模块中代码: Option ExplicitPublic Const HKEY_CLASSES_ROOT = &H80000000 Public Const HKEY_CURRENT_USER = &H80000001 Public Const HKEY_LOCAL_MACHINE = &H80000002 Public Const HKEY_USERS = &H80000003 Public Const HKEY_PERFORMANCE_DATA = &H80000004 Public Const HKEY_CURRENT_CONFIG = &H80000005 Public Const HKEY_DYN_DATA = &H80000006Public Const REG_NONE = 0 Public Const REG_SZ = 1 Public Const REG_EXPAND_SZ = 2 Public Const REG_BINARY = 3 Public Const REG_DWORD = 4 Public Const REG_DWORD_BIG_ENDIAN = 5 Public Const REG_MULTI_SZ = 7Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long Declare Function RegQueryValue Lib "advapi32.dll" Alias "RegQueryValueA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal lpValue As String, lpcbValue As Long) As Long 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 Declare Function ExpandEnvironmentStrings Lib "kernel32" Alias "ExpandEnvironmentStringsA" (ByVal lpSrc As String, ByVal lpDst As String, ByVal nSize As Long) As LongSub MultiStringToStringArray(S As String, S2() As String) Dim count As Integer, pos As Integer, pos2 As Integer, idx As Integer
ReDim S2(0 To count - 1) pos = 1 For idx = 0 To count - 1 pos2 = InStr(pos, S, Chr(0)) S2(idx) = Mid(S, pos, pos2 - pos) pos = pos2 + 1 Next End Sub
模块代码: Option ExplicitPrivate Sub Command1_Click() Shell "RegEdit " & App.Path & "\kjAPI.reg", vbNormalFocus End SubPrivate Sub Command2_Click() Dim hKey As Long, ret As Long, lenData As Long, typeData As Long Dim Name As String, NameList(0 To 5) As String Dim i As Integer, j As Integer
ret = RegOpenKey(HKEY_CURRENT_USER, "Software\kjAPI", hKey) If ret <> 0 Then Exit Sub
For i = 0 To UBound(NameList) Name = NameList(i) ret = RegQueryValueEx(hKey, Name, 0, typeData, ByVal vbNullString, lenData) If ret <> 0 Then RegCloseKey hKey Exit Sub End If
Select Case typeData
Case REG_SZ, REG_EXPAND_SZ, REG_MULTI_SZ Dim S As String
If typeData = REG_SZ Then S = Left(S, InStr(S, Chr(0)) - 1) Text1.SelText = IIf(Name = "", "(预设值)", Name) & " = " & S & vbCrLf ElseIf typeData = REG_EXPAND_SZ Then Dim S2 As String
S2 = String(Len(S) + 256, Chr(0)) ExpandEnvironmentStrings S, S2, Len(S2) S = Left(S2, InStr(S2, Chr(0)) - 1) Text1.SelText = Name & " = " & S & vbCrLf ElseIf typeData = REG_MULTI_SZ Then Dim SArr() As String
MultiStringToStringArray S, SArr For j = 0 To UBound(SArr) Text1.SelText = Name & "(" & j & ") = " & SArr(j) & vbCrLf Next End If
Case REG_DWORD, REG_DWORD_BIG_ENDIAN Dim L As Long
RegQueryValueEx hKey, Name, 0, typeData, L, lenData Text1.SelText = Name & " = " & L & vbCrLf
Case REG_BINARY ReDim bArr(0 To lenData - 1) As Byte
RegQueryValueEx hKey, Name, 0, typeData, bArr(0), lenData Text1.SelText = Name & " = " For j = 0 To UBound(bArr) Text1.SelText = Hex(bArr(j)) & " " Next Text1.SelText = vbCrLf End Select Next RegCloseKey hKey End Sub
Option ExplicitPublic Const HKEY_CLASSES_ROOT = &H80000000
Public Const HKEY_CURRENT_USER = &H80000001
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const HKEY_USERS = &H80000003
Public Const HKEY_PERFORMANCE_DATA = &H80000004
Public Const HKEY_CURRENT_CONFIG = &H80000005
Public Const HKEY_DYN_DATA = &H80000006Public Const REG_NONE = 0
Public Const REG_SZ = 1
Public Const REG_EXPAND_SZ = 2
Public Const REG_BINARY = 3
Public Const REG_DWORD = 4
Public Const REG_DWORD_BIG_ENDIAN = 5
Public Const REG_MULTI_SZ = 7Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Declare Function RegQueryValue Lib "advapi32.dll" Alias "RegQueryValueA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal lpValue As String, lpcbValue As Long) As Long
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
Declare Function ExpandEnvironmentStrings Lib "kernel32" Alias "ExpandEnvironmentStringsA" (ByVal lpSrc As String, ByVal lpDst As String, ByVal nSize As Long) As LongSub MultiStringToStringArray(S As String, S2() As String)
Dim count As Integer, pos As Integer, pos2 As Integer, idx As Integer
pos = InStr(S, Chr(0))
While pos > 0
count = count + 1
pos = InStr(pos + 1, S, Chr(0))
Wend
count = count - 1
ReDim S2(0 To count - 1)
pos = 1
For idx = 0 To count - 1
pos2 = InStr(pos, S, Chr(0))
S2(idx) = Mid(S, pos, pos2 - pos)
pos = pos2 + 1
Next
End Sub
Option ExplicitPrivate Sub Command1_Click()
Shell "RegEdit " & App.Path & "\kjAPI.reg", vbNormalFocus
End SubPrivate Sub Command2_Click()
Dim hKey As Long, ret As Long, lenData As Long, typeData As Long
Dim Name As String, NameList(0 To 5) As String
Dim i As Integer, j As Integer
ret = RegOpenKey(HKEY_CURRENT_USER, "Software\kjAPI", hKey)
If ret <> 0 Then Exit Sub
NameList(0) = ""
NameList(1) = "Str1": NameList(2) = "Str2": NameList(3) = "Str3"
NameList(4) = "LongData": NameList(5) = "BinaryData"
For i = 0 To UBound(NameList)
Name = NameList(i)
ret = RegQueryValueEx(hKey, Name, 0, typeData, ByVal vbNullString, lenData)
If ret <> 0 Then
RegCloseKey hKey
Exit Sub
End If
Select Case typeData
Case REG_SZ, REG_EXPAND_SZ, REG_MULTI_SZ
Dim S As String
S = String(lenData, Chr(0))
RegQueryValueEx hKey, Name, 0, typeData, ByVal S, lenData
If typeData = REG_SZ Then
S = Left(S, InStr(S, Chr(0)) - 1)
Text1.SelText = IIf(Name = "", "(预设值)", Name) & " = " & S & vbCrLf
ElseIf typeData = REG_EXPAND_SZ Then
Dim S2 As String
S2 = String(Len(S) + 256, Chr(0))
ExpandEnvironmentStrings S, S2, Len(S2)
S = Left(S2, InStr(S2, Chr(0)) - 1)
Text1.SelText = Name & " = " & S & vbCrLf
ElseIf typeData = REG_MULTI_SZ Then
Dim SArr() As String
MultiStringToStringArray S, SArr
For j = 0 To UBound(SArr)
Text1.SelText = Name & "(" & j & ") = " & SArr(j) & vbCrLf
Next
End If
Case REG_DWORD, REG_DWORD_BIG_ENDIAN
Dim L As Long
RegQueryValueEx hKey, Name, 0, typeData, L, lenData
Text1.SelText = Name & " = " & L & vbCrLf
Case REG_BINARY
ReDim bArr(0 To lenData - 1) As Byte
RegQueryValueEx hKey, Name, 0, typeData, bArr(0), lenData
Text1.SelText = Name & " = "
For j = 0 To UBound(bArr)
Text1.SelText = Hex(bArr(j)) & " "
Next
Text1.SelText = vbCrLf
End Select
Next
RegCloseKey hKey
End Sub