Loop through the registry 2

[asid]

Hi

I need to loop through a part of the registry. I will not know the name of all the keys. The part of the registry I need to loop through is:

HKEY_LOCAL_MACHINE\Software\Microsoft\Windows NT\CurrentVersion\Print\Printers

Someone may have 5 printers installed. I need to go through each key in the registry and go into a sub key and get the printer driver name value.

Does anyone have any ideas about how to loop through the keys in a registry tree when the names are unkown?

TIA

Antony

 

[VBslammer]

This works on my XP box, haven't tested on NT or 9x:

'@------------- API Constants for Win32 Reg. -------------@

Public Const REG_SZ = 1
Public Const REG_EXPAND_SZ = 2
Public Const REG_BINARY = 3
Public Const REG_DWORD = 4

Public 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 = &H80000006

Public Const ERROR_SUCCESS = 0&
Public Const ERROR_ACCESS_DENIED = 5&
Public Const ERROR_MORE_DATA = 234&
Public Const ERROR_NO_MORE_ITEMS = 259&
Public Const ERROR_BADKEY = 1010&
Public Const ERROR_CANTOPEN = 1011&
Public Const ERROR_CANTREAD = 1012&
Public Const ERROR_REGISTRY_CORRUPT = 1015&

Public Const REG_OPTION_NON_VOLATILE = 0
Public Const REG_CREATED_NEW_KEY = &H1
Public Const REG_OPENED_EXISTING_KEY = &H2

Public Const KEY_QUERY_VALUE = &H1
Public Const KEY_ENUMERATE_SUB_KEYS = &H8
Public Const KEY_NOTIFY = &H10
Public Const READ_CONTROL = &H20000
Public Const STANDARD_RIGHTS_ALL = &H1F0000
Public Const STANDARD_RIGHTS_EXECUTE = (READ_CONTROL)
Public Const STANDARD_RIGHTS_READ = (READ_CONTROL)
Public Const STANDARD_RIGHTS_REQUIRED = &HF0000
Public Const SYNCHRONIZE = &H100000
Public Const KEY_SET_VALUE = &H2
Public Const KEY_CREATE_SUB_KEY = &H4
Public Const KEY_CREATE_LINK = &H20
Public Const STANDARD_RIGHTS_WRITE = (READ_CONTROL)
Public Const KEY_READ = ((STANDARD_RIGHTS_READ Or _
  KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or _
  KEY_NOTIFY) And (Not SYNCHRONIZE))
Public Const KEY_WRITE = ((STANDARD_RIGHTS_WRITE Or _
  KEY_SET_VALUE Or KEY_CREATE_SUB_KEY) And _
  (Not SYNCHRONIZE))
Public 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))


'@----------------------- Types -------------------------@

Public Type FILETIME
  dwLowDateTime As Long
  dwHighDateTime As Long
End Type

Public Type PrinterInfo
  PrinterName As String
  PrinterDriver As String
  Port As String
End Type

'@---------------------- Declares -----------------------@

Public 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

Public 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, _
dwSize As Long) As Long

Public Declare Function RegCloseKey Lib "advapi32.dll" _
(ByVal hKey As Long) As Long

Public 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

Public Declare Function RegQueryInfoKey Lib "advapi32.dll" Alias _
"RegQueryInfoKeyA" (ByVal hKey As Long, ByVal lpClass As String, _
lpcbClass As Long, ByVal lpReserved As Long, lpcSubKeys As Long, _
lpcbMaxSubKeyLen As Long, lpcbMaxClassLen As Long, lpcValues As Long, _
lpcbMaxValueNameLen As Long, lpcbMaxValueLen As Long, lpcbSecurityDescriptor _
As Long, lpftLastWriteTime As FILETIME) As Long


'@---------------------------------------------------------------@
'@  PURPOSE: Sample function to call GetPrinterInfo(strValue).
'@---------------------------------------------------------------@
Function RunPrinters()
On Error GoTo ErrHandler

  Dim lngCtr As Long
  Dim pinfo() As PrinterInfo
  
  ' Call the registry function
  pinfo = GetPrinterInfo("Printer Driver")
  
  ' verify results
  For lngCtr = LBound(pinfo) To UBound(pinfo)
    With pinfo(lngCtr)
      Debug.Print .PrinterName; Tab(30); .PrinterDriver; Tab(60); .Port
      Debug.Print String(80, "*")
    End With
  Next lngCtr

ExitHere:
  Exit Function
ErrHandler:
  Debug.Print "Error: " & Err & "-" & Err.Description
  Resume ExitHere
End Function

'@---------------------------------------------------------------@
'@  PURPOSE: Read registry for printer info (string values only).
'@  NOTES  : This function targets a specific value, could modify
'@           to enumerate all printer values.
'@  RETURNS: Array of user-defined type (PrinterInfo)
'@           - PrinterInfo(index).PrinterName
'@           - PrinterInfo(index).PrinterDriver
'@           - PrinterInfo(index).Port
'@---------------------------------------------------------------@
Function GetPrinterInfo(ByVal strValue As String) As PrinterInfo()
On Error GoTo ErrHandler

  Dim hKey            As Long           ' handle to the registry key
  Dim subKey          As Long           ' enumerated subkey
  Dim retVal          As Long           ' API return value
  Dim strKey          As String         ' Key to query
  Dim keyCount        As Long           ' Number of subkeys
  Dim lngCnt          As Long           ' Loop counter
  Dim strTemp         As String         ' Temp string
  Dim strRetVal       As String         ' key value
  Dim lngSize         As Long           ' Max subkey size
  Dim FT              As FILETIME       ' File write info
  Dim udtPrtInfo()    As PrinterInfo    ' Array for function return values
  
  strKey = "Software\Microsoft\Windows NT\CurrentVersion\Print\Printers"
  
  ' Open the registry key to enumerate the values of.
  retVal = RegOpenKeyEx(HKEY_LOCAL_MACHINE, strKey, 0, _
                          KEY_QUERY_VALUE, hKey)
  
  ' Check to see if an error occured.
  If retVal <> 0 Then
    Debug.Print &quot;Registry key could not be opened. Error: &quot; & retVal
    GoTo ExitHere
  End If
  
  ' Get the number of keys below the main key, and the largest string size.
  retVal = RegQueryInfoKey(hKey, 0, 0, 0, keyCount, _
                             lngSize, 0, 0, 0, 0, 0, FT)
  
  ' Check results again.
  If (retVal <> ERROR_SUCCESS) Or (keyCount <= 0) Then
    Debug.Print &quot;Subkey count undetermined. Error: &quot; & retVal & _
                &quot;  Key Count: &quot; & keyCount
    GoTo ExitHere
  End If
  
  ' Close the key because it needs to be re-opened with KEY_READ access.
  retVal = RegCloseKey(hKey)
  
  ' Reopen with proper SAM level.
  retVal = RegOpenKeyEx(HKEY_LOCAL_MACHINE, strKey, 0, KEY_READ, hKey)
  
  If retVal <> ERROR_SUCCESS Then
    Debug.Print &quot;Could not open key - Error level: &quot; & retVal
    GoTo ExitHere
  End If
  
  ' Place all subkey names in udt array.
  ReDim udtPrtInfo(keyCount - 1)
  
  ' Loop through keys and get &quot;Printer Driver&quot; values.
  For lngCnt = 0 To keyCount - 1
    
    ' initialize the return string.
    strRetVal = String(lngSize, 0)
    
    ' get the KEY name for each index below main key.
    retVal = RegEnumKey(hKey, lngCnt, strRetVal, lngSize)
    
    ' trim the null terminated string.
    udtPrtInfo(lngCnt).PrinterName = StripNulls(strRetVal)
    
    ' Open this subkey
    retVal = RegOpenKeyEx(hKey, udtPrtInfo(lngCnt).PrinterName, _
                           0, KEY_QUERY_VALUE, subKey)
    
    ' if success, we're ready to get a value for this key.
    If retVal = ERROR_SUCCESS Then
      
      ' initialize return string.
      strRetVal = String(255, 0)

      retVal = RegQueryValueEx(subKey, strValue, 0&, _
                                 REG_SZ, ByVal strRetVal, 255)
      
      ' if success, assign value to appropriate type.
      If retVal = ERROR_SUCCESS Then
        Select Case UCase(strValue)
          Case &quot;PRINTER DRIVER&quot;
            udtPrtInfo(lngCnt).PrinterDriver = StripNulls(strRetVal)
          Case &quot;NAME&quot;
            udtPrtInfo(lngCnt).PrinterName = StripNulls(strRetVal)
          Case &quot;PORT&quot;
            udtPrtInfo(lngCnt).Port = StripNulls(strRetVal)
          Case Else
            ' handle unknown type here.
        End Select
      End If
      
      ' close it up.
      retVal = RegCloseKey(subKey)
      
    End If
  Next lngCnt
  
  ' done with the key, close it.
  retVal = RegCloseKey(hKey)
  
  ' return udt.
  GetPrinterInfo = udtPrtInfo
  
ExitHere:
  Exit Function
ErrHandler:
  Debug.Print &quot;Error: &quot; & Err & &quot;-&quot; & Err.Description
  Resume ExitHere
End Function

@---------------------------------------------------------@

Function StripNulls(ByVal szString As String) As String
  Dim i As Integer  
  i = InStr(szString, Chr$(0))  
  If i > 0 Then
    StripNulls = Left$(szString, i - 1)
  Else
    StripNulls = szString
  End If  
End Function

VBSlammer

 

[asid]

Hey VBSlammer

Thanks for the post. Looks really comprehensive.

BTW, I should have mentioned that XP was my OS.

I'll start playing with this ASAP.

Thanks again

Antony