Browse DevX
Sign up for e-mail newsletters from DevX

Tip of the Day
Language: VB5,VB6
Expertise: Intermediate
Jun 9, 2001



Building the Right Environment to Support AI, Machine Learning and Deep Learning

SaveRegToFile - Save a registry subkey to a .reg file

Private Const HKEY_CLASSES_ROOT = &H80000000
Private Const HKEY_CURRENT_CONFIG = &H80000005
Private Const HKEY_CURRENT_USER = &H80000001
Private Const HKEY_LOCAL_MACHINE = &H80000002
Private Const HKEY_USERS = &H80000003

'Save the specified registry's key and (optionally) its subkeys to a REG file 
' that can be loaded later
' - hKey is the root key
' - sKeyName is the key to save to the file
' - sRegFile is the target file where the text will be saved
' - bIncludeSubKeys specifies whether the routine will save also the subkeys
' - bAppendToFile specifies wheter the generated text will be appended to an 
' existent file
'  SaveRegToFile HKEY_CURRENT_USER, "Software\Microsoft\Visual Basic\6.0",
'  "C:\vb6.reg"

'NOTE: this routine requires EnumRegistryKeys and EnumRegistryValuesEx

Sub SaveRegToFile(ByVal hKey As Long, ByVal sKeyName As String, _
    ByVal sRegFile As String, Optional ByVal bIncludeSubKeys As Boolean = True, _
    Optional ByVal bAppendToFile As Boolean = False)
    Dim handle As Integer
    Dim sFirstKeyPart As String
    Dim col As New Collection
    Dim regItem As Variant
    Dim sText As String
    Dim sQuote As String
    Dim sTemp As String
    Dim sHex As String
    Dim i As Long
    Dim vValue As Variant
    Dim iPointer As MousePointerConstants
    Dim sValueName As String
    sQuote = Chr$(34)
    On Error Resume Next
    'conver the hKey value to the descriptive string
    Select Case hKey
        Case HKEY_CLASSES_ROOT: sFirstKeyPart = "HKEY_CLASSES_ROOT\"
        Case HKEY_CURRENT_USER: sFirstKeyPart = "HKEY_CURRENT_USER\"
        Case HKEY_USERS: sFirstKeyPart = "HKEY_USERS\"
    End Select
    'this can be a long operation
    iPointer = Screen.MousePointer
    Screen.MousePointer = vbHourglass
    'if the text won't be appended, add the "REGEDIT4" header
    If bAppendToFile = False Then
        sText = "REGEDIT4" & vbCrLf & vbCrLf
        'add the same header if the text will be appended to an
        'existent file that does not contain the header. 
        ' This works only if the file exists but is empty.
        handle = FreeFile
        Open sRegFile For Binary As #handle
        ' read the string and close the file
        sTemp = Space$(LOF(handle))
        Get #handle, , sTemp
        Close #handle
        'if not found, add it
        If InStr(1, sTemp, "REGEDIT4") = 0 Then
            sText = "REGEDIT4" & vbCrLf & vbCrLf
        End If
    End If
    'save the key name with the format [keyname]
    sText = sText & "[" & sFirstKeyPart & sKeyName & "]" & vbCrLf
    'get the collection with all the values under this key
    Set col = EnumRegistryValuesEx(hKey, sKeyName)
    For Each regItem In col
        vValue = regItem(1)
        Select Case regItem(2)
            Case vbString
                'if the value is a string, check if it's a path by looking if 
                ' the 3 characters
                'are in the form X:\. If so, replace a single "\" with "\\"
                If Left$(vValue, 3) Like "[A-Z,a-z]:\" Then vValue = Replace _
                    (vValue, "\", "\\")
                'quote it
                sTemp = sQuote & vValue & sQuote
            Case vbLong
                'if it's a long, save it with the format dword:num
                sTemp = "dword:" & CLng(vValue)
            Case vbArray + vbByte
                'if it's an array of bytes, save it with the format hex:num1,
                ' num2,num3,...
                sTemp = "hex:"
                For i = 0 To UBound(vValue)
                    sHex = Hex$(vValue(i))
                    'convert from long to hex
                    If Len(sHex) < 2 Then sHex = "0" & sHex
                    sTemp = sTemp & sHex & ","
                'remove the last comma
                sTemp = Left$(sTemp, Len(sTemp) - 1)
            Case Else
                sTemp = ""
        End Select
        'get the value name: if the string is empty, take @,
        '  else take that name and quote it
        sValueName = IIf(Len(regItem(0)) > 0, sQuote & regItem(0) & sQuote, "@")
        'save this line to the temporary text that will be saved
        sText = sText & sValueName & "=" & sTemp & vbCrLf
    sText = sText & vbCrLf
    handle = FreeFile
    'open the target file with Append or Output mode,
    '  according to the bAppendToFile parameter
    If bAppendToFile Then
        Open sRegFile For Append As #handle
        Open sRegFile For Output As #handle
    End If
    'save the text
    Print #handle, sText;
    Close #handle
    'call recursively this routine to save all the subkeys,
    '  if the bIncludeSubKeys param is true
    If bIncludeSubKeys Then
        Set col = EnumRegistryKeys(hKey, sKeyName)
        For Each regItem In col
            'note: the text will be added to the file just created for the
            'values in the root key
            SaveRegToFile hKey, sKeyName & "\" & regItem, sRegFile, True, True
    End If
    Screen.MousePointer = iPointer
End Sub

Marco Bellinaso
Comment and Contribute






(Maximum characters: 1200). You have 1200 characters left.



Thanks for your registration, follow us on our social networks to keep up-to-date