Regedit Wrappers

Sub BackupRegKey(sKey, FolBackup, bLog)
 ' Back up sKey to subfolder of folbackup;
 ' subfolder named with current date
 ' reg file named with time and master key path
 ' bLog determines whether this will be logged locally
 ' TargetFolder will be created if it does not exist
 ' DEPENDENCIES: md, fWrite, RegeditRead, LogInfoEvent
 TargetFolder = FolBackup
 If  Mid(TargetFolder, Len(TargetFolder))<>"\" Then _
  TargetFolder = TargetFolder & "\"
 TargetFolder = TargetFolder & DateString8
 TargetFile = TargetFolder & "\" & Replace(sKey,"\", "-") _
  & "_" & TimeString5 &  ".reg"
 md TargetFolder
 fWrite TargetFile, RegeditRead(sKey)
 If bLog Then LogInfoEvent sKey & "backed up to " & TargetFile, ""
End Sub

Function RegeditSearch(sSearch, sKey)
 ' Returns array of matches found in the registry
 ' If SubKey is not blank, restricts the search
 ' returns array with elements in form
 ' [Registry-Key-Path]"Valuename"="Value"
 ' Based on a script by Bill James (http://www.billsway.com)
 Dim Sh : Set Sh = CreateObject("WScript.Shell")
 Dim FSO : Set FSO = CreateObject("Scripting.FileSystemObject")
 Dim Fil, eRegLine, sRegKey, aRegFileLines, aTmp(), sCmd
 Fil = FSO.GetTempName
 sCmd = "regedit /s /a " & Fil & " " & """" _
  & sKey & """"
 Sh.Run sCmd, , True
 '/a enables export as Ansi for WinXP
  With FSO.GetFile(Fil)
   aRegFileLines = Split(.OpenAsTextStream(1, 0).Read(.Size), vbcrlf)
  End With
  FSO.DeleteFile(Fil)
 ReDim aTmp(-1)
  For Each eRegLine In aRegFileLines
   If InStr(1, eRegLine, "[", 1) > 0 Then sRegKey = eRegLine
   If InStr(1, eRegLine, sSearch, 1) >  0 Then
    ReDim Preserve aTmp(UBound(aTmp)+1)
    If sRegKey <> eRegLine Then
     aTmp(UBound(aTmp)) = sRegKey & eRegLine
    Else
     aTmp(UBound(aTmp)) = sRegKey
    End If
   End If
  Next
  RegeditSearch = aTmp
End Function

Function RegDictionary(sRegData)
 ' Populates a dictionary from regedit
 ' export file formatted text
 Dim aData, i, aTmp
 sData = Replace(UtfRead(sRegData), _
  vbCrLf & vbCrLf,vbCrLf)
 aData = Split(sData,vbCrLf & "[")
 Set RegDictionary = CreateObject( _
  "Scripting.Dictionary")
 For i = 1 To UBound(aData)-1
  aTmp = split(aData(i), "]")
  RegDictionary.add "[" & aTmp(0) _
   & "]",aTmp(1)
 Next
End Function

Function RegeditRead(sKey)
 ' Exports sKey from registry to a variable
 ' PROCEDURE DEPENDENCIES: fRead
 Dim Sh, sCmd, fTmp
 With CreateObject("Scripting.FileSystemObject")
  fTmp = .GetTempName
  Set Sh = CreateObject("WScript.Shell")
  sCmd = "regedit /s /e """ & fTmp & """ " & """" & sKey & """"
  Sh.Run sCmd,0,True
  RegeditRead = fRead(fTmp)
  .DeleteFile fTmp
 End With
End Function

Sub RegExport(sKey, Fil)
 ' Exports sKey from registry to Fil
 Dim Sh, sCmd
 Set Sh = CreateObject("WScript.Shell")
 sCmd = "regedit /s /e """ & Fil & """ " & """" & sKey & """"
 Sh.Run sCmd,0,True
End Sub

Sub RegImport( filPath, bWait)
 ' Imports a regfile into the registry
 CreateObject("WScript.Shell").Run "regedit /s " _
  & filPath, 0, bWait
End Sub

Sub RemoveKey(sKey)
 ' Removes Registry key and everything underneath it
 Const ForReading = 1
 Const ForWriting = 2
 Const ForAppending = 8
 Dim header, sData, FSO, sTmp, fTmp, tsTmp
 header = "REGEDIT4" & vbCrLf & vbCrLf
 sData = header & "[-" & sKey & "]" & vbCrLf
 Set FSO = CreateObject("Scripting.FileSystemObject")
 sTmp = FSO.GetAbsolutePathName(FSO.GetTempName)
 FSO.CreateTextFile(sTmp)
 Set fTmp = FSO.GetFile(sTmp)
 Set tsTmp = fTmp.OpenAsTextStream(ForWriting, True)
 tsTmp.Write(sData): tsTmp.Close
 CreateObject("WScript.Shell").Run "%COMSPEC% /C regedit /s " _
  & Chr(34) & sTmp & Chr(34), 0, True
 FSO.DeleteFile sTmp, True
End Sub