Option Explicit

Dim intCounter, intRC, intArgs
Dim objFile, objFSO
Dim strComment, strComputer, strDisclaimer, strFile, strKey, strVersion

strVersion  = "0.0.2 alpha"
strComment  = ""
intCounter  = 0

With WScript.Arguments
	intArgs = 0
	If .Unnamed.Count > 0 Then Syntax
	If .Named.Count   < 2 Then Syntax
	If .Named.Exists( "C" ) Then
		strComputer = .Named.Item( "C" )
		intArgs     = intArgs + 1
		If Trim( strComputer ) = "" Then Syntax
	Else
		strComputer = "."
	End If
	If .Named.Exists( "F" ) Then
		strFile = .Named.Item( "F" )
		intArgs = intArgs + 1
		If Trim( strFile ) = "" Then Syntax
	End If
	If .Named.Exists( "R" ) Then
		strKey  = .Named.Item( "R" )
		intArgs = intArgs + 1
		If Trim( strKey ) = "" Then Syntax
		If Left( UCase( strKey ), 5 ) <> "HKEY_" Then Syntax
		If InStr( strKey, "\" ) = 0 Then Syntax
	End If
	If .Named.Count <> intArgs Then Syntax
End With

intRC = ConvertReg( strKey, strFile )

WScript.Quit intRC


Function ConvertReg( myRegPath, myFileName )
' This subroutine will read the specified registry key FROM any machine and
' create KiXtart and VBScript scripts to RECREATE this key on any other machine
	ConvertReg = 1
	intCounter = intCounter + 1

	Dim arrHives, arrKey, arrSubKeys, arrTypes, arrValueNames, arrValueTypes
	Dim blnValid, blnWriteDisclaimer
	Dim i, intHive, intRC
	Dim objFSO, objReg, objKiXtartFile, objVBScriptFile
	Dim strFileName, strHeader, strKiXtartFile, strLine, strValue, strVBScriptFile
	Dim varValue

	' Hive constants
	Const HKEY_CLASSES_ROOT   = &H80000000
	Const HKEY_CURRENT_USER   = &H80000001
	Const HKEY_LOCAL_MACHINE  = &H80000002
	Const HKEY_USERS          = &H80000003
	Const HKEY_CURRENT_CONFIG = &H80000005
	Const HKEY_DYN_DATA       = &H80000006 ' Windows 95/98 only

	' Array to convert constants' values back to their names
	arrHives = Array( "HKEY_CLASSES_ROOT",   _
	                  "HKEY_CURRENT_USER",   _
	                  "HKEY_LOCAL_MACHINE",  _
	                  "HKEY_USERS",          _
	                  "",                    _
	                  "HKEY_CURRENT_CONFIG", _
	                  "HKEY_DYN_DATA"        )

	' Value types constants
	Const REG_SZ                         =  1
	Const REG_EXPAND_SZ                  =  2
	Const REG_BINARY                     =  3
	Const REG_DWORD                      =  4
	Const REG_DWORD_BIG_ENDIAN           =  5 ' Handled like ordinary DWORD
	Const REG_LINK                       =  6 ' Not supported by this script
	Const REG_MULTI_SZ                   =  7
	Const REG_RESOURCE_LIST              =  8 ' Not supported by this script
	Const REG_FULL_RESOURCE_DESCRIPTOR   =  9 ' Not supported by this script
	Const REG_RESOURCE_REQUIREMENTS_LIST = 10 ' Not supported by this script
	Const REG_QWORD                      = 11 ' Windows Vista/Server 2008 only, not supported by this script

	' Array to convert constants' values back to their names
	arrTypes = Array( "",                               _
	                  "REG_SZ",                         _
	                  "REG_EXPAND_SZ",                  _
	                  "REG_BINARY",                     _
	                  "REG_DWORD",                      _
	                  "REG_DWORD_BIG_ENDIAN",           _
	                  "REG_LINK",                       _
	                  "REG_MULTI_SZ",                   _
	                  "REG_RESOURCE_LIST",              _
	                  "REG_FULL_RESOURCE_DESCRIPTOR",   _
	                  "REG_RESOURCE_REQUIREMENTS_LIST", _
	                  "REG_QWORD"                       )

	' I/O mode constants
	Const ForReading   = 1
	Const ForWriting   = 2
	Const ForAppending = 8

	' ASCII/Unicode constants
	Const TristateUseDefault = -2
	Const TristateMixed      = -2
	Const TristateTrue       = -1
	Const TristateFalse      =  0

	' Split specified registry path into the hive name and the rest
	arrKey = Split( myRegPath, "\", 2 )
	' Check if the specified key is valid
	If Not IsArray( arrkey ) Then Exit Function
	If UBound( arrkey ) <> 1 Then Exit Function
	blnValid = False
	For i = 0 To UBound( arrHives )
		If arrHives(i) = UCase( arrKey(0) ) Then
			intHive  = &H80000000 + i
			blnValid = True
		End If
	Next
	If Not blnValid Then Exit Function

	' Read the specified file name, strip its extension
	Set objFSO = CreateObject( "Scripting.FileSystemObject" )
	With objFSO
		strFileName = .BuildPath( .GetParentFolderName( myFileName ), .GetBaseName( myFileName ) )
	End With
	' Append extensions for the scripts to be generated
	strKiXtartFile  = strFileName & ".kix"
	strVBScriptFile = strFileName & ".vbs"
	strHeader       = WriteHeader( "KiXtart" )
	' Open the existing files or create new ones, and
	' write a header if the files don't already have one
	If objFSO.FileExists( strKiXtartFile ) Then
		blnWriteDisclaimer = True
		Set objKiXtartFile = objFSO.OpenTextFile( strKiXtartFile, ForReading,   False )
		If InStr( objKiXtartFile.ReadAll, strDisclaimer ) > 0 Then blnWriteDisclaimer = False
		objKiXtartFile.Close
		Set objKiXtartFile = Nothing
		Set objKiXtartFile = objFSO.OpenTextFile( strKiXtartFile, ForAppending, False, TristateFalse )
		If blnWriteDisclaimer Then objKiXtartFile.Write vbCrLf & vbCrLf & strHeader
	Else
		Set objKiXtartFile = objFSO.OpenTextFile( strKiXtartFile, ForWriting,   True,  TristateFalse )
		objKiXtartFile.Write strHeader
	End If
	strHeader = WriteHeader( "VBScript" )
	If objFSO.FileExists( strVBScriptFile ) Then
		blnWriteDisclaimer = True
		Set objVBScriptFile = objFSO.OpenTextFile( strVBScriptFile, ForReading,   False )
		If InStr( objVBScriptFile.ReadAll, strDisclaimer ) > 0 Then blnWriteDisclaimer = False
		objVBScriptFile.Close
		Set objVBScriptFile = Nothing
		Set objVBScriptFile = objFSO.OpenTextFile( strVBScriptFile, ForAppending, False, TristateFalse )
		If blnWriteDisclaimer Then objVBScriptFile.Write vbCrLf & vbCrLf & strHeader
	Else
		Set objVBScriptFile = objFSO.OpenTextFile( strVBScriptFile, ForWriting,   True,  TristateFalse )
		objVBScriptFile.Write strHeader
	End If

	' Connect to the registry on the specified computer
	Set objReg = GetObject( "winmgmts:{impersonationLevel=impersonate}!//" & strComputer & "/root/default:StdRegProv" )

	' Read all values in the specified registry key
	objReg.EnumValues intHive, arrKey(1), arrValueNames, arrValueTypes

	' If no values were found, add an (empty) default value
	If IsNull( arrValueNames ) Then
		arrValueNames = Array( "" )
		arrValueTypes = Array( REG_SZ )
	End If

	' Add the results to the scripts
	objKiXtartFile.WriteLine  vbCrLf & "$RC = $objReg.CreateKey( $" _
	                        & arrHives( intHive - &H80000000 ) _
	                        & ", """ & arrKey(1) & """ )" & vbCrLf
	objVBScriptFile.WriteLine vbCrLf & "intRC = objReg.CreateKey( " _
	                        & arrHives( intHive - &H80000000 ) _
	                        & ", """ & arrKey(1) & """ )" & vbCrLf

	' Convert each value into KiXtart and VBScript code
	For i = 0 To UBound( arrValueNames )
		' The code for each value type differs only slightly
		Select Case arrValueTypes(i)
			Case REG_SZ
				' Read the registry value(s)
				objReg.GetStringValue intHive, arrKey(1), arrValueNames(i), varValue
				' Write the code to RECREATE those values
				objKiXtartFile.WriteLine  "$RC = $objReg.SetStringValue( $" _
				                        & arrHives( intHive - &H80000000 ) & ", """ _
				                        & arrKey(1) & """, """ & arrValueNames(i) _
				                        & """, """ & varValue & """ )"
				objVBScriptFile.WriteLine "intRC = objReg.SetStringValue( " _
				                        & arrHives( intHive - &H80000000 ) & ", """ _
				                        & arrKey(1) & """, """ & arrValueNames(i) _
				                        & """, """ & varValue & """ )"
			Case REG_EXPAND_SZ
				' Read the registry value(s)
				objReg.GetExpandedStringValue intHive, arrKey(1), arrValueNames(i), varValue
				' Write the code to RECREATE those values
				objKiXtartFile.WriteLine  "$RC = $objReg.SetExpandedStringValue( $" _
				                        & arrHives( intHive - &H80000000 ) & ", """ _
				                        & arrKey(1) & """, """ & arrValueNames(i) _
				                        & """, """ & varValue & """ )"
				objVBScriptFile.WriteLine "intRC = objReg.SetExpandedStringValue( " _
				                        & arrHives( intHive - &H80000000 ) & ", """ _
				                        & arrKey(1) & """, """ & arrValueNames(i) _
				                        & """, """ & varValue & """ )"
				' Add a comment/warning note
				strComment = strComment _
				           & "' Value """ & myRegPath & "\" & arrValueNames(i) _
				           & """ is of type REG_EXPAND_SZ; it was expanded on the source computer," _
				           & " and might not be correct on the target computer" & vbCrLf
			Case REG_BINARY
				' Read the registry value(s)
				objReg.GetBinaryValue intHive, arrKey(1), arrValueNames(i), varValue
				' Write the code to RECREATE those values
				objKiXtartFile.WriteLine  vbCrLf & "$arrBinaryValue = " _
				                        & Join( varValue, "," ) & vbCrLf _
				                        & "$RC = $objReg.SetBinaryValue( $" _
				                        & arrHives( intHive - &H80000000 ) & ", """ _
				                        & arrKey(1) & """, """ & arrValueNames(i) _
				                        & """, $arrBinaryValue )"
				objVBScriptFile.WriteLine "intRC = objReg.SetBinaryValue( " _
				                        & arrHives( intHive - &H80000000 ) & ", """ _
				                        & arrKey(1) & """, """ & arrValueNames(i) _
				                        & """, Array( " & Join( varValue, "," ) & " ) )"
			Case REG_DWORD, REG_DWORD_BIG_ENDIAN
				' Read the registry value(s)
				objReg.GetDWORDValue intHive, arrKey(1), arrValueNames(i), varValue
				' Write the code to RECREATE those values
				objKiXtartFile.WriteLine  "$RC = $objReg.SetDWORDValue( $" _
				                        & arrHives( intHive - &H80000000 ) & ", """ _
				                        & arrKey(1) & """, """ & arrValueNames(i) _
				                        & """, " & varValue & " )"
				objVBScriptFile.WriteLine "intRC = objReg.SetDWORDValue( " _
				                        & arrHives( intHive - &H80000000 ) & ", """ _
				                        & arrKey(1) & """, """ & arrValueNames(i) _
				                        & """, " & varValue & " )"
			Case REG_MULTI_SZ
				' Read the registry value(s)
				objReg.GetMultiStringValue intHive, arrKey(1), arrValueNames(i), varValue
				' Escape doublequotes, dollar signs and "at" signs for KiXtart
				strValue = ""
				For Each strLine In varValue
					If InStr( strLine, "'" ) Then
						strComment = strComment _
						           & "' Single quotes were found in REG_MULTI_SZ value """ _
						           & myRegPath & "\" & arrValueNames(i) _
						           & """ (may cause problems in KiXtart)" & vbCrLf
					End If
					strValue = strValue & ",'" & strLine & "'"
				Next
				strValue = Mid( strValue, 2 )
				' Write the code to RECREATE those registry values
				objKiXtartFile.WriteLine  vbCrLf & "$arrMultiStringValue = " _
				                        & strValue & vbCrLf _
				                        & "$RC = $objReg.SetMultiStringValue( $" _
				                        & arrHives( intHive - &H80000000 ) & ", """ _
				                        & arrKey(1) & """, """ & arrValueNames(i) _
				                        & """, $arrMultiStringValue )"
				' Escape doublequotes for VBScript
				strValue = ""
				For Each strLine In varValue
					strValue = strValue & ",""" & Replace( strLine, """", """""" ) & """"
				Next
				strValue = Mid( strValue, 2 )
				' Write the code to RECREATE those registry values
				objVBScriptFile.WriteLine "intRC = objReg.SetMultiStringValue( " _
				                        & arrHives( intHive - &H80000000 ) & ", """ _
				                        & arrKey(1) & """, """ & arrValueNames(i) _
				                        & """, Array( " & strValue & " ) )"
			Case REG_LINK, REG_RESOURCE_LIST, REG_FULL_RESOURCE_DESCRIPTOR, REG_RESOURCE_REQUIREMENTS_LIST, REG_QWORD
				' Add a comment/warning note
				strComment = strComment _
				           & "' Registry value """ & myRegPath & "\" & arrValueNames(i) _
				           & """ is of a valid type (" & arrValueTypes(i) _
				           & "), but this type is not supported by Reg2Scr.vbs." & vbCrLf
			Case Else
				' Add a comment/warning note
				strComment = strComment _
				           & "' Registry value """ & myRegPath & "\" & arrValueNames(i) _
				           & """ is of unknown type (" & i  & ")" & vbCrLf
		End Select
	Next

	' Close the files
	objKiXtartFile.Close
	objVBScriptFile.Close
	Set objKiXtartFile  = Nothing
	Set objVBScriptFile = Nothing

	' Recurse through the subkeys
	objReg.EnumKey intHive, arrKey(1), arrSubKeys
	If IsArray( arrSubKeys ) Then
		For i = 0 To UBound( arrSubKeys )
			intRC = ConvertReg( myRegPath & "\" & arrSubKeys(i), myFileName )
		Next
	End If

	' Once we're back at the end of the first iteration,
	' we'll append the comments/warning notes to the scripts
	intCounter = intCounter - 1
	If intCounter = 0 Then
		WScript.Echo "Done. Two scripts have been generated:" & vbCrLf & vbCrLf _
		           & vbTab & """" & strKiXtartFile & """" & vbCrLf & vbCrLf _
		           & "and" & vbCrLf & vbCrLf _
		           & vbTab & """" & strVBScriptFile & """" & vbCrLf
		If strComment <> "" Then
			' Write the comments/warning notes
			WScript.Echo "Please read the NOTES AND WARNINGS at the end of the generated code!"
			strComment = vbCrLf     & vbCrLf     & vbCrLf _
			           & "' NOTES AND WARNINGS:" & vbCrLf _
			           & "' ===================" & vbCrLf _
			           & strComment              & vbCrLf
			Set objVBScriptFile = objFSO.OpenTextFile( strVBScriptFile, ForAppending, False, TristateFalse )
			objVBScriptFile.Write strComment
			objVBScriptFile.Close
			Set objVBScriptFile = Nothing
			strComment = Replace( strComment, "' ", "; " )
			Set objKiXtartFile = objFSO.OpenTextFile( strKiXtartFile, ForAppending, False, TristateFalse )
			objKiXtartFile.Write strComment
			objKiXtartFile.Close
			Set objKiXtartFile = Nothing
		End If
	End If

	Set objFSO = Nothing
	Set objReg = Nothing
	ConvertReg = 0
End Function


Function WriteHeader( myScriptLanguage )
	strDisclaimer = "' Disclaimer: Though I did my best to provide error free code,"  & vbCrLf _
	              & "'             I cannot guarantee that the code generated by"     & vbCrLf _
	              & "'             Reg2Scr.vbs will work on your system(s)."          & vbCrLf _
	              & "'             This script is generated without any human"        & vbCrLf _
	              & "'             intervention, and is designed to modify the"       & vbCrLf _
	              & "'             registry, which is always risky."                  & vbCrLf _
	              & "'             This script does not check for runtime errors,"    & vbCrLf _
	              & "'             but you can easily add your own error checking."   & vbCrLf _
	              & "'             USE THIS SCRIPT AT YOUR OWN RISK, AND ONLY IF"     & vbCrLf _
	              & "'             YOU FULLY UNDERSTAND ITS IMPLICATIONS!"            & vbCrLf _
	              & "'             Test this script thoroughly before using it in"    & vbCrLf _
	              & "'             a production environment."                         & vbCrLf _
	              & "'             Always have a verified full backup ready before"   & vbCrLf _
	              & "'             using ANY script that modifies the registry."      & vbCrLf _
	              & "'             CHECK FOR NOTES AND WARNINGS END OF THE GENERATED" & vbCrLf _
	              & "'             CODE: IF REG2SCR.VBS DETECTED ANY ""ANOMALITIES""" & vbCrLf _
	              & "'             WHILE GENERATING THIS SCRIPT, IT WILL LEAVE A"     & vbCrLf _
	              & "'             SHORT DESCRIPTION THERE!"                          & vbCrLf
	Select Case LCase( myScriptLanguage )
		Case "vbscript"
			WriteHeader = "' VBScript generated with Reg2Scr.vbs,  Version " & strVersion  & vbCrLf _
			            & "' by Rob van der Woude, http://www.robvanderwoude.com" & vbCrLf & vbCrLf _
			            & strDisclaimer     & vbCrLf _
			            & "Option Explicit" & vbCrLf & vbCrLf _
			            & "Const HKEY_CLASSES_ROOT   = &H80000000" & vbCrLf _
			            & "Const HKEY_CURRENT_USER   = &H80000001" & vbCrLf _
			            & "Const HKEY_LOCAL_MACHINE  = &H80000002" & vbCrLf _
			            & "Const HKEY_USERS          = &H80000003" & vbCrLf _
			            & "Const HKEY_CURRENT_CONFIG = &H80000005" & vbCrLf _
			            & "Const HKEY_DYN_DATA       = &H80000006" & vbCrLf & vbCrLf _
			            & "Const REG_SZ                         =  1" & vbCrLf _
			            & "Const REG_EXPAND_SZ                  =  2" & vbCrLf _
			            & "Const REG_BINARY                     =  3" & vbCrLf _
			            & "Const REG_DWORD                      =  4" & vbCrLf _
			            & "Const REG_DWORD_BIG_ENDIAN           =  5" & vbCrLf _
			            & "Const REG_LINK                       =  6" & vbCrLf _
			            & "Const REG_MULTI_SZ                   =  7" & vbCrLf _
			            & "Const REG_RESOURCE_LIST              =  8" & vbCrLf _
			            & "Const REG_FULL_RESOURCE_DESCRIPTOR   =  9" & vbCrLf _
			            & "Const REG_RESOURCE_REQUIREMENTS_LIST = 10" & vbCrLf _
			            & "Const REG_QWORD                      = 11" & vbCrLf & vbCrLf _
			            & "Dim intRC, objReg, strComputer"   & vbCrLf & vbCrLf _
			            & "strComputer = ""."""     & vbCrLf & vbCrLf _
			            & "Set objReg = GetObject( ""winmgmts:{impersonationLevel=impersonate}" _
			            & "!//"" & strComputer & ""/root/default:StdRegProv"" )" & vbCrLf
		Case "kixtart"
			strDisclaimer = Replace( strDisclaimer, "'", ";" )
			WriteHeader = "; KiXtart code generated with Reg2Scr.vbs,  Version "  & strVersion & vbCrLf _
			            & "; by Rob van der Woude, http://www.robvanderwoude.com" & vbCrLf & vbCrLf _
			            & strDisclaimer                      & vbCrLf _
			            & "$HKEY_CLASSES_ROOT   = &80000000" & vbCrLf _
			            & "$HKEY_CURRENT_USER   = &80000001" & vbCrLf _
			            & "$HKEY_LOCAL_MACHINE  = &80000002" & vbCrLf _
			            & "$HKEY_USERS          = &80000003" & vbCrLf _
			            & "$HKEY_CURRENT_CONFIG = &80000005" & vbCrLf _
			            & "$HKEY_DYN_DATA       = &80000006" & vbCrLf & vbCrLf _
			            & "$REG_SZ                         =  1" & vbCrLf _
			            & "$REG_EXPAND_SZ                  =  2" & vbCrLf _
			            & "$REG_BINARY                     =  3" & vbCrLf _
			            & "$REG_DWORD                      =  4" & vbCrLf _
			            & "$REG_DWORD_BIG_ENDIAN           =  5" & vbCrLf _
			            & "$REG_LINK                       =  6" & vbCrLf _
			            & "$REG_MULTI_SZ                   =  7" & vbCrLf _
			            & "$REG_RESOURCE_LIST              =  8" & vbCrLf _
			            & "$REG_FULL_RESOURCE_DESCRIPTOR   =  9" & vbCrLf _
			            & "$REG_RESOURCE_REQUIREMENTS_LIST = 10" & vbCrLf _
			            & "$REG_QWORD                      = 11" & vbCrLf & vbCrLf _
			            & "Dim $RC, $objReg, $Computer" & vbCrLf & vbCrLf _
			            & "$Computer = ""."""  & vbCrLf & vbCrLf _
			            & "$objReg = GetObject( ""winmgmts:{impersonationLevel=impersonate}" _
			            & "!//$Computer/root/default:StdRegProv"" )" & vbCrLf
		Case Else
			WriteHeader = ""
	End Select
End Function


Sub Syntax
	Dim strMsg
	strMsg = vbCrLf _
	       & "Reg2Scr.vbs,  Version " & strVersion & vbCrLf _
	       & "Read the specified registry key from the specified computer, and generate"     & vbCrLf _
	       & "KiXtart and VBScript code to recreate that registry key on any other computer" & vbCrLf & vbCrLf _
	       & "Usage:  REG2SRC.VBS  /R:regkey  /F:outputfile  [ /C:remotecomputer ]" & vbCrLf & vbCrLf _
	       & "Where:  ""regkey""          is the full registry path"                & vbCrLf _
	       & "                          (e.g. HKEY_LOCAL_MACHINE\SOFTWARE\MyKey)"   & vbCrLf _
	       & "        ""outputfile""      is the (path and) file name for the output scripts" & vbCrLf _
	       & "                          (if an extension is specified it will be ignored)"    & vbCrLf _
	       & "        ""remotecomputer""  is the optional remote computer name"               & vbCrLf _
	       & "                          (default if not specified is the local computer)"     & vbCrLf & vbCrLf _
	       & "Notes:  USE THIS SCRIPT AND THE ONES GENERATED ENTIRELY AT YOUR OWN RISK!"      & vbCrLf _
	       & "        The scripts generated need to be tested thorougly before being used"    & vbCrLf _
	       & "        in a production environment. Make sure you have a verified, recent,"    & vbCrLf _
	       & "        full backup ready before using the generated scripts."                  & vbCrLf _
	       & "        Read the NOTES/WARNINGS at the end of the generated code; they point"   & vbCrLf _
	       & "        out any ""anomalies"" encountered by Reg2Scr.vbs."            & vbCrLf  & vbCrLf _
	       & "Written by Rob van der Woude"           & vbCrLf _
	       & "http://www.robvanderwoude.com"
	WScript.Echo strMsg
	WScript.Quit 1
End Sub