vb快速访问注册表的方法

VERSION 5.00 Begin VB.Form frmMain BorderStyle = 1 'Fixed Single Caption = "Reg Demo" ClientHeight = 6570 ClientLeft = 45 ClientTop = 435 ClientWidth = 7695 LinkTopic = "Form1" MaxButton = 0 'False MinButton = 0 'False ScaleHeight = 6570 ScaleWidth = 7695 StartUpPosition = 2 'CenterScreen Begin VB.TextBox txtData Height = 270 Left = 1200 TabIndex = 6 Text = "ExCFormParser" Top = 5400 Width = 6375 End Begin VB.TextBox txtRegKey Height = 270 Left = 1200 TabIndex = 4 Text = "\Registry\Machine" Top = 5040 Width = 6375 End Begin VB.CommandButton cmdEnd Caption = "End" Enabled = 0 'False Height = 495 Left = 2760 TabIndex = 2 Top = 5760 Width = 1455 End Begin VB.CommandButton cmdStart Caption = "Start" Height = 495 Left = 1200 TabIndex = 1 Top = 5760 Width = 1455 End Begin VB.ListBox lstMsg Height = 4545 Left = 120 TabIndex = 0 Top = 360 Width = 7455 End Begin VB.Label lblMsg AutoSize = -1 'True Caption = "String:" Height = 195 Index = 2 Left = 120 TabIndex = 7 Top = 5445 Width = 450 End Begin VB.Label lblMsg AutoSize = -1 'True Caption = "Reg Path:" Height = 195 Index = 1 Left = 120 TabIndex = 5 Top = 5085 Width = 720 End Begin VB.Label lblMsg AutoSize = -1 'True Caption = "Reg Demo Result:" Height = 195 Index = 0 Left = 120 TabIndex = 3 Top = 120 Width = 1305 End End Attribute VB_Name = "frmMain" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Option Explicit Private Type UNICODE_STRING Length As Integer MaximumLength As Integer Buffer As Long End Type Private Type OBJECT_ATTRIBUTES Length As Long RootDirectory As Long ObjectName As Long Attributes As Long SecurityDescriptor As Long SecurityQualityOfService As Long End Type Private Type KEY_VALUE_FULL_INFORMATION TitleIndex As Long Type As Long DataOffset As Long DataLength As Long NameLength As Long Name As Long End Type Private Type LARGE_INTEGER Lowpart As Long Highpart As Long End Type Private Type KEY_BASIC_INFORMATION LastWriteTim As LARGE_INTEGER TitleIndex As Long NameLength As Long Name As Long End Type Private Type KEY_FULL_INFORMATION LastWriteTim As LARGE_INTEGER TitleIndex As Long ClassOffset As Long ClassLength As Long SubKeys As Long MaxNameLen As Long MaxClassLen As Long Values As Long MaxValueNameLen As Long MaxValueDataLen As Long Class As Long End Type Private Enum KEY_INFORMATION_CLASS KeyBasicInformation KeyNodeInformation KeyFullInformation KeyNameInformation KeyCachedInformation KeyFlagsInformation End Enum Private Enum KEY_VALUE_INFORMATION_CLASS KeyValueBasicInformation KeyValueFullInformation KeyValuePartialInformation KeyValueFullInformationAlign64 KeyValuePartialInformationAlign64 End Enum Private Const STATUS_BUFFER_OVERFLOW = &H80000005 Private Const STATUS_BUFFER_TOO_SMALL = &HC0000023 Private Const OBJ_CASE_INSENSITIVE = &H40 Private Const READ_CONTROL = &H20000 Private Const KEY_QUERY_VALUE = &H1 Private Const KEY_ENUMERATE_SUB_KEYS = &H8 Private Const KEY_NOTIFY = &H10 Private Const KEY_READ = KEY_QUERY_VALUE + KEY_ENUMERATE_SUB_KEYS + KEY_NOTIFY + READ_CONTROL Private Declare Function ZwClose Lib "NTDLL.DLL" (ByVal ObjectHandle As Long) As Long Private Declare Sub RtlInitUnicodeString Lib "NTDLL.DLL" (ByVal DestinationString As Long, ByVal SourceString As Long) Private Declare Function ZwOpenKey Lib "NTDLL.DLL" (KeyHandle As Long, ByVal DesiredAccess As Long, ByVal ObjectAttributes As Long) As Long Private Declare Function ZwQueryKey Lib "NTDLL.DLL" (ByVal KeyHandle As Long, _ ByVal KeyInformationClass As KEY_INFORMATION_CLASS, _ ByVal KeyInformation As Long, _ ByVal KeyInformationLength As Long, _ ResultLength As Long _ ) As Long Private Declare Function ZwEnumerateValueKey Lib "NTDLL.DLL" (ByVal KeyHandle As Long, _ ByVal Index As Long, _ ByVal KeyValueInformationClass As KEY_VALUE_INFORMATION_CLASS, _ ByVal KeyValueInformation As Long, _ ByVal KeyValueInformationLength As Long, _ ResultLength As Long _ ) As Long Private Declare Function ZwEnumerateKey Lib "NTDLL.DLL" (ByVal KeyHandle As Long, _ ByVal Index As Long, _ ByVal KeyInformationClass As KEY_INFORMATION_CLASS, _ ByVal KeyInformation As Long, _ ByVal KeyInformationLength As Long, _ ResultLength As Long _ ) As Long Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByVal Destination As Long, ByVal Source As Long, ByVal Length As Long) Private g_blnEnd As Boolean Public Sub EnumRegistryKey(ByVal lpRegKey As String, ByVal lpFcString As String) Dim KeyHandle As Long Dim ntStatus As Long Dim ResultLength As Long Dim bytBuffer() As Byte Dim bytValueBuffer() As Byte Dim strValue As String Dim KeyBase As KEY_BASIC_INFORMATION Dim KeyValueFull As KEY_VALUE_FULL_INFORMATION Dim KeyFull As KEY_FULL_INFORMATION Dim i As Integer Dim ustrKeyName As UNICODE_STRING Dim objAttr As OBJECT_ATTRIBUTES Dim strKeyName As String RtlInitUnicodeString VarPtr(ustrKeyName), StrPtr(lpRegKey) objAttr.Length = LenB(objAttr) objAttr.ObjectName = VarPtr(ustrKeyName) objAttr.Attributes = OBJ_CASE_INSENSITIVE ntStatus = ZwOpenKey(KeyHandle, KEY_READ, VarPtr(objAttr)) If ntStatus >= 0 Then ntStatus = ZwQueryKey(KeyHandle, _ KeyFullInformation, _ 0, _ 0, _ ResultLength _ ) If ntStatus = STATUS_BUFFER_OVERFLOW Or ntStatus = STATUS_BUFFER_TOO_SMALL Then ReDim bytBuffer(ResultLength - 1) ntStatus = ZwQueryKey(KeyHandle, _ KeyFullInformation, _ VarPtr(bytBuffer(0)), _ ResultLength, _ ResultLength _ ) If ntStatus >= 0 Then CopyMemory VarPtr(KeyFull), VarPtr(bytBuffer(0)), LenB(KeyFull) For i = 0 To KeyFull.Values - 1 If g_blnEnd Then Exit For If i Mod 10 Then DoEvents ntStatus = ZwEnumerateValueKey(KeyHandle, _ i, _ KeyValueFullInformation, _ 0, _ 0, _ ResultLength _ ) If ntStatus = STATUS_BUFFER_OVERFLOW Or ntStatus = STATUS_BUFFER_TOO_SMALL Then ReDim bytValueBuffer(ResultLength - 1) ntStatus = ZwEnumerateValueKey(KeyHandle, _ i, _ KeyValueFullInformation, _ VarPtr(bytValueBuffer(0)), _ ResultLength, _ ResultLength _ ) If ntStatus >= 0 Then CopyMemory VarPtr(KeyValueFull), VarPtr(bytValueBuffer(0)), LenB(KeyValueFull) strValue = String(KeyValueFull.NameLength / 2, 0) CopyMemory StrPtr(strValue), VarPtr(bytValueBuffer(0)) + 20, KeyValueFull.NameLength If InStr(strValue, lpFcString) Then lstMsg.AddItem "KeyName:" & strValue End If End If Erase bytValueBuffer End If Next For i = 0 To KeyFull.SubKeys - 1 If g_blnEnd Then Exit For If i Mod 10 Then DoEvents ntStatus = ZwEnumerateKey(KeyHandle, _ i, _ KeyBasicInformation, _ 0, _ 0, _ ResultLength _ ) If ntStatus = STATUS_BUFFER_OVERFLOW Or ntStatus = STATUS_BUFFER_TOO_SMALL Then ReDim bytValueBuffer(ResultLength - 1) ntStatus = ZwEnumerateKey(KeyHandle, _ i, _ KeyBasicInformation, _ VarPtr(bytValueBuffer(0)), _ ResultLength, _ ResultLength _ ) If ntStatus >= 0 Then CopyMemory VarPtr(KeyBase), VarPtr(bytValueBuffer(0)), LenB(KeyBase) strValue = String(KeyBase.NameLength / 2, 0) CopyMemory StrPtr(strValue), VarPtr(bytValueBuffer(0)) + 16, KeyBase.NameLength If InStr(strValue, lpFcString) Then lstMsg.AddItem "KeyName: " & strValue End If strKeyName = lpRegKey & "\" & strValue EnumRegistryKey strKeyName, lpFcString End If Erase bytValueBuffer End If Next End If Erase bytBuffer End If ZwClose KeyHandle End If End Sub Private Sub cmdEnd_Click() g_blnEnd = True Me.cmdStart.Enabled = True Me.cmdEnd.Enabled = False End Sub Private Sub cmdStart_Click() lstMsg.Clear g_blnEnd = False Me.cmdStart.Enabled = False Me.cmdEnd.Enabled = True Me.Caption = "Doing..." EnumRegistryKey txtRegKey.Text, txtData.Text cmdEnd_Click Me.Caption = "reg demo" End Sub

转自http://topic.csdn.net/u/20091029/12/074699fa-e074-4e4d-86b0-aba16eed2144.html