Visual Basic, .NET, ASP, VBScript
Новости | Примеры | Библиотека кодов | НеЧаВо | VBA | Справочник по VB | Справочник по WinAPI | ActiveX контролы | Статьи по VB | Мастерская разработчика | Форум VBNet | Яndex bar! | Голосование | Полезные программы | Магазин VBNet | Рассылка | Конкурсы | Юмор | Чат | Реклама на VBNet | Автора! | Ссылки | Бета-тестирование | Послать пример на сайт
 

   
   
     

Форум - Общий форум

Страница: 1 |

 

  Вопрос: Чтение данных из реестра Добавлено: 23.06.10 21:48  

Автор вопроса:  Nevep
Необходимо прочитать параметры раздела в реестре...не подразделы, а именно параметры. Перебрал кучу исходников, но они выводят только подразделы раздела. Вот один из них:
Const HKEY_CLASSES_ROOT = &H80000000
 Const HKEY_CURRENT_USER = &H80000001
 Const HKEY_LOCAL_MACHINE = &H80000002
 Const HKEY_USERS = &H80000003
 Const HKEY_PERFORMANCE_DATA = &H80000004
 Const HKEY_CURRENT_CONFIG = &H80000005
 Const HKEY_DYN_DATA = &H80000006

 Const REG_SZ = 1
 Const REG_BINARY = 3
 Const REG_DWORD = 4
 Const ERROR_SUCCESS = 0&

Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegEnumKey Lib "advapi32.dll" Alias "RegEnumKeyA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, ByVal cbName As Long) As Long
Private Declare Function RegEnumValue Lib "advapi32.dll" Alias "RegEnumValueA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpValueName As String, lpcbValueName As Long, lpReserved As Long, lpType As Long, lpData As Byte, lpcbData As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long

Public Function GetAllKeys(hKey As Long, strPath As String) As Variant
    On Error Resume Next
   Dim lRegResult As Long
   Dim lCounter As Long
   Dim hCurKey As Long
   Dim strBuffer As String
   Dim lDataBufferSize As Long
   Dim strNames() As String
   Dim intZeroPos As Integer
 
   lCounter = 0
   lRegResult = RegOpenKey(hKey, strPath, hCurKey)
   Do
      lDataBufferSize = 255
      strBuffer = String(lDataBufferSize, " ")
      lRegResult = RegEnumKey(hCurKey, lCounter, strBuffer, lDataBufferSize)
      If lRegResult = ERROR_SUCCESS Then
         ReDim Preserve strNames(lCounter) As String
         intZeroPos = InStr(strBuffer, Chr$(0))
         If intZeroPos > 0 Then
            strNames(UBound(strNames)) = Left$(strBuffer, intZeroPos - 1)
         Else
            strNames(UBound(strNames)) = strBuffer
         End If
         lCounter = lCounter + 1
      Else
         Exit Do
      End If
   Loop
   GetAllKeys = strNames
End Function

Public Function GetAllValues(hKey As Long, strPath As String) As Variant
    On Error Resume Next
   Dim lRegResult As Long
   Dim hCurKey As Long
   Dim lValueNameSize As Long
   Dim strValueName As String
   Dim lCounter As Long
   Dim byDataBuffer(4000) As Byte
   Dim lDataBufferSize As Long
   Dim lValueType As Long
   Dim strNames() As String
   Dim lTypes() As Long
   Dim intZeroPos As Integer
   
   lRegResult = RegOpenKey(hKey, strPath, hCurKey)
   Do
      lValueNameSize = 255
      strValueName = String$(lValueNameSize, " ")
      lDataBufferSize = 4000
      lRegResult = RegEnumValue(hCurKey, lCounter, strValueName, lValueNameSize, 0&, lValueType, byDataBuffer(0), lDataBufferSize)
      If lRegResult = ERROR_SUCCESS Then
         ReDim Preserve strNames(lCounter) As String
         ReDim Preserve lTypes(lCounter) As Long
         lTypes(UBound(lTypes)) = lValueType
         intZeroPos = InStr(strValueName, Chr$(0))
         If intZeroPos > 0 Then
            strNames(UBound(strNames)) = Left$(strValueName, intZeroPos - 1)
         Else
            strNames(UBound(strNames)) = strValueName
         End If
         lCounter = lCounter + 1
      Else
         Exit Do
      End If
   Loop
   Dim Finisheddata() As Variant
   ReDim Finisheddata(UBound(strNames), 0 To 1) As Variant
   For lCounter = 0 To UBound(strNames)
      Finisheddata(lCounter, 0) = strNames(lCounter)
      Finisheddata(lCounter, 1) = lTypes(lCounter)
   Next
   GetAllValues = Finisheddata
End Function

Private Sub Form_Load()
Dim k
k = GetAllKeys(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\StartMenu")
MsgBox (k(0) & Chr(13) & k(1) & Chr(13) & k(2))
End Sub

Выводит Policy StartMenu StartPanel, а нужно Bitmap, HelpID, Text, Type.

Ответить

  Ответы Всего ответов: 7  

Номер ответа: 1
Автор ответа:
 LamerOnLine



ICQ: 334781088 

Вопросов: 108
Ответов: 2822
  Профиль | | #1 Добавлено: 23.06.10 22:16
В разделе примеров на форуме модулей для работы с реестром - до жопы. Click&Use.

Ответить

Номер ответа: 2
Автор ответа:
 Nevep



Вопросов: 6
Ответов: 25
  Профиль | | #2 Добавлено: 23.06.10 23:06
Ага, точняк. Спасибо:)
Проблему решил.
Option Explicit

Private Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" (ByVal hkey&, ByVal lpSubKey$, ByVal dwReserved&, ByVal samDesired As Long, phkResult As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32" Alias "RegQueryValueExA" (ByVal hkey As Long, ByVal lpValueName As String, lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
Private Declare Function RegCloseKey& Lib "advapi32" (ByVal hkey&;)
Private Declare Function RegQueryInfoKey Lib "advapi32.dll" Alias "RegQueryInfoKeyA" (ByVal hkey&, ByVal lpClass$, lpcbClass&, ByVal lpReserved&, lpcSubKeys&, lpcbMaxSubKeyLen&, lpcbMaxClassLen&, lpcValues&, lpcbMaxValueNameLen&, lpcbMaxValueLen&, lpcbSecurityDescriptor&, lpftLastWriteTime As Any) As Long
Private Declare Function RegEnumValue Lib "advapi32.dll" Alias "RegEnumValueA" (ByVal hkey&, ByVal dwIndex&, ByVal lpValueName$, lpcbValueName&, ByVal lpReserved&, lpType&, lpData As Any, lpcbData As Long) As Long

Const HKEY_CLASSES_ROOT = &H80000000
Const HKEY_CURRENT_USER = &H80000001
Const HKEY_LOCAL_MACHINE = &H80000002
Const HKEY_USERS = &H80000003

Private Const KEY_QUERY_VALUE = &H1
Private Const KEY_SET_VALUE = &H2
Private Const KEY_CREATE_SUB_KEY = &H4
Private Const KEY_ENUMERATE_SUB_KEYS = &H8
Private Const KEY_NOTIFY = &H10
Private Const KEY_CREATE_LINK = &H20
Private Const STANDARD_RIGHTS_ALL = &H1F0000
Private Const SYNCHRONIZE = &H100000

Private Const KEY_ALL_ACCESS = ((STANDARD_RIGHTS_ALL Or _
        KEY_QUERY_VALUE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY _
        Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY Or _
        KEY_CREATE_LINK) And (Not SYNCHRONIZE))
Private Const REG_SZ = 1, REG_DWORD = 4, REG_EXPAND_SZ = 2, REG_BINARY = 3, REG_MULTI_SZ = 7
Private lmCount, rtn As Long

Function GetString(hkey As Long, strpath As String, strValue As String) As String
 Dim strData As String
 Dim lngData As Long, i As Long
  rtn = RegOpenKeyEx(hkey, strpath, 0, KEY_ALL_ACCESS, hkey)
   strData = Space(255)
   lngData = Len(strData)
  rtn = RegQueryValueEx(hkey, strValue, ByVal 0, REG_SZ, ByVal strData, lngData)
  rtn = RegCloseKey(hkey)
   strData = Trim(strData)
 GetString = Left(strData, lngData - 1)
End Function
Function QueryRegInfoKey(hkey&, Optional lngSubKeys&, Optional lngMaxKeyLen&, Optional lngValues&, Optional lngMaxValNameLen&, Optional lngMaxValLen&;)
QueryRegInfoKey = RegQueryInfoKey(hkey, vbNullString, ByVal 0&, 0&, lngSubKeys, lngMaxKeyLen, ByVal 0&, lngValues, lngMaxValNameLen, lngMaxValLen, ByVal 0&, ByVal 0&;)
lngMaxKeyLen = lngMaxKeyLen + 1
lngMaxValNameLen = lngMaxValNameLen + 1
lngMaxValLen = lngMaxValLen + 1
End Function
Function GetRegKeyValues(hkey As String, strSubKey As String)
Dim lngNumValues As Long, strValues As String, strValues1 As String, _
lngMaxValSize  As Long, lngValRetBytes As Long, lngMaxSettingSize As Long, _
lngSetRetBytes As Long, lngSetting As Long, lngType As Long, _
hChildKey As Long, i As Integer
rtn = RegOpenKeyEx(hkey, strSubKey, 0, KEY_ALL_ACCESS, hChildKey)
rtn = QueryRegInfoKey(hChildKey, , , lngNumValues, lngMaxValSize, lngMaxSettingSize)
lngNumValues = lngNumValues - 1
 For i = 0 To lngNumValues
  strValues1 = Space(lngMaxValSize)
  lngValRetBytes = lngMaxValSize
  strValues = Space(lngMaxSettingSize)
  lngSetRetBytes = lngMaxSettingSize
  RegEnumValue hChildKey, i, strValues1, lngValRetBytes, 0, lngType, ByVal strValues, lngSetRetBytes
    If lngType = REG_SZ Then
      MsgBox (GetString(HKEY_LOCAL_MACHINE, strSubKey, Left(strValues1, lngValRetBytes)))
    'ElseIf lngType = REG_DWORD Then
    '  Lst1.AddItem RTrim(Left(strValues1, lngValRetBytes))
    '  Lst2.AddItem "REG_DWORD"
    'ElseIf lngType = REG_BINARY Then
    '  Lst1.AddItem Left(strValues1, lngValRetBytes)
    '  Lst2.AddItem "REG_BINARY"
    'ElseIf lngType = REG_EXPAND_SZ Then
    '  Lst1.AddItem Left(strValues1, lngValRetBytes)
    '  Lst2.AddItem "REG_EXPAND_SZ"
    'ElseIf lngType = REG_MULTI_SZ Then
    '  Lst1.AddItem Left(strValues1, lngValRetBytes)
    '  Lst2.AddItem "REG_MULTI_SZ"
    End If
  Next i
RegCloseKey hChildKey
End Function

Private Sub Form_Load()
Dim SubKey As String
SubKey = "SOFTWARE\Microsoft\Windows\CurrentVersion\Run"
GetRegKeyValues HKEY_LOCAL_MACHINE, SubKey
End Sub

Ответить

Номер ответа: 3
Автор ответа:
 EROS



Вопросов: 58
Ответов: 4255
  Профиль | | #3 Добавлено: 24.06.10 07:41
O_O, только не говори что ты эту хрень будешь в NET юзать!?

Ответить

Номер ответа: 4
Автор ответа:
 LamerOnLine



ICQ: 334781088 

Вопросов: 108
Ответов: 2822
  Профиль | | #4 Добавлено: 24.06.10 12:08
EROS, код в первом посте похож на NET?

Ответить

Номер ответа: 5
Автор ответа:
 EROS



Вопросов: 58
Ответов: 4255
  Профиль | | #5 Добавлено: 25.06.10 07:51
EROS, код в первом посте похож на NET?

Его предыдущий пост был по НЕТ, хотя там тоже были API.. вот я и предположил что ТС пишет на НЕТ но собирается юзать всякую хрень..

Ответить

Номер ответа: 6
Автор ответа:
 Smith



ICQ: adamis@list.ru 

Вопросов: 153
Ответов: 3632
  Профиль | | #6 Добавлено: 25.06.10 19:37
Нет смысла использовать ту хрень, которая используется внутри фрэймворка, а иначе нахрена вообще фрэймворк.

Ответить

Номер ответа: 7
Автор ответа:
 EROS



Вопросов: 58
Ответов: 4255
  Профиль | | #7 Добавлено: 25.06.10 20:11
а иначе нахрена вообще фрэймворк.

он,имхо, призван облегчить жизнь програмиста.. он избавляет от необходимости написания рутинного кода как в этом топике.. тут он написал простыню, а в НЕТ мне для этого надо будет написать 2 строчки..

Ответить

Страница: 1 |

Поиск по форуму



© Copyright 2002-2011 VBNet.RU | Пишите нам