[Last Call] Learn how to a build a cloud-first strategyRegister Now

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 353
  • Last Modified:

How to perform a registry search?

Hi,

Is there any way in VB6 to perform a registry search, the same way I can do that with regedit?
What I need is to search for values only(things that appear in the right pane of regedit), and to get all values that match the search as an array(but together with the full key name, not the values only). Also to get partial matches, like if I'm searching for 'abcde' to get also '1abcde' or 'abcdef'.
It would be nice if I can define the search area, like to search for example under HKEY_LOCAL_MACHINE only, not the entire registry.
I need a solution that will work on all windows versions(except 3.x and NT4 sp3 or below)

Thanx
0
peterned
Asked:
peterned
  • 9
  • 6
  • 3
  • +3
1 Solution
 
hesCommented:
0
 
DennisBorgCommented:
:ping:
0
 
peternedAuthor Commented:
That's an interesting example but it does not search and I can't see how to use it for what I want
0
What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

 
wileecoyCommented:
peterned,

Maybe I can help you get to a close answer with the example posted above.

In the sub ListEntryValues, there are lines as:

'******** begin code

Select Case mDataType
    Case REG_SZ
        For i = 1 To mDataByteLength - 1
            mDataByteValue = mDataByteValue & Chr$(arrDataByte(i))
        Next i
        mAccumText = mAccumText & Space(mAlignPos) & mEntry & " = """ & _
             mDataByteValue & """" & vbCrLf

'******** end code

I added a listbox (List1) and then changed the code as follows:

'******** begin code

Select Case mDataType
    Case REG_SZ
        For i = 1 To mDataByteLength - 1
            mDataByteValue = mDataByteValue & Chr$(arrDataByte(i))
        Next i
        If InStr(1, mDataByteValue, "www", vbTextCompare) Then
            mAccumText = mAccumText & Space(mAlignPos) & mEntry & " = """ & _
                 mDataByteValue & """" & vbCrLf
            List1.AddItem mDataByteValue
        End If

'******** end code

That displays in a listbox all values with "www" anywhere in the value.

If this is more of what you are looking for, simply add a textbox (text1) and replace the "www" with Text1.Text.

Then you can run the program and put in your search selection in the textbox, Text1.

hth.

Wileecoy.

btw - it is late and I am tired.  If any of this is unclear, or if you need additional or more comprehensive code, feel free to ask.

0
 
lyonstCommented:
0
 
peternedAuthor Commented:
I tried this but it doesn't seem to work for me, I mean nothing appears in the list. I changed "www" to "iis" which exists as a value name, tried other stuffs too. That's on w2k sp1.
But even if I make it work, I don't think this is the right approach. It might be ok for searching the values under some subkey which does not have its own subkeys, but what if I want to search  under HKEY_LOCAL_MACHINE, or the entire registry? This will require to retrieve and analyze an enormous amount of information(to loop reqursively through all subkeys, get all values and look for a match). I guess this will be either too slow or will lead to a crash if the search range is big.
0
 
peternedAuthor Commented:
My previous comment is for Wileecoy's code.
I also took a quick look at the example  lyonst suggested, but can't find anything I can use for searching there - it can create or delete keys, set key values, or retrieve values if you know where they reside, but not to search.
0
 
wileecoyCommented:
peterned,

Yea, I think you're right.  It won't let you search from just HKEY_LOCAL_MACHINE.

Lemme see what else I have up my sleeve.

Wileecoy.
0
 
ArkCommented:
Hi
Just finished it. Was suprised - could not find anything similiar in the NET??? Have to test code a bit. Hope I'll send source to FreeVBCode tomorrow. I used class module for make it easy to use and probably convert to OCX/DLL.

'=====CLASS MODULE CODE (ClassName = cRegSearch)=========

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 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 RegQueryValue Lib "advapi32.dll" Alias "RegQueryValueA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal lpValue As String, lpcbValue As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey 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 RegEnumValueType 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, ByVal null1 As Long, ByVal null2 As Long) As Long
Private Declare Function RegEnumValueString 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 String, lpcbData As Long) As Long

Enum ROOT_KEYS
     HKEY_ALL = &H0&
     HKEY_CLASSES_ROOT = &H80000000
     HKEY_CURRENT_USER = &H80000001
     HKEY_LOCAL_MACHINE = &H80000002
     HKEY_USERS = &H80000003
     HKEY_PERFORMANCE_DATA = &H80000004
     HKEY_CURRENT_CONFIG = &H80000005
     HKEY_DYN_DATA = &H80000006
End Enum

Enum SEARCH_FLAGS
     KEY_NAME = 0
     VALUE_NAME = 1
     VALUE_VALUE = 2
     WHOLE_STRING = 4
End Enum

Enum FOUN_WHERE
     FOUND_KEY_NAME
     FOUND_VALUE_NAME
     FOUND_VALUE_VALUE
End Enum

Private Const STANDARD_RIGHTS_ALL = &H1F0000
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 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))
Const KEY_READ = &H20019  ' ((READ_CONTROL Or KEY_QUERY_VALUE Or
                          ' KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And (Not
                          ' SYNCHRONIZE))

Private Const ERROR_SUCCESS = 0&
Private Const ERR_MORE_DATA = 234&
Private Const ERROR_NO_MORE_ITEMS = 259&

Private Const REG_NONE = 0
Private Const REG_SZ = 1
Private Const REG_EXPAND_SZ = 2
Private Const REG_BINARY = 3
Private Const REG_DWORD = 4
Private Const REG_DWORD_LITTLE_ENDIAN = 4
Private Const REG_DWORD_BIG_ENDIAN = 5
Private Const REG_LINK = 6
Private Const REG_MULTI_SZ = 7
Private Const REG_RESOURCE_LIST = 8
Private Const REG_FULL_RESOURCE_DESCRIPTOR = 9
Private Const REG_RESOURCE_REQUIREMENTS_LIST = 10

Private Const MAX_VALUE_SIZE = 4096
Private Const MAX_KEY_SIZE = 256
Private Declare Sub CopyMem Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSource As Any, ByVal ByteLen As Long)

Public Event SearchFound(ByVal sKey As String, ByVal sValue As Variant, ByVal lFound As FOUN_WHERE)
Public Event SearchFinished(ByVal lReason As Long)

Dim lStopSearch As Long
'local variable(s) to hold property value(s)
Private mvarRootKey As ROOT_KEYS 'local copy
Private mvarSearchFlags As SEARCH_FLAGS 'local copy
Private mvarSearchString As String 'local copy
Private mvarSubKey As String 'local copy
Dim sSubKey As String

Public Property Let SubKey(ByVal vData As String)
    mvarSubKey = vData
End Property

Public Property Let SearchString(ByVal vData As String)
    mvarSearchString = vData
End Property

Public Property Let SearchFlags(ByVal vData As SEARCH_FLAGS)
    mvarSearchFlags = vData
End Property

Public Property Let RootKey(ByVal vData As ROOT_KEYS)
    mvarRootKey = vData
End Property

Public Sub DoSearch()
    If mvarRootKey <> HKEY_ALL Then
       Call EnumRegKeys(mvarRootKey, mvarSubKey)
    Else
       Call EnumRegKeys(HKEY_CLASSES_ROOT, mvarSubKey)
       If lStopSearch Then Exit Sub
       Call EnumRegKeys(HKEY_CURRENT_USER, mvarSubKey)
       If lStopSearch Then Exit Sub
       Call EnumRegKeys(HKEY_LOCAL_MACHINE, mvarSubKey)
       If lStopSearch Then Exit Sub
       Call EnumRegKeys(HKEY_USERS, mvarSubKey)
       If lStopSearch Then Exit Sub
       Call EnumRegKeys(HKEY_PERFORMANCE_DATA, mvarSubKey)
       If lStopSearch Then Exit Sub
       Call EnumRegKeys(HKEY_CURRENT_CONFIG, mvarSubKey)
       If lStopSearch Then Exit Sub
       Call EnumRegKeys(HKEY_DYN_DATA, mvarSubKey)
    End If
    RaiseEvent SearchFinished(lStopSearch)
    lStopSearch = 0
End Sub

Public Sub StopSearch()
    lStopSearch = 1
End Sub

Private Sub EnumRegKeys(ByVal lKeyRoot As Long, ByVal sSubKey As String)
    Dim curidx As Long
    Dim KeyName As String
    Dim hKey As Long
    Dim sTemp As String
    If lStopSearch Then Exit Sub
    On Error GoTo ErrEnum
    If RegOpenKeyEx(lKeyRoot, sSubKey, 0, KEY_READ, hKey) Then Exit Sub
    Do
      DoEvents
      KeyName = Space$(MAX_KEY_SIZE)
      If RegEnumKey(hKey, curidx, KeyName, MAX_KEY_SIZE) <> ERROR_SUCCESS Then Exit Do
      curidx = curidx + 1
      KeyName = TrimNull(KeyName)
      If sSubKey <> "" Then
         sTemp = sSubKey & "\" & KeyName
      Else
         sTemp = KeyName
      End If
      If (mvarSearchFlags And KEY_NAME) = KEY_NAME Then
         If CheckMatching(KeyName) Then
            RaiseEvent SearchFound(sTemp, "*", KEY_NAME)
         End If
      End If
      If (mvarSearchFlags And VALUE_NAME) = VALUE_NAME Or (mvarSearchFlags And VALUE_VALUE) = VALUE_VALUE Then
         Call EnumRegValues(lKeyRoot, sTemp)
      End If
      Call EnumRegKeys(lKeyRoot, sTemp)
    Loop
ErrEnum:
    If Err Then lStopSearch = Err
    RegCloseKey hKey
End Sub

Private Sub EnumRegValues(ByVal lKeyRoot As Long, ByVal sSubKey As String)
   Dim curidx As Long, ValueName As String, ValueValue As String
   Dim hKey As Long
   Dim lType As Long
   Dim arrData() As Byte
   Dim cbDataSize As Long
   If lStopSearch Then Exit Sub
   On Error GoTo ErrEnum
   If RegOpenKeyEx(lKeyRoot, sSubKey, 0, KEY_READ, hKey) Then Exit Sub
   ValueName = String(MAX_KEY_SIZE, 0)
   cbDataSize = MAX_VALUE_SIZE
   ReDim arrData(cbDataSize)
   Do
     ValueName = String(MAX_KEY_SIZE, 0)
     If RegEnumValue(hKey, curidx, ValueName, MAX_KEY_SIZE, 0&, lType, arrData(0), cbDataSize) <> ERROR_SUCCESS Then Exit Do
     ReDim Preserve arrData(cbDataSize - 1)
     ValueName = TrimNull(ValueName)
     If (mvarSearchFlags And VALUE_NAME) = VALUE_NAME Then
        If CheckMatching(ValueName) Then RaiseEvent SearchFound(sSubKey & "\" & ValueName, "*", VALUE_NAME)
     End If
     If (mvarSearchFlags And VALUE_VALUE) = VALUE_VALUE Then
        ValueValue = TrimNull(GetRegData(lType, arrData))
        If CheckMatching(ValueValue) Then
           RaiseEvent SearchFound(sSubKey & "\" & ValueName, ValueValue, VALUE_VALUE)
        End If
     End If
     curidx = curidx + 1
   Loop
ErrEnum:
   If Err Then lStopSearch = Err
   RegCloseKey hKey
End Sub

Private Function TrimNull(startstr As String) As String
   Dim pos As Integer
   pos = InStr(startstr, Chr$(0))
   If pos Then
      TrimNull = Left$(startstr, pos - 1)
      Exit Function
   End If
   TrimNull = startstr
End Function

Private Function CheckMatching(ByVal sCheck As String) As Boolean
   If (mvarSearchFlags And WHOLE_STRING) = WHOLE_STRING Then
      CheckMatching = (UCase(sCheck) = UCase(mvarSearchString))
   Else
      CheckMatching = InStr(1, sCheck, mvarSearchString, vbTextCompare)
   End If
End Function

Private Function GetRegData(ByVal lType As Long, abData() As Byte) As String
   Dim lData As Long, i As Long
   Dim sTemp As String
   sTemp = ""
   Select Case lType
        Case REG_SZ, REG_MULTI_SZ
             GetRegData = TrimNull(StrConv(abData, vbUnicode))
        Case REG_DWORD
             CopyMem lData, abData(0), 4&
             GetRegData = "0x" & Format(Hex(lData), "00000000") & "(" & lData & ")"
        Case REG_BINARY
             For i = 0 To UBound(abData)
                 sTemp = Right("00" & abData(i), 2) & " "
             Next i
             GetRegData = Left(sTemp, Len(sTemp) - 1)
        Case Else
             GetRegData = "Temporary usupported"
   End Select
End Function

Private Sub Class_Initialize()
   mvarSubKey = ""
   mvarRootKey = HKEY_ALL
End Sub

Private Sub Class_Terminate()
  lStopSearch = 1
End Sub

'=======USING - FORM CODE==========
Dim WithEvents cReg As cRegSearch

Private Sub Command1_Click()
  If Command1.Caption = "&Stop Search" Then
     cReg.StopSearch
     Exit Sub
  End If
  If Command1.Caption = "&Start Search" Then Command1.Caption = "&Stop Search" Else Command1.Caption = "&Start Search"
  cReg.RootKey = HKEY_LOCAL_MACHINE
'  cReg.SubKey = "Config"
  cReg.SearchFlags = KEY_NAME + VALUE_NAME + VALUE_VALUE
  cReg.SearchString = "microsoft"
  Caption = "Searching....."
  cReg.DoSearch
End Sub

Private Sub cReg_SearchFinished(ByVal lReason As Long)
   If lReason = 0 Then
      Caption = "Done!"
   ElseIf lReason = 1 Then
      Caption = "Terminated by user!"
   Else
      Caption = "An Error occured! Err number = " & lReason
'      Err.Raise lReason
   End If
End Sub

Private Sub cReg_SearchFound(ByVal sKey As String, ByVal sValue As Variant, ByVal lFound As FOUN_WHERE)
   Dim sTemp As String
   sTemp = "Found at: "
   Select Case lFound
         Case FOUND_KEY_NAME
              sTemp = sTemp & "KEY NAME"
         Case FOUND_VALUE_NAME
              sTemp = sTemp & "VALUE NAME"
         Case FOUND_VALUE_VALUE
              sTemp = sTemp & "VALUE VALUE"
   End Select
   On Error Resume Next
   Text1 = Text1 & vbCrLf & sTemp & " -> " & sKey & "; " & sValue
   If Err Then cReg.StopSearch
End Sub

Private Sub Form_Load()
   Command1.Caption = "&Start Search"
   Text1 = ""
   Set cReg = New cRegSearch
End Sub

Private Sub Form_Unload(Cancel As Integer)
   cReg.StopSearch
   Set cReg = Nothing
End Sub

0
 
ArkCommented:
PS, Sorry, didn't remove some extra API declarations/constants - it's just a "beta"

Cheers
0
 
ArkCommented:
Small bug found:

In GetRegDat function should be:
        Case REG_BINARY
             For i = 0 To UBound(abData)
                 sTemp = sTemp & Right("00" & Hex(abData(i)), 2) & " "
             Next i
             GetRegData = Left(sTemp, Len(sTemp) - 1)


Cheers

0
 
peternedAuthor Commented:
Tried this code but it returns Error #9 each time. That's on w2k sp1, later today I'll try it on NT and 9.x.
You define the string being searched in
cReg.SearchString = "microsoft" ,right?
Should I add some referencies to the project?
0
 
ArkCommented:
Sorry, this is just beta :)
To avoid #9 Error change This:

ReDim Preserve arrData(cbDataSize - 1)

to this

     If cbDataSize < 1 Then cbDataSize = 1
     ReDim Preserve arrData(cbDataSize - 1)

Cheers
0
 
peternedAuthor Commented:
Well, it works now, but does not return the value of what it founds, only the name.
It's also too slow, one search lasts 26 minutes(on P II 350 MHz 128MB RAM machine, with no other tasks running). It found the first matching value after 11 minutes, and as I see in the code it searches only under HKEY_LOCAL_MACHINE.
As a comparison regedit found the first match(for the same search) almost immediately if I search  under HKEY_LOCAL_MACHINE only, and for 45 seconds if I search the entire registry.
Later I'll test it on NT and 9.x
0
 
ArkCommented:
Hi
To get also Value, just change:
    If (mvarSearchFlags And VALUE_NAME) = VALUE_NAME Then
       If CheckMatching(ValueName) Then RaiseEvent SearchFound(sSubKey & "\" & ValueName, "*", VALUE_NAME)
    End If

to

    If (mvarSearchFlags And VALUE_NAME) = VALUE_NAME Then
       If CheckMatching(ValueName) Then RaiseEvent SearchFound(sSubKey & "\" & ValueName, TrimNull(GetRegData(lType, arrData)), VALUE_NAME)
    End If

As for performance - I'm sure RegEdit use not recursive API but direct File search.

Cheers
0
 
ArkCommented:
Hi
For NT you can use RegFind.exe utility (http://support.microsoft.com/support/kb/articles/q146/3/03.asp)
Also, take a look at this free ocx - http://www.freewarefilez.com/cgi-bin/links/jump.cgi?ID=2290

Cheers
0
 
ArkCommented:
Hi
Bugs fixed, code tested - OK.
Recently posted code to FreeVBCode.com

Performance - searching whole registry for missing string ("aa_bb_cc_dd_ee_ff") at my P166MMX 32M RAM:

RegEdit - 3 min. 50 sec.

My app (AVI ON, showing currently viewing key ON) - 6 min. 20 sec.
My app (AVI OFF, showing currently viewing key OFF - like RegEdit does) - 4 min. 40 sec.

'===========================
For PAQ - Class module code
'===========================

' Class for searching Windows Registry
'
' Written by Arkadiy Olovyannikov (ark@fesma.ru)
' Copyright 2001 by Arkadiy Olovyannikov
'
' This software is FREEWARE. You may use it as you see fit for
' your own projects but you may not re-sell the original or the
' source code.
'
' No warranty express or implied, is given as to the use of this
' program. Use at your own risk.

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 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 RegCloseKey Lib "advapi32.dll" (ByVal hKey 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

Enum ROOT_KEYS
     HKEY_ALL = &H0&
     HKEY_CLASSES_ROOT = &H80000000
     HKEY_CURRENT_USER = &H80000001
     HKEY_LOCAL_MACHINE = &H80000002
     HKEY_USERS = &H80000003
     HKEY_PERFORMANCE_DATA = &H80000004
     HKEY_CURRENT_CONFIG = &H80000005
     HKEY_DYN_DATA = &H80000006
End Enum

Enum SEARCH_FLAGS
     KEY_NAME = 0
     VALUE_NAME = 1
     VALUE_VALUE = 2
     WHOLE_STRING = 4
End Enum

Enum FOUND_WHERE
     FOUND_IN_KEY_NAME
     FOUND_IN_VALUE_NAME
     FOUND_IN_VALUE_VALUE
End Enum

Private Const STANDARD_RIGHTS_ALL = &H1F0000
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 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))
Const KEY_READ = &H20019  ' ((READ_CONTROL Or KEY_QUERY_VALUE Or
                          ' KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And (Not
                          ' SYNCHRONIZE))

Private Const ERROR_SUCCESS = 0&
Private Const ERR_MORE_DATA = 234&
Private Const ERROR_NO_MORE_ITEMS = 259&

Private Const REG_NONE = 0
Private Const REG_SZ = 1
Private Const REG_EXPAND_SZ = 2
Private Const REG_BINARY = 3
Private Const REG_DWORD = 4
Private Const REG_DWORD_LITTLE_ENDIAN = 4
Private Const REG_DWORD_BIG_ENDIAN = 5
Private Const REG_LINK = 6
Private Const REG_MULTI_SZ = 7
Private Const REG_RESOURCE_LIST = 8
Private Const REG_FULL_RESOURCE_DESCRIPTOR = 9
Private Const REG_RESOURCE_REQUIREMENTS_LIST = 10

Private Const MAX_KEY_SIZE = 256
Private Const MAX_VALUE_SIZE = 4096

Private Declare Sub CopyMem Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSource As Any, ByVal ByteLen As Long)

Public Event SearchFound(ByVal sRootKey As String, ByVal sKey As String, ByVal sValue As Variant, ByVal lFound As FOUND_WHERE)
Public Event SearchFinished(ByVal lReason As Long)
Public Event SearchKeyChanged(ByVal sFullKeyName As String)

Private mvarRootKey As ROOT_KEYS
Private mvarSearchFlags As SEARCH_FLAGS
Private mvarSearchString As String
Private mvarSubKey As String

Dim lStopSearch As Long

Public Property Let SubKey(ByVal vData As String)
    mvarSubKey = vData
End Property

Public Property Let SearchString(ByVal vData As String)
    mvarSearchString = vData
End Property

Public Property Let SearchFlags(ByVal vData As SEARCH_FLAGS)
    mvarSearchFlags = vData
End Property

Public Property Let RootKey(ByVal vData As ROOT_KEYS)
    mvarRootKey = vData
End Property

Public Sub DoSearch()
    If mvarRootKey <> HKEY_ALL Then
       Call EnumRegKeys(mvarRootKey, mvarSubKey)
    Else
       Call EnumRegKeys(HKEY_CLASSES_ROOT, mvarSubKey)
       If lStopSearch Then GoTo Search_Terminated
       Call EnumRegKeys(HKEY_CURRENT_USER, mvarSubKey)
       If lStopSearch Then GoTo Search_Terminated
       Call EnumRegKeys(HKEY_LOCAL_MACHINE, mvarSubKey)
       If lStopSearch Then GoTo Search_Terminated
       Call EnumRegKeys(HKEY_USERS, mvarSubKey)
       If lStopSearch Then GoTo Search_Terminated
       Call EnumRegKeys(HKEY_PERFORMANCE_DATA, mvarSubKey)
       If lStopSearch Then GoTo Search_Terminated
       Call EnumRegKeys(HKEY_CURRENT_CONFIG, mvarSubKey)
       If lStopSearch Then GoTo Search_Terminated
       Call EnumRegKeys(HKEY_DYN_DATA, mvarSubKey)
    End If
Search_Terminated:
    RaiseEvent SearchFinished(lStopSearch)
    lStopSearch = 0
End Sub

Public Sub StopSearch()
    lStopSearch = 1
End Sub

Private Sub EnumRegKeys(ByVal lKeyRoot As Long, ByVal sSubKey As String)
    Dim curidx As Long
    Dim KeyName As String
    Dim hKey As Long
    Dim sTemp As String
    If lStopSearch Then Exit Sub
    On Error GoTo ErrEnum
    If RegOpenKeyEx(lKeyRoot, sSubKey, 0, KEY_READ, hKey) Then Exit Sub
    Do
      DoEvents
      KeyName = Space$(MAX_KEY_SIZE)
      If RegEnumKey(hKey, curidx, KeyName, MAX_KEY_SIZE) <> ERROR_SUCCESS Then Exit Do
      curidx = curidx + 1
      KeyName = TrimNull(KeyName)
      If sSubKey <> "" Then
         sTemp = sSubKey & "\" & KeyName
      Else
         sTemp = KeyName
      End If
'****************************************************
'This event is used for showing currently viewing key.
'Usually you don't need this.
'To increase performance, remove this event
      If lStopSearch = 0 Then RaiseEvent SearchKeyChanged(RootKeyName(lKeyRoot) & "\" & sTemp)
'****************************************************
      If (mvarSearchFlags And KEY_NAME) = KEY_NAME Then
         If CheckMatching(KeyName) Then
            RaiseEvent SearchFound(RootKeyName(lKeyRoot), sTemp, "*", FOUND_IN_KEY_NAME)
         End If
      End If
      If (mvarSearchFlags And VALUE_NAME) = VALUE_NAME Or (mvarSearchFlags And VALUE_VALUE) = VALUE_VALUE Then
         Call EnumRegValues(lKeyRoot, sTemp)
      End If
      Call EnumRegKeys(lKeyRoot, sTemp)
    Loop
ErrEnum:
    If Err Then lStopSearch = Err
    RegCloseKey hKey
End Sub

Private Sub EnumRegValues(ByVal lKeyRoot As Long, ByVal sSubKey As String)
   Dim curidx As Long, ValueName As String, ValueValue As String
   Dim hKey As Long
   Dim lType As Long
   Dim arrData() As Byte
   Dim cbDataSize As Long
   If lStopSearch Then Exit Sub
   On Error GoTo ErrEnum
   If RegOpenKeyEx(lKeyRoot, sSubKey, 0, KEY_READ, hKey) Then Exit Sub
   ValueName = String(MAX_KEY_SIZE, 0)
   cbDataSize = MAX_VALUE_SIZE
   ReDim arrData(cbDataSize)
   Do
     ValueName = String(MAX_KEY_SIZE, 0)
     If RegEnumValue(hKey, curidx, ValueName, MAX_KEY_SIZE, 0&, lType, arrData(0), cbDataSize) <> ERROR_SUCCESS Then Exit Do
     If cbDataSize < 1 Then cbDataSize = 1
     ReDim Preserve arrData(cbDataSize - 1)
     ValueName = TrimNull(ValueName)
     If (mvarSearchFlags And VALUE_NAME) = VALUE_NAME Then
        If CheckMatching(ValueName) Then RaiseEvent SearchFound(RootKeyName(lKeyRoot), sSubKey & "\" & ValueName, GetRegData(lType, arrData), FOUND_IN_VALUE_NAME)
     End If
     If (mvarSearchFlags And VALUE_VALUE) = VALUE_VALUE Then
        ValueValue = TrimNull(GetRegData(lType, arrData))
        If CheckMatching(ValueValue) Then
           RaiseEvent SearchFound(RootKeyName(lKeyRoot), sSubKey & "\" & ValueName, ValueValue, FOUND_IN_VALUE_VALUE)
        End If
     End If
     curidx = curidx + 1
   Loop
ErrEnum:
   If Err Then lStopSearch = Err
   RegCloseKey hKey
End Sub

Private Function TrimNull(startstr As String) As String
   Dim pos As Integer
   pos = InStr(startstr, Chr$(0))
   If pos Then
      TrimNull = Left$(startstr, pos - 1)
      Exit Function
   End If
   TrimNull = startstr
End Function

Private Function CheckMatching(ByVal sCheck As String) As Boolean
   If (mvarSearchFlags And WHOLE_STRING) = WHOLE_STRING Then
      CheckMatching = (UCase(sCheck) = UCase(mvarSearchString))
   Else
      CheckMatching = InStr(1, sCheck, mvarSearchString, vbTextCompare)
   End If
End Function

Private Function GetRegData(ByVal lType As Long, abData() As Byte) As String
   Dim lData As Long, i As Long
   Dim sTemp As String
   sTemp = ""
   Select Case lType
        Case REG_SZ, REG_MULTI_SZ
             GetRegData = TrimNull(StrConv(abData, vbUnicode))
        Case REG_DWORD
             CopyMem lData, abData(0), 4&
             GetRegData = "0x" & Format(Hex(lData), "00000000") & "(" & lData & ")"
        Case REG_BINARY
             For i = 0 To UBound(abData)
                 sTemp = sTemp & Right("00" & Hex(abData(i)), 2) & " "
             Next i
             GetRegData = Left(sTemp, Len(sTemp) - 1)
        Case Else
             GetRegData = "Temporary unsupported"
   End Select
End Function

Private Function RootKeyName(lKey As Long) As String
   Select Case lKey
       Case HKEY_CLASSES_ROOT: RootKeyName = "HKEY_CLASSES_ROOT"
       Case HKEY_CURRENT_USER: RootKeyName = "HKEY_CURRENT_USER"
       Case HKEY_LOCAL_MACHINE: RootKeyName = "HKEY_LOCAL_MACHINE"
       Case HKEY_USERS: RootKeyName = "HKEY_USERS"
       Case HKEY_PERFORMANCE_DATA: RootKeyName = "HKEY_PERFORMANCE_DATA"
       Case HKEY_CURRENT_CONFIG: RootKeyName = "HKEY_CURRENT_CONFIG"
       Case HKEY_DYN_DATA: RootKeyName = "HKEY_DYN_DATA"
   End Select
End Function
Private Sub Class_Initialize()
   mvarRootKey = HKEY_ALL
   mvarSubKey = ""
   mvarSearchString = ""
End Sub

Private Sub Class_Terminate()
  lStopSearch = 1
End Sub

'== I'll post here a link when code will be published==

Cheers
0
 
peternedAuthor Commented:
Well I had troubles with this, it didn't work with the previous form you posted. But what you uploaded to freevbcode works fine and much faster than before.
Thanks
0
 
ArkCommented:
Thanks for points, glad I could help you. I see you alreadt find this code. Here is a link:
http://www.freevbcode.com/ShowCode.Asp?ID=3175

Cheers
0
 
wileecoyCommented:
Ark,

Excellent code - great interface.

Especially like the way your controls resize with the form.

Well Done!

Wileecoy
0
 
ArkCommented:
Thanks :)
0

Featured Post

Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

  • 9
  • 6
  • 3
  • +3
Tackle projects and never again get stuck behind a technical roadblock.
Join Now