'HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\DNS Server
Sub ExportKey(FileName, KeyPath, MachineName, Unicode)
Dim S, Key, Out
'Get RegEdit.Server object
Set S = CreateObject("RegEdit.Server")
If Unicode Then
Out = "Windows Registry Editor Version 5.00"
Else
Out = "REGEDIT4"
End If
If Len(MachineName)>0 Then
s.Connect MachineName
End If
Set Key = s.GetKey(KeyPath)
'Get the registry data as a string
Out = Out & ExportOneKey(Key)
'Save the data to a file.
SaveFile FileName, Out, Unicode
End Sub
'Exports registry key to
Function ExportOneKey(Key)
On Error Resume Next
Dim Out, Value, SubKey
'wscript.echo "key:" & key.Name
'First line contains full path to the key in [] brackets
Out = vbCrLf & "[" & Key.Path & "]"
'Process each value.
For Each Value In Key.Values
'begin of the line - name of the value in quotes.
If Len(Value.Name) = 0 Then
Out = Out & vbCrLf & "@="
Else
Out = Out & vbCrLf & """" & Replace(Value.Name, """", "\""") & """="
End If
'Out each value by it's type.
Select Case Value.Type
Case vtDWord
Out = Out & "dword:" & Right("00000000" & LCase(Hex(Value.Value)), 8)
Case vtBinary
Out = Out & "hex:" & ToHex(Value.Binary, Len(Value.Name)+6)
Case vtString
Out = Out & """" & Replace(Value.Value, "\", "\\") & """"
Case Else
Out = Out & "hex(" & Value.Type & "):" & ToHex(Value.Binary, Len(Value.Name)+10)
End Select
Next
'Export subkeys
For Each SubKey In Key.SubKeys
Out = Out & ExportOneKey(SubKey)
Next
ExportOneKey = vbCrLf & Out
End Function
'Converts value to hex string separated by comma
Function ToHex(Value, C)
Dim Out, I
For I=1 To LenB(Value)
C = C + 3
If C>77 Then
Out = Out & "\" & vbCrLf & " "
c=3
End If
Out = Out & Right("0" & Hex(AscB(MidB(Value,I,1))), 2) & ","
Next
ToHex = LCase(Left(Out,Len(out)-1))
End Function
'*********************** Process command line
If Wscript.Arguments.Count < 1 Then
do_Help
Wscript.Quit
End If
Dim sKey, FileName, MachineName, Unicode
Unicode = True
'Read the script arguments
'First read and normalize the key path.
sKey = Wscript.Arguments(0)
If Right(sKey,1) = "\" Then sKey = Left(sKey, Len(sKey)-1)
If Left(sKey,2) = "\\" Then
Dim Pos
Pos = Instr(3, sKey, "\", 1)
MachineName = Mid(sKey, 3, Pos-1-2)
sKey = Mid(sKey, Pos+1)
End If
'second parameter is filename, or 95 - format.
If Wscript.Arguments.Count > 1 Then
FileName = Wscript.Arguments(1)
If FileName = "95" Then
Unicode = False
End If
End If
'Set default file name if the parameter is not specified
If Len(FileName) = 0 Then
FileName = Replace(sKey, "\", "_") & ".reg"
End If
'Normalize file name.
If Instr(FileName, ".") = 0 Then FileName = FileName & ".reg"
'Read the fourth optional agrument - 95 format.
If Wscript.Arguments.Count > 3 Then
Unicode = Wscript.Arguments(2)
If Unicode = "95" Then
Unicode = False
End If
End If
Wscript.Echo "Export of key: " & sKey & vbCrLf & _
"Machine name: " & MachineName & vbCrLf & _
"File name: " & FileName
'call export function
ExportKey FileName, sKey, MachineName, Unicode
Wscript.Quit
'*********************** Support functions
Sub do_Help
Wscript.Echo "Export registry key in Win9x/NT4 and unicode format" & vbCrLf & _
"2005 Antonin Foller, Motobit software" & vbCrLf & _
"" & vbCrLf & _
"run exportkey.vbs [\\machinename\]keypath [filename] [95]" & vbCrLf & _
"machinename - name or IP of the computer to export" & vbCrLf & _
"keypath - full registry path" & vbCrLf & _
"filename - file to export data" & vbCrLf & _
"95 - the export will be in Win9x/NT4 format" & vbCrLf & _
"" & vbCrLf & _
"samples" & vbCrLf & _
"exportkey.vbs ""HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\DNS Server""" & vbCrLf & _
" - exports 'DNS Server' key on local computer in Unicode format" & vbCrLf & _
"" & vbCrLf & _
"exportkey.vbs ""HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Office"" ms.reg 95" & vbCrLf & _
" - exports 'Office' key on local computer in Win95 format" & vbCrLf & _
"" & vbCrLf & _
"exportkey.vbs ""\\gen\HKLM\SOFTWARE\Microsoft\Intelligent Search"" 95" & vbCrLf & _
" - exports 'Intelligent Search' key on 'gen' computer in Win95 format"
End Sub
'Saves string as a text file.
Sub SaveFile(FileName, Contents, Unicode)
If Len(FileName)>0 Then
Dim FileStream, FS
Set FS = CreateObject("Scripting.FileSystemObject")
' wscript.echo "fn:" & FileName
Set FileStream = FS.CreateTextFile(FileName, True, Unicode)
FileStream.Write Contents
End If
End Sub
'ValueType - begin
Public Const vtNone = &H0 'No value type
Public Const vtString = &H1 'Nul terminated string
Public Const vtExpandString = &H2 'Nul terminated string (with environment variable references)
Public Const vtBinary = &H3 'Free form binary
Public Const vtDWord = &H4 '32-bit number
Public Const vtDWordBigEndian = &H5 '32-bit number. In big-endian format, the most significant byte of a word is the low-order byte.
Public Const vtLink = &H6 'Symbolic Link (unicode)
Public Const vtMultiString = &H7 'Multiple strings
Public Const vtResourceList = &H8 'Resource list in the resource map
Public Const vtFullResourceDescriptor = &H9 'Resource list in the hardware description
Public Const vtResourceRequirementsList = &HA
'ValueType - end |