TAG:
|
原始来源:王国荣 程式启动时，会在 "HKEY_LOCAL_MACHINE\\kj\\Registry" Subkey 底下写入：(此时 会呼叫 SetDefaultvalue 及 Setvalue 函数) 资料类型 名称 资料 ========= ============== ================================ (预设值) kj Registry Master REG_SZ StringData 这是字串 REG_MULTI_SZ MultiString 字串一(0) +字串二+Chr(0) +Chr(0) REG_DWORD LongData 99999 REG_BINARY BinaryData 11 22 33 44 AA BB CC DD 接着当您按下「显示所有 value 时」(command1)时，程式会读出来所有 value 并且 显示在ListBox 之中(此时会呼叫 GetDefaultvalue、GetvalueByIndex 函数)。 最後当程式结束时，则会删除以上所有的 value(此时会呼叫 GetvalueByIndex 函数 及 RegDeletevalue API 函数)。 ''请放3个CommandBox一个ListBox於form上 Option Explicit '' Private Sub Form_Load() Dim hKey As Long, ret As Long ret = SetDefaultvalue(HKEY_LOCAL_MACHINE, "SOFTWARE\\kj\\Registry", _ "kj Registry Master") ret = RegOpenKey(HKEY_LOCAL_MACHINE, "SOFTWARE\\kj\\Registry", hKey) ret = Setvalue(hKey, "StringData", REG_SZ, "这是字串") ret = Setvalue(hKey, "MultiString", REG_MULTI_SZ, "字串一" + Chr(0) _ + "字串二" + Chr(0)) ret = Setvalue(hKey, "LongData", REG_DWORD, 99999) ret = Setvalue(hKey, "BinaryData", REG_BINARY, _ Array(&H11, &H22, &H33, &H44, &HAA, &HBB, &HCC, &HDD), 8) Call RegCloseKey(hKey) MsgBox "已写入资料到登录资料库中，您可以开启 RegEdit 加以检查！" End Sub Private Sub Command1_Click() '' 显示所有 value Dim Index As Long, ret As Long, hKey As Long Dim bArr() As Byte, Name As String, vType As Long ret = RegOpenKey(HKEY_LOCAL_MACHINE, "SOFTWARE\\kj\\Registry", hKey) ret = GetvalueByIndex(hKey, Index, Name, bArr, vType) While ret If Len(Name) = 0 Then Name = "(预 设 值)" List1.AddItem Name & vbTab & valueOutput(bArr, vType) Index = Index + 1 ret = GetvalueByIndex(hKey, Index, Name, bArr, vType) Wend Call RegCloseKey(hKey) End Sub Private Sub Form_Unload(Cancel As Integer) Dim Index As Long, ret As Long, hKey As Long Dim bArr() As Byte, Name As String, vType As Long ret = RegOpenKey(HKEY_LOCAL_MACHINE, "SOFTWARE\\kj\\Registry", hKey) ret = GetvalueByIndex(hKey, Index, Name, bArr, vType) While ret Call RegDeletevalue(hKey, Name) '' 不可以执行 Index = Index + 1，因为 Index = 0 的 value 已删除， '' 後面的 Index 向前递减，所以 Index = 0 又可以读到 value， '' 其实在这一个 While 回圈中，您可以将 Index 变数改成 0 ret = GetvalueByIndex(hKey, Index, Name, bArr, vType) Wend Call RegCloseKey(hKey) MsgBox "kj\\Registry 的 value 已删除，利用 RegEdit 检查时，记得要先执行功能的「检视／重新整理」！" End Sub Function valueOutput(bArr() As Byte, ByVal vType As Long) As String Dim S As String, S2 As String, length As Integer, L As Long Dim i As Integer, sArr() As String Select Case vType Case REG_SZ, REG_EXPAND_SZ ByteArrayToString bArr, S '' 呼叫 ExpandEnvironmentStrings S2 = String(Len(S) + 256, Chr(0)) length = ExpandEnvironmentStrings(S, S2, Len(S2)) S = Left(S2, length - 1) valueOutput = "Type=String, Data=" & S Case REG_MULTI_SZ ByteArrayToMultiString bArr, sArr valueOutput = "Type=MultiString, Data=" For i = LBound(sArr) To UBound(sArr) valueOutput = valueOutput & sArr(i) & ", " Next i Case REG_DWORD, REG_DWORD_BIG_ENDIAN ByteArrayToLong bArr, L valueOutput = "Type=Long, Data=" & L Case REG_BINARY valueOutput = "Type=Byte Array, Data=" For i = LBound(bArr) To UBound(bArr) valueOutput = valueOutput + Format(Hex(bArr(i)), "00") Next i End Select End Function Private Sub Command2_Click() Unload Me End End Sub Private Sub Command3_Click() Dim hKey As Long, resu As Long Dim aa As Boolean Dim bytary() As Byte Dim str5 As String resu = RegOpenKey(HKEY_LOCAL_MACHINE, _ "SOFTWARE\\Microsoft\\Windows\\CurrentVersion", hKey) aa = Getvalue(hKey, "ProductId", bytary, REG_SZ) Call ByteArrayToString(bytary, str5) Debug.Print str5 Call RegCloseKey(hKey) End Sub ''以下程式在registry.bas ''这是一个十分有用的函式库，而且原作者将之整理得相当好。 Type FILETIME dwLowDateTime As Long dwHighDateTime As Long End Type '' Registry API 宣告 Declare 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 RegQueryInfoKey Lib "advapi32.dll" Alias "RegQueryInfoKeyA" (ByVal hKey As Long, ByVal lpClass As String, lpcbClass As Long, lpReserved As Long, lpcSubKeys As Long, lpcbMaxSubKeyLen As Long, lpcbMaxClassLen As Long, lpcvalues As Long, lpc 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 Declare Function RegEnumKeyEx Lib "advapi32.dll" Alias "RegEnumKeyExA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, lpcbName As Long, lpReserved As Long, ByVal lpClass As String, lpcbClass As Long, lpftLastWriteTime As FILETIME) As 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 '' mo 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 RegSetvalue Lib "advapi32.dll" Alias "RegSetvalueA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal dwType As Long, ByVal lpData As String, ByVal cbData As Long) As Long Declare Function RegSetvalueEx Lib "advapi32.dll" Alias "RegSetvalueExA" (ByVal hKey As Long, ByVal lpvalueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long Declare Function RegDeletevalue Lib "advapi32.dll" Alias "RegDeletevalueA" (ByVal hKey As Long, ByVal lpvalueName As String) As Long Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long '' 其他相关的 API 宣告 Declare Function ExpandEnvironmentStrings Lib "KERNEL32" Alias "ExpandEnvironmentStringsA" (ByVal lpSrc As String, ByVal lpDst As String, ByVal nSize As Long) As Long Declare Sub RtlMoveMemory Lib "KERNEL32" (lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long) (王国荣) |