'
' export a registry in *.INF format
'
' Usage:
'	cscript //nologo //U $0 [-b 32][-s 16384] HKLM\SOFTWARE ... > output.inf
'	cscript //nologo $0 [-b 32][-s 16384] -u -o output.inf HKLM\SOFTWARE ....
'
' References:
'	Windows DDK, INF AddReg Directive <URL:http://msdn.microsoft.com/en-us/library/ff546320.aspx>
'	WMI Reference, StdRegProv Class <URL:http://msdn.microsoft.com/en-us/library/aa393664.aspx>
'
' WSH Limitations:
' * Cannot get unexpanded REG_EXPAND_SZ value if valuename includes "\".
' * If the key does not contain any explicit valuenames, the program cannot tell apart
'   the key's default value from undefined or REG_NONE.
'   The program always emits as default value undefined (FLG_ADDREG_KEYONLY).
' * If the key does not contain any explicit valuenames, and the key itself has REG_EXPAND_SZ
'   as the default value, and it does not include any expandable string (%value%),
'   the program cannot tell its expandability. Program emits the default value as REG_SZ.
' * Windows 2000, 2003 cannot read REG_QWORD values, as it lacks GetQWORDValue() method.
' * Cannot get REG_RESOURCE_LIST(type 8), REG_FULL_RESOURCE_REQUIREMENTS_LIST(type 10) values.
'    (you probably do not want them either)
' * Cannot properly get invalid REG_DWORD values having non-4byte length.
' * On Windows 2000, REG_SZ/REG_MULTI_SZ output could have bogus,memory-leak-ish values 
'   due to unknown bug in the system.
'   (several occurence when dumping the whole HKEY_LOCAL_MACHINE)
' * On Windows 2000 SP4, dumping "HKU" (HKEY_USERS) fails.
'   Install a hotfix, http://support.microsoft.com/kb/817478 to replace WMI stdprov.dll .
'
' Note:
' * Dumping full tree of HKLM could take significant amount of time
'   with a high CPU load. (HKLM dump of Windows Vista yields ~160MB file)
' * By default, refuses to dump >16kB REG_BINARY. Specify "-s bytes#" to change.
'
' $Id$
'

strComputer = "."
Dim objReg, objShell
Set objReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\default:StdRegProv")
Set objShell=CreateObject("wscript.shell")

Dim hexBreak
hexBreak = 32	' bytes to output per line for binary data, 0 for no line break
Dim maxBinary
maxBinary = 16384	'refuse dumping REG_BINARY longer than maxBinary


' return INF escaped string
' escQ("String value")
Function escQ(ByVal str)
	' "%value%" in *.inf is replaced by [string] section; escape them
	str = Replace(str,"%", "%%")

	' " -> "" and quote if 
	' includes " or whitespace
	' "\" will be continuation in *.inf
	' "," will be a field separator
	' XXX control chars
	if InStr(str," ") or InStr(str,"""") or InStr(str,";") or InStr(str,",") or _
	    Right(str,1) = "\" then
		escQ = """" & Replace(str, """", """""") & """"
	else
		escQ = str
	end if
End Function

' Return integer array as hex XX,XX,... string
' Inserts "\<crlf><tab>" as continuation line every <nlc> items, 0 for no continuation
' infHex(arrayIntValues, 0)
Function infHex(arr, nlc)
	Dim i
	infHex = ""
	Dim t

	if not IsArray(arr) then Exit Function

	'' VBScript cannot test for Erase-ed array;
	'' for empty array, UBound() will throw exception (won't return -1).
	On Error Resume Next
	    t = -1
	    t = UBound(arr)
	On Error goto 0
	if t<0 then Exit Function

	for i=0 to UBound(arr)
		if i <> 0 then
			infHex=infHex & ","
			if (i mod 8) = 0 then infHex=infHex & " "
			if nlc <> 0 then if (i mod nlc) = 0 then infHex=infHex & "\" & vbCrLf & vbTab
		end if
		if arr(i) <> 0 then
			infHex = infHex & Right("0" + Hex(arr(i)), 2)
		else
			infHex = infHex & Hex(arr(i))	'"0" for shorter output
		end if
	next
End Function

' return str array as "xxx","yyy",... string
' infMulti(arrayStringValues)
Function infMulti(arr)
	Dim i
	Dim curlen
	Dim stmp
	infMulti = ""
	curlen=0	'length of current line; reset on continuation
	for i=0 to UBound(arr)
		if i <> 0 then stmp=", " else stmp = ""
		'' wrap long REG_MULTI_SZ by continuation
		if curlen >= (2048-8) then	'4096 is *.inf limit
			stmp = stmp & "\" & vbCrLf & vbTab
			curlen=0
		end if
		stmp=stmp & escQ(arr(i))
		infMulti = infMulti & stmp
		curlen = curlen + lenB(stmp)
	next
End Function

' hs2u.Item("HKEY_CURRENT_USER") == &h80000001
Dim hs2u
Set hs2u = CreateObject("Scripting.Dictionary")
hs2u.Item("HKEY_CLASSES_ROOT")	= &H80000000
hs2u.Item("HKCR") 		= &H80000000
hs2u.Item("HKEY_CURRENT_USER")	= &H80000001
hs2u.Item("HKCU")		= &H80000001
hs2u.Item("HKEY_LOCAL_MACHINE")	= &H80000002
hs2u.Item("HKLM")		= &H80000002
hs2u.Item("HKEY_USERS")		= &H80000003
hs2u.Item("HKU")		= &H80000003
' hu2s.Item(&H80000002) == "HKLM"
Dim hu2s
Set hu2s = CreateObject("Scripting.Dictionary")
hu2s.Item(&H80000000)	= "HKCR"
hu2s.Item(&H80000001)	= "HKCU"
hu2s.Item(&H80000002)	= "HKLM"
'hu2s.Item(&H80000003)	= "HKU"
hu2s.Item(&H80000003)	= "HKEY_USERS"	''RegRead errors on "HKU"


' VBScript does not have any sort function. Roll one.

' Sort the arrays by values of the first array.
' Compare number as number rather than string if possible.
' Compare strings ignoring case.
' Usage: SortArrays refarray subarray
Sub SortArrays (ByRef a1, ByRef a2)
	if not IsArray(a1) then Exit Sub
	if UBound(a1)<=0 then Exit Sub
'DDD'wscript.stderr.WriteLine "DDD: sorting ("& UBound(a1)+1 &")"
	Call Qsort2(a1,LBound(a1),UBound(a1), a2)
'DDD'wscript.stderr.WriteLine "DDD: sorted"
End Sub
' Implement Quicksort; O(N log N)
Sub Qsort2(ByRef a1, ByVal lo, ByVal hi, ByRef a2)
	Dim i,j
	Dim piv,x
	'if not IsArray(a1) then Exit Sub
	'if UBound(a1)<=0 then Exit Sub
	i=lo : j=hi
	piv = a1(int((lo+hi)/2))

	Do while i<=j
		Do while i<hi
			'if IsNumeric(a1(i)) AND IsNumeric(piv) then
			'	if (a1(i)+0.0) >= (piv+0.0) then Exit Do
			'else
			'	if LCase(a1(i)) >= LCase(piv) then Exit Do
			'end if
			if CompareStrNum(a1(i),piv) >= 0 then Exit Do
			i=i+1
		Loop
		Do while lo<j
			'if IsNumeric(piv) AND IsNumeric(a1(j)) then
			'	if (piv+0.0) >= (a1(j)+0.0) then Exit Do
			'else
			'	if LCase(piv) >= LCase(a1(j)) then Exit Do
			'end if
			if CompareStrNum(piv,a1(j)) >= 0 then Exit Do
			j=j-1
		Loop
		if i<=j then
			x=a1(i): a1(i)=a1(j): a1(j)=x
			if IsArray(a2) then x=a2(i): a2(i)=a2(j): a2(j)=x
			i=i+1 : j=j-1
		end if
	Loop
	if lo<j then Call Qsort2(a1, lo,j , a2)
	if i<hi then Call Qsort2(a1,  i,hi, a2)

End Sub
' Roll a trivial sort routine; performance O(N^2) (bad).
'o2'Sub SortArrays (ByRef a1, ByRef a2)
'o2'	Dim i,f
'o2'	Dim x,xf
'o2'
'o2'	if not IsArray(a1) then Exit Sub
'o2'	if UBound(a1)<=0 then Exit Sub
'o2''DDD'wscript.stderr.WriteLine "DDD: sorting ("& UBound(a1)+1 &")"
'o2'
'o2'	for f=0 to UBound(a1)
'o2'		xf=f
'o2'		' find smallest
'o2'		for i=f+1 to UBound(a1)
'o2'			if IsNumeric(a1(xf)) AND IsNumeric(a1(i)) then
'o2'				if (a1(xf)+0.0)>(a1(i)+0.0) then xf=i	
'o2'			else
'o2'				if LCase(a1(xf))>LCase(a1(i)) then xf=i	
'o2'			end if
'o2'		next 'i
'o2'		x=a1(f): a1(f)=a1(xf): a1(xf)=x
'o2'		if IsArray(a2) then x=a2(f): a2(f)=a2(xf): a2(xf)=x
'o2'	next 'f
'o2''DDD'wscript.stderr.WriteLine "DDD: sorted"
'o2'End Sub

''' Compare num as num, otherwise ignore case
'c0'Function CompareStrNum(ByVal s1, ByVal s2)
'c0'	if IsNumeric(s1) AND IsNumeric(s2) then
'c0'		s1=s1+0.0 : s2=s2+0.0
'c0'		CompareStrNum = -(s1>s2)+(s1<s2)
'c0'		Exit Function
'c0'	end if
'c0'	s1 = LCase(s1) : s2 = LCase(s2)
'c0'	CompareStrNum = -(s1>s2)+(s1<s2)
'c0'End Function
''' Slower: compare to be "string2" < "String10"
''' return 1,0,-1
Dim reg_az09
Set reg_az09 = New RegExp : reg_az09.Pattern = "^([^0-9]+|[0-9][0-9A-F]*)(.*)"
Function CompareStrNum(ByVal s1, ByVal s2)
	Dim sub1, sub2
	Dim m1,m2
	Dim w1,w2
	Dim e1,e2

	s1 = UCase(s1) : s2 = UCase(s2)

	'' compare "xx123yy456" by chopping into xx,123,yy,456
	while Len(s1)>0 AND Len(s2)>0 
'DDD'wscript.stderr.WriteLine "DDD: comp <"& s1 &"> <"& s2 &">"

		Set sub1 = reg_az09.Execute(s1)
		if sub1.count=0 then CompareStrNum = -(s1>s2)+(s1<s2) : Exit Function
		Set sub2 = reg_az09.Execute(s2)
		if sub2.count=0 then CompareStrNum = -(s1>s2)+(s1<s2) : Exit Function

		'' the values should be "(ZZ)(123)(...)"|"(123)(ZZ)..."
		Set m1=sub1(0) : Set m2=sub2(0)	'SubMatches collection
		w1=m1.SubMatches(0) : w2=m2.SubMatches(0)

'DDD'wscript.stderr.WriteLine "DDD: subm <"& w1 &"> <"& w2 &">"
		if IsNumeric(w1) AND IsNumeric(w2) then
			' numeric comparison
			' (todo: "000" vs "00")
			w1=w1+0.0 : w2=w2+0.0
			CompareStrNum = -(w1>w2)+(w1<w2)
		else
			' string comparison
			CompareStrNum = -(w1>w2)+(w1<w2)
		end if
		if CompareStrNum<>0 then Exit Function
		s1=m1.SubMatches(1) : s2=m2.SubMatches(1) '' chop "ZZ" and iterate for "123..."
	wend
	'' exausted the string
	CompareStrNum = -(s1>s2)+(s1<s2)
End Function

'' Convert QWORD decimal string into byte array.
' VBScript numeric is limited to 53bit accuracy.
' Decimal string representation passed back by GetQWORDValue seems always correct,
' but REG_QWORD cannot be byte-splitted without a custom bignum program.
' Usage: QWORD2Arr8("9843086184167632639", a) => a()=&hff,&hee,&hdd,&hcc,&hbb,&haa,&h99,&h88
Sub QWORD2Arr8 (ByVal q, ByRef a)
	Dim i
	Dim s
	Dim vu,vd,w
	ReDim a(7)
	s = Right("00000000000000000000" & CStr(q), 20)	' 20 digit decimal
	vu = Int(Left(s,13)): vd = Int(Right(s,7))	'split into upper 13, lower 7
'DDD'wscript.stderr.WriteLine "DDD: QWORD split "& vu &":"& vd 'should be NNNN:MMMM; not negative or exponent representation
	'' Byte-split the lower 7 digits. This is easy since max is 1e7-1 = 0x989680-1
	for i=0 to 3
		a(i)= vd AND &hFF
		vd = int(vd / &h100)
	next 'i

	'' Sum the upper 13 digits with 1e7 = 0x989680 weight.
	'' Upper13 * (nibble-weight max 0x98) should not exceed 53bit,
	'' so upper part should be split to be below (2^54-1)/256 = 35184372088831 (14digits).
	'' So splitting by 13digits should be safe.

	'' Keep carry values in each byte; compensate later.
	'' Use "w-int(w/256)*256" instead of "w AND &hFF" or "w MOD 256" since 
	'' handling exceeds 32bit (but below 53bit)
	w = vu * &h80: for i=0 to 7: a(i)=a(i)+w-int(w/256.0)*256: w=int(w / &h100): next
	w = vu * &h96: for i=1 to 7: a(i)=a(i)+w-int(w/256.0)*256: w=int(w / &h100): next
	w = vu * &h98: for i=2 to 7: a(i)=a(i)+w-int(w/256.0)*256: w=int(w / &h100): next
	'' Fixup carry
	for i=0 to 7-1
		a(i+1)=a(i+1)+int(a(i) / &h100)
		a(i)=a(i) AND &hFF
	next 'i
	'' Recast to Byte type, in case the caller uses VarType to determine registry type
	for i=0 to 7
		a(i)=CByte(a(i) AND &hFF)
	next 'i
End Sub


' prereq: global objReg, objShell, hexBreak, maxBinary
' dump1Key(wscript.StdOut, &H80000001, "Software\Microsoft", 0)
' 
' Warning: If the string value contains Unicode chars outside the codepage,
' tsOut.WriteLine will bail. You need "cscript //U" for UTF16LE output.
'
Sub dump1Key (ByRef tsOut, uHIVE, strKeyPath, isLeaf)
	Dim strHive
	Dim i,Value,arrValue()
	Dim arrValueNames, arrValueTypes
	Dim e

'DDD'wscript.StdErr.WriteLine "Dumping key [0x"& hex(uHIVE) &","& strKeyPath &"]" 'DDD
	strHIVE = hu2s.Item(uHIVE)

	''' Now get the values
	e = objReg.EnumValues(uHIVE, strKeyPath, arrValueNames, arrValueTypes)
'DDD'wscript.StdErr.Writeline "dump1key: "& e &"=EnumValues(&h"& hex(uHive) &","& strKeyPath &", ...)" 'DDD
	'' return will be
	'' e==0 && arrValueNames != Null	normal, including key's default value
	'' e==0 && arrValueNames == Null	no explicit valuenames in this key. default value could still exist
	''	(bug?) EnumValues method <URL:http://msdn.microsoft.com/en-us/library/aa390388.aspx> (see community comments)
	'' e==2					nonexistent key
	if e = 2 then 
		wscript.StdErr.WriteLine "ERROR: EnumValues("&strKeyPath&") error="& e &", skip this key"
		tsOut.Write ";;?nokey?;" & strHIVE & "," & escQ(strKeyPath)
		Exit Sub
	end if

	''' Compensate the "bug" which the default value won't be enumerated.
	if IsNull(arrValueNames) then
		'' Try getting the default value of the key via Shell.RegRead
		Value = Null
		On Error Resume Next
		    Value = objShell.RegRead(strHIVE & "\" & strKeyPath & "\")
		On Error goto 0
		'' (Win2000) If error, or Null, there's no default value for the key.
		'' (Vista) always return empty string... 
		''  so also try existence by GetStringValue
		if VarType(Value) = vbString then
			if Value = "" then
			    '' Value is "", so possibly a null string, nonexistent, or REG_NONE
			    Value = Null
			    On Error Resume Next
				e = objReg.GetStringValue(uHIVE,strKeyPath,"", Value)
			    On Error goto 0
			    ' Value should be Null if no default value
			    ' XXX non-REG_SZ default value
			    ' XXX cannot properly recognize REG_NONE!
			end if
		end if
		if IsNull(Value) then
			''' No default value, no explicit valuenames, no subkeys
			''' for this key, but
			''' you need to emit at least a line to create just the key.
			if (isLeaf) then
				tsOut.Write strHIVE & "," & escQ(strKeyPath) & "," & ""
				tsOut.WriteLine ",16"	'FLG_ADDREG_KEYONLY
			end if
		else
			'' There is some default value for the key.
			'' But no way to pick up the type?
			ReDim arrValueNames(0), arrValueTypes(0)
			arrValueNames(0)="" : arrValueTypes(0)=1 'Assume REG_SZ first
			' Try estimating the type ...
			e=VarType(Value)
'DDD'wscript.stderr.WriteLine "DDD: VarType="& int(e/8192)*8192 &"+"& e mod 8192
			if e=vbString then
				arrValueTypes(0)=1	'REG_SZ
				'' Try detecting REG_EXPAND_SZ; 
				'' XXX cannot detect if value lacks %env%
				'' This could be slow, but won't be here so often
				e = objReg.GetStringValue(uHive, strKeyPath, "", i)
				if e=0 and i <> Value then arrValueTypes(0)=2 'REG_EXPAND_SZ 
			elseif e=vbLong OR e=vbInteger then
				arrValueTypes(0)=4	'REG_DWORD
			elseif e AND vbArray then
				'' Lower word of VarType() seems to be always vbVariant(12);
				'' try explicit test on Value(0)
				Select Case VarType(Value(0))
				  Case vbByte
				    arrValueTypes(0)=3	'assume REG_BINARY
				  Case vbString
				    arrValueTypes(0)=7	'assume REG_MULTI_SZ
				  Case vbVariant	'(unlikely)
				    arrValueTypes(0)=7	'assume REG_MULTI_SZ
				End Select
			end if
			' (XXX cannot properly pickup the type REG_EXPAND_SZ !)
			' (XXX will barf on other type!)
			' (todo: if the value type could be detected from Value, arrayValueTypes may not be needed below?)
		end if
	else
		'' Nothing needed to do; EnumValues seems to properly include the 
		'' default valuename("") when some other explicit valuename exist
	end if

	if not IsNull(arrValueNames) then
	SortArrays arrValueNames,arrValueTypes
	for i=0 to UBound(arrValueNames)
		select case arrValueTypes(i)

		case 1	'REG_SZ
			'' You could get error if
			'' - permission denied
			'' - trying to read default value of hive, such as "HKCU\"
			Value = Null : e=0
			if InStr(arrValueNames(i), "\")<=0 then
				'RegRead is faster, as it doesn't query WMI
				''' Occasionally RegRead returns bogus binary string (leaky?),
				''' or the argument itself.
				''' GetStringValue() seems way better, but at performance cost.
				Value = objShell.RegRead(strHIVE & "\" & strKeyPath & "\" & arrValueNames(i))
			else
				e = objReg.GetStringValue(uHIVE,strKeyPath,arrValueNames(i), Value)
				if e<>0 then Value=Null
			end if
			if not IsNull(Value) then
				tsOut.Write strHIVE & "," & escQ(strKeyPath) & "," & escQ(arrValueNames(i))
				tsOut.Write ",,"
				tsOut.WriteLine escQ(Value)	'use "cscript //U" if error occurs
			else
				if strKeyPath <> "" then
					wscript.StdErr.WriteLine "ERROR: failed to GetStringValue("& strHIVE &","& strKeyPath &","& arrValueNames(i) &")=0x"& Right("0000000" & hex(e), 8) &"; skipping"
					tsOut.WriteLine ";;?getval?;" & strHIVE & "," & escQ(strKeyPath) & "," & escQ(arrValueNames(i))
				end if
			end if
		case 2	'REG_EXPAND_SZ
			' GetStringValue still seems to expand the value,
			' so use wscript.shell RegRead("HKCU\Key\Value")
			' XXX cannot read valuename including "\" !!
			Value = "" : e=0
			if InStr(arrValueNames(i), "\")<=0 then
				'' get unexpanded value
				Value = objShell.RegRead(strHIVE & "\" & strKeyPath & "\" & arrValueNames(i))
			else
				wscript.StdErr.WriteLine "ERROR: cannot get unexpanded REG_EXPAND_SZ valuename with backslash; emitting expanded value for ["& strKeyPath &","& arrValueNames(i) &"]"
				e = objReg.GetStringValue(uHIVE,strKeyPath,arrValueNames(i), Value)
			end if
			tsOut.Write strHIVE & "," & escQ(strKeyPath) & "," & escQ(arrValueNames(i))
			tsOut.Write ",0x20000,"	'FLG_ADDREG_TYPE_EXPAND_SZ
			tsOut.WriteLine escQ(Value)
		case 3	'REG_BINARY
			''' RegRead is faster, as it doesn't query WMI
			Value = Null : e=0
			if InStr(arrValueNames(i), "\")<=0 then
				Value = objShell.RegRead(strHIVE & "\" & strKeyPath & "\" & arrValueNames(i))
			else
				e = objReg.GetBinaryValue(uHIVE,strKeyPath,arrValueNames(i), Value)
			end if
			if UBound(Value) > maxBinary then
				wscript.stderr.WriteLine "ERROR: refusing to dump long REG_BINARY length "& UBound(Value) &">"& maxBinary &" ["& strKeyPath & ","& arrValueNames(i) &"]"
				tsOut.Write ";;?toolong?("& UBound(Value) &");"
				tsOut.Write strHIVE & "," & escQ(strKeyPath) & "," & escQ(arrValueNames(i))
				tsOut.WriteLine ",1, "	'FLG_ADDREG_BINVALUETYPE
			else
				tsOut.Write strHIVE & "," & escQ(strKeyPath) & "," & escQ(arrValueNames(i))
				tsOut.Write ",1, "	'FLG_ADDREG_BINVALUETYPE
				tsOut.WriteLine infHex(Value, hexBreak)
			end if
		case 4	'REG_DWORD / REG_DWORD_LITTLE_ENDIAN
			Value = Null : e=0
			'e = objReg.GetDWORDValue(uHIVE,strKeyPath,arrValueNames(i), Value)
			if InStr(arrValueNames(i), "\")<=0 then
				Value = objShell.RegRead(strHIVE & "\" & strKeyPath & "\" & arrValueNames(i))
				'' XXX RegRead does NOT return error on invalid (non-4byte) data !!!
				'' XXX Should use slow GetDWORDValue for proper detection. (about 25% slower)
			else
				e = objReg.GetDWORDValue(uHIVE,strKeyPath,arrValueNames(i), Value)
				'' In rare case the value could be other than 4bytes long, which will emit error.
				'' regedit.exe will show the value as "invalid".
			end if
			if not IsNumeric(Value) then
				wscript.StdErr.WriteLine "ERROR: failed to get REG_DWORD ["& strHIVE &","& strKeyPath &","& arrValueNames(i) &"]; skipping"
				tsOut.Write ";;?getval?;"
			end if
			tsOut.Write strHIVE & "," & escQ(strKeyPath) & "," & escQ(arrValueNames(i))
			' use "65537" instead of 0x10001 for shorter output
			tsOut.Write ",65537, "	'FLG_ADDREG_TYPE_DWORD
			if IsNumeric (Value) then tsOut.WriteLine Value else tsOut.WriteLine
		'case 5	'REG_DWORD_BIG_ENDIAN
		'case 6	'REG_LINK
		case 7	'REG_MULTI_SZ
			''' Occasionally arrValue will have excess,corrupted member appended
			''' when not cleared before the call ... (leaky library?)
			'if IsArray(arrValue) then Erase arrValue else arrValue=Null 'doing this on every iteration could be slow
			'e = objReg.GetMultiStringValue(uHIVE,strKeyPath,arrValueNames(i), arrValue)
			Value = Null : e=0
			if InStr(arrValueNames(i), "\")<=0 then
				Value = objShell.RegRead(strHIVE & "\" & strKeyPath & "\" & arrValueNames(i))
			else
				e = objReg.GetMultiStringValue(uHIVE,strKeyPath,arrValueNames(i), Value)
			end if
			if not IsArray(Value) then tsOut.Write ";;?getval?;"
			tsOut.Write strHIVE & "," & escQ(strKeyPath) & "," & escQ(arrValueNames(i))
			tsOut.Write ",0x10000, "	'FLG_ADDREG_TYPE_MULTI_SZ
			tsOut.WriteLine infMulti(Value)
		'case 8	'REG_RESOURCE_LIST
		'case 9	'REG_FULL_RESOURCE_DESCRIPTOR
		'case 10	'REG_FULL_RESOURCE_REQUIREMENTS_LIST
		case 11	'REG_QWORD / REG_QWORD_LITTLE_ENDIAN
			''' Win2000 does not have GetQWORDValue.
			''' Since VBScript does not have any means to test 
			''' objects' method existence, reluctantly revert to "on error".
			Value = Null
			On Error Resume Next
			    e = objReg.GetQWORDValue(uHIVE,strKeyPath,arrValueNames(i), Value)
			On Error goto 0
			' (returns null on "ExecTime" value, shown as "invalid value" from regedit.exe)
			if e<>0 or not IsNumeric(Value) then
				wscript.StdErr.WriteLine "ERROR: cannot read REG_QWORD ["& strKeyPath &","& arrValueNames(i) &"]"
				tsOut.Write ";;?REG_QWORD?;"
			end if
			' XXX there's no FLG_ADDREG_TYPE_QWORD !!!
			' make up the flag as ((11<<16) & FLG_ADDREG_TYPE_BINARY)
			tsOut.Write strHIVE & "," & escQ(strKeyPath) & "," & escQ(arrValueNames(i))
			tsOut.Write ",0xB0001, "
			'' You can express QWORD by "0xB0001,x,x,x,x,x,x,x,x" but 
			'' there's no VBS way to extract the value as binary bytes.
			'' Split the value by custom bignum proc QWORD2Arr8 .
			if IsNumeric(Value) then
				if IsArray(arrValue) then ReDim arrValue(7)
				'if Value < 0 or Value > 9007199254740991 then wscript.StdErr.WriteLine "ERROR: REG_QWORD value bigger then 53bit not properly calculated ["& strKeyPath &","& arrValueNames(i) &"]="& Value
				QWORD2Arr8 Value, arrValue
				tsOut.Write infHex(arrValue, hexBreak)
			end if
			tsOut.WriteLine 
		case 0	'REG_NONE
			tsOut.Write strHIVE & "," & escQ(strKeyPath) & "," & escQ(arrValueNames(i))
			tsOut.WriteLine ",0x20001"	'FLG_ADDREG_TYPE_NONE
		case Else	'UNKNOWN
			if IsArray(arrValue) then Erase arrValue else arrValue=Null
			On Error Resume Next	'likely errors on anything else
			    e = objReg.GetBinaryValue(uHIVE,strKeyPath,arrValueNames(i), arrValue)
			On Error goto 0
			' XXX this output is not valid!
			' arrValue is likely Null, so still no hex output
			' Server 2008 keeps the arrValue as Erase-ed array
			wscript.StdErr.WriteLine "WARNING: unrecognized type " & arrValueTypes(i) & " for [" & strKeyPath & "," & arrValueNames(i) & "] , skipping"
			tsOut.Write ";;?type("& arrValueTypes(i) &")?;"
			tsOut.Write strHIVE & "," & escQ(strKeyPath) & "," & escQ(arrValueNames(i))
			tsOut.Write ",0x" & Right("000" & hex(arrValueTypes(i)), 4) & "0001, "
			tsOut.WriteLine infHex(arrValue, hexBreak)

		end select 'arrValueTypes(i)
	next 'i
	end if
End Sub

' prereq: global objReg, objShell, hexBreak, maxBinary
' dumpKeyRecursive wscript.StdOut, &H80000001, "Software\Microsoft"
Sub dumpKeyRecursive (ByRef tsOut, uHIVE, strKeyPath)
	Dim i
	Dim arrKeyNames

	''' just "dump1key : for each keys dumpKeyRecursive:next"
	''' is enough, but to squelch intermediate FLG_ADDREG_KEYONLY lines,
	''' we need to know beforehand whether the subkey exists.

	''' Get the subkeys
	objReg.EnumKey uHIVE, strKeyPath, arrKeyNames
'DDD'if Not IsNull(arrKeyNames) then wscript.StdErr.WriteLine "subkeys: 0x"& hex(uHIVE) &","& strKeyPath &", arrKeyNames="& join(arrKeyNames,",") 'DDD

	''' Dump the current key first
	dump1key tsOut, uHIVE, strKeyPath, isNull(arrKeyNames)

	''' Dump subkeys
	if Not IsNull(arrKeyNames) then
	SortArrays arrKeyNames, Null
	for each i in arrKeyNames
		''' zero-length subkey name will cause infinite loop!
		''' there shouldn't be, but sometimes is (bug?)
		if i <> "" and i <> "\" then
			''' recurse
			if IsNull(strKeyPath) then
				dumpKeyRecursive tsOut, uHIVE, i
			elseif strKeyPath = "" then
				''' if strKeyPath is blank, we are dumping the root dir
				''' of the hive; should not pass the subkey as "\SOFTWARE"
				dumpKeyRecursive tsOut, uHIVE, i
			else
				''' "SOFTWARE\Microsoft" when subkey i=="Microsoft"
				dumpKeyRecursive tsOut, uHIVE, strKeyPath & "\" & i
			end if
		end if
	next
	end if

End Sub

' prereq: global objReg, objShell, hexBreak, maxBinary
' reg2AddReg WScript.StdOut, "HKLM\Software\Microsoft"
Sub reg2AddReg (ByRef tsOut, strHiveKeyPath)
	Dim sHIVE,sKey

	' strip trailing "\"
	strHiveKeyPath = LTrim(strHiveKeyPath)
	While Right(strHiveKeyPath,1) = "\" strHiveKeyPath=Left(strHiveKeyPath, Len(strHiveKeyPath)-1): Wend

	if InStr(strHiveKeyPath, "\") > 0 then
		''' "HKCU\SOFTWARE"
		sHIVE = Left(strHiveKeyPath, InStr(strHiveKeyPath, "\")-1)	' first token
		sKey = Mid(strHiveKeyPath, InStr(strHiveKeyPath,"\")+1)
	else
		''' plain "HKEY_CURRENT_USER", without subkey
		sHIVE = strHiveKeyPath
		sKey = ""
	end if

	if hs2u.Exists(sHIVE) then
		dumpKeyRecursive tsOut, hs2u.Item(sHIVE), sKey 
	else
		wscript.StdErr.WriteLine "ERROR: Unidentified tree name [" & sHIVE & "]"
		tsOut.WriteLine ";;?treename?;" & escQ(strHiveKeyPath)
		'wscript.Quit
	end if
End Sub


''' Main routine to parse command line arguments

Dim objFSO
set objFSO = CreateObject("Scripting.FileSystemObject")

Dim opt_u,strOutFile
Dim tsOutFile
opt_u = vbUseDefault	'cf. FileSystemObject.OpenTextFile()
strOutFile = Null
Set tsOutFile = wscript.StdOut	'TextStream object, to be replaced by "-o outFile"

''' parse options
Dim optind, optarg
for optind=0 to wscript.Arguments.Count-1
	optarg = wscript.Arguments(optind)
	if Left(optarg,1) = "/" then optarg=Replace(optarg,"/","-",1,1)
	Select Case optarg
	  Case "-b"
		optind=optind+1
		hexBreak = Int(wscript.Arguments(optind))
	  Case "-u"
		opt_u = vbTrue
	  Case "-o"
		if not IsNull(strOutFile) then tsOutFile.Close
		optind=optind+1
		strOutFile = wscript.Arguments(optind)
		set tsOutFile = objFSO.OpenTextFile(strOutFile, 2, -1, opt_u)
		''' BOM (Byte Order Mark) is automatically prepended
	  Case "-s"
		optind=optind+1
		maxBinary = Int(wscript.Arguments(optind))
	  Case "-?"
		wscript.echo "Usage: " & vbCrLf & _
		"cscript //nologo //U dump2inf.vbs [-b 32][-s 16384] HKLM\SOFTWARE ... > output.inf" & vbCrLf & _
		"cscript //nologo dump2inf.vbs [-b 32][-s 16384] -u -o output.inf HKLM\SOFTWARE ...." & vbCrLf & _
		"  -o file.inf	Output to file.inf instead of stdout" & vbCrLf & _
		"  -u		Output the -o file in Unicode mode" & vbCrLf & _
		"  -s 16384	Maximum REG_BINARY size to dump" & vbCrLf & _
		"  -b 32		Maximum bytes in a line for REG_BINARY dump" & vbCrLf & _
		vbCrLf & "Example: Dump the whole HKEY_CURRENT_USER in ANSI text file hkcu.inf: " & vbCrLf & _
		"cscript //nologo dump2inf.vbs HKCU > hkcu.inf" & vbCrLf & _
		vbCrLf & "Example: Dump HKEY_LOCAL_MACHINE\Software in UTF16 to SOFTWARE.INF: " & vbCrLf & _
		"cscript //nologo dump2inf.vbs -u -o SOFTWARE.INF HKLM\Software" & vbCrLf
		wscript.quit(1)
	  Case Else
		Exit For
	End Select
next

'' output BOM for stdout first
'' Object comparison (tsOutFile Is WScript.StdOut) seems to be always False, 
'' so switch by strOutFile
if IsNull(strOutFile) then
	'' will barf on ANSI mode TextStream anyway
	on error resume next
	    tsOutFile.Write chrW(&HFEFF)
	on error goto 0
end if

tsOutFile.WriteLine "[Version]"
tsOutFile.WriteLine "Signature = ""$Windows NT$""" & VbCRLF
tsOutFile.WriteLine "[DefaultInstall]"
tsOutFile.WriteLine "AddReg = section.addreg" & VbCRLF
tsOutFile.WriteLine "[section.addreg]"

''' parse args "HIVE\Subkey" ...
for optind=optind to wscript.Arguments.Count-1
	reg2AddReg tsOutFile, wscript.Arguments(optind)
next

tsOutFile.Close

'end


' DONE: default value of the key HKR\.ico subkey enum malfunct
' DONE: Key-only will set default values to null string, not "no value"
' DONE: squelch no-value key to emit ",16" line if leaf key exists; lots of them
' DONE: non-REG_SZ default value of a key (undetectable?)
' DONE: infinite loop under HKLM,SYSTEM\ControlSet002\Control\CriticalDeviceDatabase (empty subkey name?)
' DONE: param HKLM\SOFTWARE\... ...
' DONE: output BOM (chr(&HFEFF)) (todo: unconditional)
' DONE: command line params
' DONE: -o output.inf
' DONE: -u (unicode output)
' DONE: Vista compensate for detecting nonexistent default value
' done (vista) REG_QWORD HKEY_CURRENT_USER\Control Panel\Appearance\New Schemes\0\Sizes\0
' done (vista) invalid? QWORD HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Group Policy\Scripts\Logon\0\0,ExecTime
' DONE: sort keys/values, for easy diff(1)
' DONE: no GetQWORDValue on Win2000 -> emit warning and continue
' DONE: default REG_MULTI_SZ without explicit values: HKEY_LOCAL_MACHINE\SOFTWARE\Classes\Installer\Assemblies\c:|Program Files|Microsoft Office|OFFICE11|ADDINS|MSOSEC.DLL
' DONE: superlong REG_MULTI_SZ in "HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Perflib\011" (150kB) -> continuation line every 2048
' DONE: express REG_QWORD by 8-tuple binary value
' DONE: REG_QWORD 53bit overflow error 2008: "HKCU\Software\Microsoft\Windows\Windows Error Reporting"
' DONE: (2008) "root invalid" error (valuename has "\"!!) -> revert with expanded value WshShell.RegRead: "HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\Wallpapers\knownfolders\0\Windows Wallpapers\MergeFolders\%SystemRoot%\web\wallpaper"
' DONE: better sort, some keys have ~3000 subkeys => implement quicksort
' (nodo) REG_EXPAND_SZ as default value HKEY_CURRENT_USER\AppEvents\Schemes\Apps\.Default\Close\Utopia0 no other name-values, but probably undumpable
' done: Optimize speed by using RegRead() (cannot get valuename with "\")
'  HKLM\SYSTEM\CurrentControlSet 1:25
'  optimized(except REG_SZ) 1:07
'  optimized(all) 0:40 but XXX lots of binary-buggy REG_SZ in Windows 2000
' DONE: compare "string2" < "String10"
' nodo: (2008) DWORD but 8byte length error "HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\Group Policy\History\{35378EAC-683F-11D2-A89A-00C04FBBCFA2}\0",lParam
' done: -s 16384 long REG_BINARY cutoff
' done: refuse dumping long REG_BINARY (>16k?) 300kB entry of HKLM,SOFTWARE\Microsoft\Windows\CurrentVersion\PropertySystem\PropertySchema,CachedSchema
' done: (2003,2008 OK)(vista OK) dump "HKEY_CURRENT_USER" (no subkey, only hivespec)
' done: 2k: cannot dump HKU\.DEFAULT\Console >> needs Hotfix
' done: Vista: RegRead("HKU\...") errors, need RegRead("HKEY_USERS") !!

' todo: (not on 2008)(test on vista) mass default values REG_MULTI_SZ: HKEY_LOCAL_MACHINE\SOFTWARE\Classes\Installer\
' todo: -x "exclude\registry\key"
' (todo) ignore ControlSet001 et al?
' (todo) redirect stderr?