- Код: Выделить всё
Option Explicit
Private Declare Function RegOpenKeyEx Lib "advapi32.dll" _
Alias "RegOpenKeyExA" (ByVal Hkey As Long, _
ByVal lpSubKey As String, _
ByVal ulOptions As Long, _
ByVal samDesired As Long, _
phkResult As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" _
(ByVal Hkey 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
Private Declare Function RegEnumValue Lib "advapi32.dll" _
Alias "RegEnumValueA" (ByVal Hkey As Long, _
ByVal dwIndex As Long, _
ByVal lpValueName As String, _
lpcbValueName As Long, _
ByVal lpReserved As Long, _
lpType As Long, _
lpData As Byte, _
lpcbData As Long) As Long
Private Declare Function RegEnumKeyEx Lib "advapi32.dll" _
Alias "RegEnumKeyExA" (ByVal Hkey As Long, _
ByVal dwIndex As Long, _
ByVal lpName As String, _
lpcbName As Long, _
ByVal lpReserved As Long, _
ByVal lpClass As String, _
lpcbClass As Long, _
lpftLastWriteTime As FILETIME) As Long
Public Const HKEY_CURRENT_USER = &H80000001
Public Const HKEY_LOCAL_MACHINE = &H80000002
Private Const READ_CONTROL = &H20000
Private Const STANDARD_RIGHTS_READ = (READ_CONTROL)
Private Const KEY_QUERY_VALUE = &H1
Private Const KEY_ENUMERATE_SUB_KEYS = &H8
Private Const KEY_NOTIFY = &H10
Private Const SYNCHRONIZE = &H100000
Private Const KEY_READ = ((STANDARD_RIGHTS_READ Or _
KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) _
And (Not SYNCHRONIZE))
Private Const ERROR_SUCCESS = 0&
Private Const REG_BINARY = 3
Private Const REG_DWORD = 4
Private Const REG_DWORD_BIG_ENDIAN = 5
Private Const REG_DWORD_LITTLE_ENDIAN = 4
Private Const REG_EXPAND_SZ = 2
Private Const REG_LINK = 6
Private Const REG_MULTI_SZ = 7
Private Const REG_FULL_RESOURCE_DESCRIPTOR = 9
Private Const REG_NONE = 0
Private Const ERROR_NO_MORE_ITEMS = 259&
Private Const REG_SZ = 1
Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Public Function SysReg(RegSubKey As String, HkeyConst As Long) As String
Dim Hkey As Long
Dim Res As Long
Dim Res1 As Long
Dim szValName As String
Dim lpvalnamesize As Long
Dim lpType As Long
Dim Data(255) As Byte
Dim DataSize As Long
Dim i As Byte, j As Byte
Dim szSubKey As String
Dim SubKeyLen As Long
Dim szClass As String
Dim ClassLen As Long
Dim FT As FILETIME
szValName = Space(512)
szSubKey = Space(512)
szClass = Space(512)
SubKeyLen = Len(szSubKey)
ClassLen = Len(szClass)
Res = RegOpenKeyEx(HkeyConst, _
RegSubKey, _
0, KEY_READ, Hkey)
If (Res <> ERROR_SUCCESS) _
Then MsgBox "ERROR CANT OPEN KEY !!!"
i = 0
j = 0
Do
Do
DataSize = 256: lpvalnamesize = Len(szValName)
Res = RegEnumValue(Hkey, i, szValName, lpvalnamesize, _
0, lpType, Data(0), DataSize)
If (Res <> ERROR_NO_MORE_ITEMS) Then
SysReg = SysReg + Mid(szValName, 1, lpvalnamesize) + " : "
If (lpType = REG_SZ Or lpType = REG_MULTI_SZ Or lpType = REG_LINK) Then
SysReg = SysReg + ByteBuffToString(Data(), DataSize) + vbCrLf
Else: If (lpType = REG_DWORD) _
Then SysReg = SysReg + ByteBuffToNum(Data(), DataSize) + vbCrLf
End If
End If
i = i + 1
Loop While (Res <> ERROR_NO_MORE_ITEMS)
i = 0
Res = RegOpenKeyEx(HkeyConst, _
RegSubKey, _
0, KEY_READ, Hkey)
Res = RegEnumKeyEx(Hkey, j, szSubKey, SubKeyLen, 0, szClass, ClassLen, FT)
Res1 = RegOpenKeyEx(HkeyConst, _
(RegSubKey _
+ szSubKey), 0, KEY_READ, Hkey)
j = j + 1
Loop While ERROR_SUCCESS <> 0
Res = RegCloseKey(Hkey)
If (Res = ERROR_SUCCESS) _
Then MsgBox "ERROR CANT CLOSE KEY !!!"
End Function
Private Function ByteBuffToString(Buff() As Byte, Lenght As Long) As String
Dim i As Long
For i = 0 To (Lenght - 2)
ByteBuffToString = ByteBuffToString + Chr(Buff(i))
Next
End Function
Private Function ByteBuffToNum(Buff() As Byte, Lenght As Long) As String
Dim i As Long
Dim szNum As String
For i = 0 To (Lenght - 2)
szNum = szNum + CStr(Hex(Buff(i)))
Next
ByteBuffToNum = szNum
End Function
Private Sub Command5_Click()
MsgBox SysReg("SYSTEM\ControlSet001\Enum\ACPI\PNP0501\1", &H80000002), , "Коммуникационные порты"
End Sub
Вроде бы все работает, но не выводит все параметры, не могу понять почему, подскажите пожалуйста в чем моя ошибка. спасибо.
