Rob van der Woude's Scripting Pages
Powered by GeSHi

Source code for reg2vbs.vbs

(view source code of reg2vbs.vbs as plain text)

  1. 'Reg2Vbs v1.5a
  2. 'Original Reg2Vbs v1.0 coded by Tim Mortimer
  3. 'Enhanced Reg2Vbs v1.51 by Denis St-Pierre (Ottawa, Canada)
  4. 'License: Public Domain
  5. '
  6. 'Purpose: converts ALL reg files in current directory to VBS in one shot!
  7. 'OS:	  works in 2k and up
  8. 'Liability: Use at your own risk!
  9. '
  10. 'v1.5 features:
  11. 'Handles REG_SZ, REG_DWORD, BINARY (U/A), MULTI-SZ, EXPAND_SZ and Default values (lines that start with @= )
  12. 'Handles Comments (lines that start with ;)
  13. 'Handles Comments at end of DWORD lines
  14. 'Handles values and data containing Chr(34), if encountered Chr(34) will be removed or processed (Default,REG_SZ) to prevent corrupt output file
  15. 'Adds blank line after each BINARY, MULTI-SZ, and EXPAND_SZ blocks (easier to read vbs)
  16. 'Handles deletion of keys or values using the "-" identifier
  17. 'UNsupported values are commented into VBS file
  18.  
  19. 'v1.5 Limitations:
  20. 'Cannot handle comments at end of MULTI-SZ, BINARY and EXPAND_SZ lines (never will)
  21. 'Cannot handle @="\"c:\blabla\""	default values for some reason
  22. 'Cannot handle Hex values that end without ",00" or ",00,00"
  23. 'Cannot handle Key names containing Chr(34)	NOTE: Key names with " are valid (see paper sizes in registry)
  24. 'CAVEAT:last line in REG file needs to be blank or else last line is ignored
  25.  
  26. '
  27. 'v1.0 Limitations:
  28. '1 - Only HKEY_CLASSES_ROOT, HKEY_CURRENT_USER and HKEY_LOCAL_MACHINE root keys are supported
  29. '2 - Only REG_SZ and REG_DWORD values are supported
  30. '3 - Keys, values and data containing Chr(34) are not supported and, if encountered, will cause corrupt output file
  31. '4 - Deletion of keys or values using the "-" identifier is not supported
  32. '5 - Comments are not handled
  33.  
  34. Option Explicit
  35.  
  36. 'Constant declarations
  37. Const sDelim = "|"
  38. Const ForReading = 1
  39. Const TristateUseDefault = -2
  40. const HKEY_LOCAL_MACHINE = &H80000002
  41.  
  42. 'Global declarations
  43. Dim FSO, g_KEY, g_Err, g_CurrentFile, g_long_HKEY
  44.  
  45. Set FSO = CreateObject("Scripting.FileSystemObject") 'Initialize the file system object
  46.  
  47. Dim sFiles
  48. Dim nFiles
  49. Dim i, bDoingMultiSZ, bUsingStdRegProv, strMultiValue, MultiValue
  50. Dim bDoingBINARY, strBINARYValue,bDoingUnicode, strEXPANDSZValue, bDoingEXPANDSZ
  51.  
  52.  
  53. 'Add key - Set global key values
  54. Dim l_HKEY, l_LenHKEY, l_SubKey
  55. Dim g_Value
  56.  
  57. g_Err = "" 'Initialize global error object
  58.  
  59. 'setting default values
  60. bDoingBINARY=False
  61. strBINARYValue=False
  62. bDoingUnicode=False
  63.  
  64. 'Get a list of reg files in the current directory and sort into an array
  65. sFiles = Split(GetRegFiles, sDelim)
  66. 'Get number of files
  67. nFiles = UBound(sFiles) - 1
  68. 'Loop through all files
  69. For i = 0 To nFiles
  70. 	'Set global current file
  71. 	g_CurrentFile = sFiles(i)
  72. 	MsgBox "Openning "&g_CurrentFile
  73. 	'Convert the file
  74. 	If (Not ConvertFile(g_CurrentFile)) Then
  75. 		MsgBox "An error occurred while converting the file: " & sFiles(i), vbCritical, "Error - reg2vbs"
  76. 	End If
  77. Next
  78.  
  79. 'create log file
  80. If Len(g_Err) > 0 Then
  81. 	MsgBox "Errors where encountered while converting the files.  Check error.log for details", vbCritical, "Conversion Completed - Errors"
  82. 	Dim hErrFile
  83. 	Set hErrFile = FSO.CreateTextFile("error.log", True)
  84. 	PrependLine g_Err, "Created: " & Now
  85. 	PrependLine g_Err, "Reg2Vbs v1.5 Error Log"
  86. 	PrependLine g_Err, "<-------------------- START ERROR LOG -------------------->"
  87. 	AppendLine g_Err, "<--------------------- END ERROR LOG --------------------->"
  88. 	hErrFile.Write g_Err
  89. 	hErrFile.Close
  90. 	Set hErrFile = Nothing
  91. End If
  92.  
  93. MsgBox "All .reg files have been converted"
  94. 'Free thefile system object
  95. Set FSO = Nothing
  96. WScript.Quit
  97.  
  98.  
  99. ' ======================================================================================================
  100. ' ======================================================================================================
  101. '
  102. '				FUNCTIONS Used
  103. '
  104. ' ======================================================================================================
  105. ' ======================================================================================================
  106. 'Function IsRegFile(sFile)
  107. 	'Checks for valid file extension
  108. '	IsRegFile = (LCase(FSO.GetExtensionName(sFile)) = "reg")
  109. 'End Function
  110.  
  111.  
  112. Function GetRegFiles()
  113. 	'Find all *.reg files in the current directory
  114. 	Dim oDir
  115. 	Dim oFile
  116. 	Dim oFiles
  117. 	Dim sCurrentDir
  118. 	Dim sResult
  119. 	'Get current directory
  120. 	sCurrentDir = Left(WScript.ScriptFullName, Len(WScript.ScriptFullName) - Len(WScript.ScriptName))
  121. 	'Obtain handle to directory
  122. 	Set oDir = FSO.GetFolder(sCurrentDir)
  123. 	'Retrieve list of files in current directory
  124. 	Set oFiles = oDir.Files
  125. 	For Each oFile In oFiles
  126. 		'Check for valid extension
  127. 		If LCase(FSO.GetExtensionName(oFile.Name)) = "reg" Then 'Checks for valid file extension
  128. 			'Add reg filename to result
  129. 			sResult = sResult & oFile.Path & sDelim
  130. 		End If
  131. 	Next
  132. 	'Assign function return value
  133. 	GetRegFiles = sResult
  134. End Function
  135.  
  136.  
  137.  
  138. Function IsValidRegFile(sFirstLine)
  139. 	'Checks for valid registry file
  140. 	Dim Result
  141. 	Select Case sFirstLine
  142. 	Case "Windows Registry Editor Version 5.00"
  143. 		'Windows 2000, XP
  144. 		Result = True
  145. 	Case "REGEDIT4"
  146. 		'Windows 95, 98 ME
  147. 		Result = True
  148. 	Case Else
  149. 		'Unknown registry file format
  150. 		Result = False
  151. 	End Select
  152. 	IsValidRegFile = Result
  153. End Function
  154.  
  155.  
  156. Function ConvertFile(sFile)
  157. 	'Converts the registry file to a vbscript file
  158. 	Dim hRegFile
  159. 	Dim hVBSFile
  160. 	Dim sRegFile
  161. 	Dim sVBSFile
  162. 	Dim sVBSBuffer
  163.  
  164. 	'Initialize the buffer
  165. 	sVBSBuffer = ""
  166. 	'Open the file as for reading in default system format (ANSI or Unicode)
  167. 	Set hRegFile = FSO.OpenTextFile(sFile, ForReading, False, TristateUseDefault)
  168. 	'Read the file contents into the buffer
  169. 	sRegFile = hRegFile.ReadAll
  170. 	'Split the buffer into an vbCrLf delimitered array
  171. 	sRegFile = Split(sRegFile, vbCrLf)
  172.  
  173. 	If IsValidRegFile(sRegFile(0)) Then	'if reg file is valid continue
  174. 		'Create initial vbs code
  175. 		AppendLine sVBSBuffer, "'VBScript Registry File created with Reg2VBS v1.5"
  176. 		AppendLine sVBSBuffer, "'v1.0 Coded by Tim Mortimer"
  177. 		AppendLine sVBSBuffer, "'v1.5 Coded by Denis St-Pierre (ottawa, Canada)"
  178. 		AppendLine sVBSBuffer, "'Creation time: " & Now
  179. 		AppendLine sVBSBuffer, "Option Explicit"
  180. 		AppendLine sVBSBuffer, "Dim objShell"
  181. 		AppendLine sVBSBuffer, "Set objShell = CreateObject(""WScript.Shell"")"
  182. 		'AppendLine sVBSBuffer, ""
  183.  
  184. 		'Add StdRegProv support in case of Binary, Multi_SZ values
  185. 		AppendLine sVBSBuffer, ""
  186. 		AppendLine sVBSBuffer, "'Add StdRegProv support in case of Binary, Multi_SZ values"
  187. 		AppendLine sVBSBuffer, "Dim strComputer, ArrOfValue, oReg"
  188. 		AppendLine sVBSBuffer, "const HKEY_USERS = &H80000003"
  189. 		AppendLine sVBSBuffer, "const HKEY_LOCAL_MACHINE = &H80000002"
  190. 		AppendLine sVBSBuffer, "const HKEY_CURRENT_USER = &H80000001"
  191. 		AppendLine sVBSBuffer, "const HKEY_CLASSES_ROOT = &H80000000"
  192. 		AppendLine sVBSBuffer, "strComputer = ""."""
  193. 		AppendLine sVBSBuffer, "Set oReg=GetObject(""winmgmts:{impersonationLevel=impersonate}!\\"" & strComputer & ""\root\default:StdRegProv"")	'used for Binary, Multi_SZ values"
  194.  
  195.  
  196. 		Dim sVBSLine
  197. 		Dim i
  198. 		For i = 1 to ubound(sRegFile) - 1 'Start at line 1 to avoid the header
  199. 			'Check for blank lines
  200. 			If Len(Trim(sRegFile(i))) > 0 Then
  201. 				sVBSLine = ConvertLine(sRegFile(i)) 'Convert registry line into vbscript equivalent
  202. 				AppendLine sVBSBuffer, sVBSLine		'Add converted line to sVBSBuffer
  203. 			Else
  204. 				'Blank line.  Do nothing.
  205. 			End If
  206. 		Next
  207. 		'Create the vbs filename
  208. 		sVBSFile = Left(sFile, Len(sFile) - 3) & "vbs"
  209.  
  210. 		'Add trailing code
  211. 		AppendLine sVBSBuffer, "Set objShell = Nothing"
  212. 		AppendLine sVBSBuffer, "WScript.Quit"
  213.  
  214. 		'Write the file
  215. 		Set hVBSFile = FSO.CreateTextFile(sVBSFile, True)
  216. 			hVBSFile.Write sVBSBuffer
  217. 			hVBSFile.Close
  218. 		Set hVBSFile = Nothing
  219.  
  220. 		ConvertFile = True		'Return true
  221. 	Else
  222. 		'Not a valid registry file
  223. 		'Add error to list
  224. 		AddError "Invalid registry file: " & sFile
  225. 		ConvertFile = False		'Return false
  226. 	End If
  227.  
  228. 	hRegFile.Close	'Close the registry file
  229. 	Set hRegFile = Nothing
  230. End Function
  231.  
  232.  
  233. Function GetHKEYValue(sHKEY)
  234. 	'Translates the HKEY value to RegWrite compatible one
  235. 	Select Case sHKEY
  236. 	Case "HKEY_CLASSES_ROOT": GetHKEYValue = "HKCR"
  237. 	Case "HKEY_CURRENT_USER": GetHKEYValue = "HKCU"
  238. 	Case "HKEY_LOCAL_MACHINE": GetHKEYValue = "HKLM"
  239. 	Case Else
  240. 		AddError "Unknown HKEY value: " & sHKEY
  241. 		GetHKEYValue = "Unknown HKEY value"
  242. 	End Select
  243. End Function
  244.  
  245.  
  246. Function ConvertLine(sRegLine) 	'Converts a registry file line into the vbscript equivalent
  247. 	Dim sLine, Result
  248. 	sLine = Trim(sRegLine)	'Remove spaces at begin and end of line
  249. 	If Len(sLine) = 0 Then
  250. 		MsgBox "ConvertLine - Len(sRegLine) = 0 - Shouldn't be here", vbCritical
  251. 		'Do nothing - blank line
  252. 	ElseIf Left(sLine, 1) = ";" Then								'*** ; comment 	 *****
  253. 		Result="'"&Mid(sLine, 2, Len(sLine))
  254.  
  255. 	ElseIf Left(sLine, 2) = "@=" Then						'		***	@= Default Value****
  256. 		Dim l_datad	
  257. 		l_datad=Right(sLine,Len(sLine)-2)
  258. 		if Len(l_datad) >2 then 	'if not blank, check for chr(34) in data
  259. 			Dim l_datadRAW
  260. 			l_datadRAW=Mid(l_datad,2,len(l_datad)-2)	'Remove chr(34) at beginning and end of string
  261. 			If Instr(1, l_datadRAW, chr(34), vbTextCompare)>0 then 'if contains " ==> chr(34)
  262. 				l_datadRAW=Replace(l_datadRAW, """", """""")
  263. '				l_datadRAW=Replace(l_datadRAW, "\""", "\""""")	' to try to handle "\"c:\blabla\""	=> NFG!!!
  264. 				l_datadRAW=Replace(l_datadRAW, "\"&chr(34), "\"&chr(34)&chr(34))	' to try to handle "\"c:\blabla\""	=> NFG!!!
  265. '					AddError "value data contained "" Now fixed. was: " & sLine
  266. 				l_datad=""""&l_datadRAW&""""	'Add chr(34) back at beginning and end of string
  267. 			End if
  268. 		End if
  269. 		Result = "objShell.RegWrite """ & g_Key & "\" & "" & """, " & Right(sLine,Len(sLine)-2) & ", " & Chr(34) & "REG_SZ" & Chr(34)&" 'Default value"
  270.  
  271. 	ElseIf Left(sLine, 2) = "[-" Then								'***    Delete KEY 	(starts with [- )	*****
  272. 		'Extract HKEY value and convert it to be vbscript' RegWrite compatible 
  273. 		'NOTE: Key names with " are valid (see paper sizes in registry)
  274. 		l_HKEY = Mid(sLine, 2, Instr(sLine, "\") - 2)
  275. 		l_HKEY=Replace(l_HKEY, "-", "")	'remove - to process
  276. 		l_LenHKEY = Len(l_HKEY)
  277. 		l_HKEY = GetHKEYValue(l_HKEY)
  278. 		l_Subkey = Mid(sLine, l_LenHKey + 3, Len(sLine) - l_LenHKEY - 3) 	'Extract subkey data
  279. 		g_Key = l_HKEY & "\" & l_SubKey			'Reconstruct new key data
  280.  
  281. 		'check for " in key name	(Sanity check)
  282. '		If Instr(1, g_Key, chr(34), vbTextCompare)>0 then 'if contains " ==> invalid Keyname!
  283. '			msgbox g_Key&" contains "" which is invalid."&vbcrlf&"it is being removed to proceed"
  284. '			g_Key=Replace(g_Key, """", "")
  285. '			AddError "Key name is invalid=> fixed. was: " & sLine
  286. '		End if
  287.  
  288. 		'Create the key
  289. 		Result = "objShell.RegDelete """&g_Key&"\"&""""
  290.  
  291. 	ElseIf Left(sLine, 1) = "[" Then								'***     KEY 	(starts with [ )	*****
  292. 		'Extract HKEY value and convert it to be vbscript' RegWrite compatible 
  293. 		'NOTE: Key names with " are valid (see paper sizes in registry)
  294. 		l_HKEY = Mid(sLine, 2, Instr(sLine, "\") - 2)
  295. '		msgbox "g_long_HKEY="&g_long_HKEY
  296. 		g_long_HKEY=l_HKEY		'Needed for WMI's StdRegProv Class
  297. 		l_LenHKEY = Len(l_HKEY)
  298. 		l_HKEY = GetHKEYValue(l_HKEY)
  299. 		l_Subkey = Mid(sLine, l_LenHKey + 3, Len(sLine) - l_LenHKEY - 3)	'Extract subkey data
  300. 		g_Key = l_HKEY & "\" & l_SubKey			'Reconstruct new key data
  301.  
  302. 		'check for " in key name	(Sanity check)
  303. '		If Instr(1, g_Key, chr(34), vbTextCompare)>0 then 'if contains " ==> invalid Keyname!
  304. '			msgbox g_Key&" contains "" which is invalid."&vbcrlf&"it is being removed to proceed"
  305. '			g_Key=Replace(g_Key, """", "")
  306. '			AddError "Key name is invalid=> fixed. was: " & sLine
  307. '		End if
  308.  
  309. 		'Create the key
  310. 		Result = "objShell.RegWrite """ & g_Key & "\"", """""
  311.  
  312.  
  313. 	ElseIf LCase(right(sLine, 2)) = ",\" AND bDoingMultiSZ=TRUE Then	'	*** Multi-SZ **** Middle of MultiSZ Value statement
  314. 		strMultiValue=sLine
  315. 		'convert ,\ to ,_	(sneaky way to process reg one line at a time)
  316. 		strMultiValue="&H"&Replace(strMultiValue, ",\", ",_")
  317. 		'convert Hex values to &H hex values
  318. 		strMultiValue=Replace(strMultiValue, ",", ",&H")
  319. 		strMultiValue=Replace(strMultiValue, ",&H_", ",_") 'Fix the ends
  320. 		Result = strMultiValue
  321.  
  322. 	ElseIf LCase(right(sLine, 5)) = "00,00" AND bDoingMultiSZ=TRUE Then	'	*** Multi-SZ **** End of MultiSZ Value statement
  323. 		bDoingMultiSZ=False		'Were done with *this* multi line statement, setting up for next
  324. 		bDoingUnicode=False
  325. 		strMultiValue=sLine
  326. 		'convert Hex values to &H hex values
  327. 		strMultiValue="&H"&Replace(strMultiValue, ",", ",&H")
  328. '		strMultiValue=Replace(strMultiValue, ",&H_", ",_") 'Fix the ends
  329. 		Result = strMultiValue &")"
  330. 		'	 					oReg.SetMultiStringValue HKEY_LOCAL_MACHINE,strKeyPath,strMultiValue,iValues
  331. 		Result = Result&vbCRLF&"oReg.SetMultiStringValue "&g_long_HKEY&", """&l_Subkey&""", """&g_Value&""", ArrOfValue"&vbCRLF		
  332.  
  333.  
  334. 	ElseIf LCase(right(sLine, 2)) = ",\" AND bDoingBINARY=TRUE Then	'		*** BINARY **** Middle of BINARY Value statement
  335. 		strBINARYValue=sLine
  336. 		'convert ,\ to ,_	(sneaky way to process reg one line at a time)
  337. 		strBINARYValue="&H"&Replace(strBINARYValue, ",\", ",_")
  338. 		'convert Hex values to &H hex values
  339. 		strBINARYValue=Replace(strBINARYValue, ",", ",&H")
  340. 		strBINARYValue=Replace(strBINARYValue, ",&H_", ",_") 'Fix the ends
  341. 		Result = strBINARYValue
  342.  
  343. 	ElseIf LCase(right(sLine, 5)) = "00,00" AND bDoingBINARY=TRUE AND bDoingUnicode=TRUE Then	'	*** BINARY **** End of BINARY Value statement (unicode)
  344. 		bDoingBINARY=False		'Were done with *this* BINARY line statement, setting up for next
  345. 		bDoingUnicode=False
  346. 		strBINARYValue=sLine
  347. 		'convert Hex values to &H hex values
  348. 		strBINARYValue="&H"&Replace(strBINARYValue, ",", ",&H")
  349. '		strBINARYValue=Replace(strBINARYValue, ",&H_", ",_") 'Fix the ends
  350. 		Result = strBINARYValue &")"
  351. 		'	 					oReg.SetBinaryValue HKEY_LOCAL_MACHINE,strKeyPath,BinaryValueName,iValues
  352. 		Result = Result&vbCRLF&"oReg.SetBinaryValue "&g_long_HKEY&", """&l_Subkey&""", """&g_Value&""", ArrOfValue"&vbCRLF
  353.  
  354. 	ElseIf LCase(right(sLine, 3)) = ",00" AND bDoingBINARY=TRUE AND bDoingUnicode=False Then	'	*** BINARY **** End of BINARY Value statement (ASCII)
  355. 		bDoingBINARY=False		'Were done with *this* BINARY line statement, setting up for next
  356. 		bDoingUnicode=False
  357. 		strBINARYValue=sLine
  358. 		'convert Hex values to &H hex values
  359. 		strBINARYValue="&H"&Replace(strBINARYValue, ",", ",&H")
  360. '		strBINARYValue=Replace(strBINARYValue, ",&H_", ",_") 'Fix the ends
  361. 		Result = strBINARYValue &")"
  362. 		'	 					oReg.SetBinaryValue HKEY_LOCAL_MACHINE,strKeyPath,BinaryValueName,iValues
  363. 		Result = Result&vbCRLF&"oReg.SetBinaryValue "&g_long_HKEY&", """&l_Subkey&""", """&g_Value&""", ArrOfValue"&vbCRLF
  364.  
  365.  
  366. 	ElseIf LCase(right(sLine, 2)) = ",\" AND bDoingEXPANDSZ=TRUE Then	'		*** EXPAND_SZ **** Middle of EXPAND_SZ Value statement
  367. 		strEXPANDSZValue=sLine
  368. 		'convert ,\ to ,_	(sneaky way to process reg one line at a time)
  369. 		strEXPANDSZValue="&H"&Replace(strEXPANDSZValue, ",\", ",_")
  370. 		'convert Hex values to &H hex values
  371. 		strEXPANDSZValue=Replace(strEXPANDSZValue, ",", ",&H")
  372. 		strEXPANDSZValue=Replace(strEXPANDSZValue, ",&H_", ",_") 'Fix the ends
  373. 		Result = strEXPANDSZValue
  374.  
  375.  
  376. 	ElseIf LCase(right(sLine, 5)) = "00,00" AND bDoingEXPANDSZ=TRUE AND bDoingUnicode=TRUE Then	'	*** EXPAND_SZ **** End of EXPAND_SZ Value statement (unicode)
  377. 		bDoingEXPANDSZ=False		'Were done with *this* EXPAND_SZ line statement, setting up for next
  378. 		bDoingUnicode=False
  379. 		strEXPANDSZValue=sLine
  380. 		'convert Hex values to &H hex values
  381. 		strEXPANDSZValue="&H"&Replace(strEXPANDSZValue, ",", ",&H")
  382. '		strEXPANDSZValue=Replace(strEXPANDSZValue, ",&H_", ",_") 'Fix the ends
  383. 		Result = strEXPANDSZValue &")"
  384. 		'	 					oReg.SetExpandedStringValue HKEY_LOCAL_MACHINE,strKeyPath,strEXPANDSZValue,iValues
  385. 		Result = Result&vbCRLF&"oReg.SetExpandedStringValue "&g_long_HKEY&", """&l_Subkey&""", """&g_Value&""", ArrOfValue"&vbCRLF
  386.  
  387.  
  388. 	ElseIf Left(sLine, 1) = Chr(34) Then	'***   Start of Value  (line starts with " ) 	*****
  389. 		'Add Value
  390. '		Dim l_Value 'Now g_value
  391. 		Dim l_Data
  392. 		Dim l_Comment
  393. 		'Extract value and data from sRegLine
  394. 		g_Value = Mid(sLine, 2, Instr(sLine, "=") - 3)
  395. 		l_Data = Right(sLine, Len(sLine) - Len(g_Value) - 3)
  396. 		l_Comment=""
  397.  
  398. 		If Instr(1, g_Value, chr(34), vbTextCompare)>0 then 'if Value name contains " ==> remove it
  399. 			msgbox "Value name "&g_Value&" contains "" and will now be removed"
  400. 			g_Value=Replace(g_Value, """", "")
  401. '			AddError "value name contained chr(34) "" Now fixed. was: " & sLine
  402. 		End if
  403. 		'Check what type of data we are converting
  404. 		If Left(l_Data, 1) = Chr(34) Then								'	***	STRING Value (starts with " )****
  405. 			if Len(l_Data) >2 then 	'if not blank
  406. 				Dim l_dataRAW
  407. 				l_dataRAW=Mid(l_Data,2,len(l_Data)-2)	'Remove chr(34) at beginning and end of string
  408. 				If Instr(1, l_dataRAW, chr(34), vbTextCompare)>0 then 'if contains " ==> chr(34)
  409. 					'msgbox l_dataRAW&" contains "" being fixed to proceed"
  410. 					l_dataRAW=Replace(l_dataRAW, """", """""")
  411. '					AddError "value data contained "" Now fixed. was: " & sLine
  412. 					l_data=""""&l_dataRAW&""""	'Add chr(34) back at beginning and end of string
  413. 				End if
  414. 			End if
  415. 			Result = "objShell.RegWrite """ & g_Key & "\" & g_Value & """, " & l_Data & ", " & Chr(34) & "REG_SZ" & Chr(34)
  416.  
  417. 		ElseIf Left(l_Data, 1) = "-" Then								'	***	Delete Value (starts with - )****
  418. 			Result = "objShell.RegDelete """ & g_Key & "\" & g_Value &""" 'Delete value"
  419.  
  420. 		ElseIf LCase(Left(l_Data, 5)) = "dword" Then						'	*** DWORD Value****
  421. 			If Instr(1, l_Data, ";", vbTextCompare)>0 then 'if contains ; ==> Comment
  422. 				l_Comment = "	'"&Mid(l_Data, Instr(1,l_Data, ";", vbTextCompare)+1 )	' Comment is ;(+1) to end of line
  423. 				l_Data = Trim(Mid(l_Data, 1,Instr(1,l_Data, ";", vbTextCompare)-1))	' Data is start to ;
  424. 			End if
  425. 			l_Data = Right(l_Data, Len(l_Data) - 6)
  426. 			Result = "objShell.RegWrite """ & g_Key & "\" & g_Value & """, " & HexToDec(l_Data) & ", " & Chr(34) & "REG_DWORD" & Chr(34)&l_Comment
  427.  
  428. 		ElseIf LCase(Left(l_Data, 7)) = "hex(7):" Then						'		*** Multi-SZ Value (Start) ****		
  429. 			strMultiValue=(right(l_Data, len(l_Data)-7))	'Get the values
  430. 			'convert ,\ to ,_	(sneaky way to process one line at a time)
  431. 			strMultiValue=Replace(strMultiValue, ",\", ",_")
  432. 			'convert Hex values to &H hex values
  433. '			iValues = Array(&H01,&Ha2,&H10)
  434. 			strMultiValue="&H"&Replace(strMultiValue, ",", ",&H")
  435. 			strMultiValue=Replace(strMultiValue, ",&H_", ",_") 'Fix the ends
  436. 			Result="ArrOfValue = Array("&strMultiValue&"	'Building array for handling Multi-SZ Value"	'convert values into an array but don't the statement yet! (use _ )
  437. 			bDoingMultiSZ=TRUE	'
  438. 			bUsingStdRegProv=TRUE
  439. 			If LCase(right(l_Data, 5)) = "00,00" then 'if the end of the line is "00,00" => end Statement
  440. 				'						oReg.SetMultiStringValue HKEY_LOCAL_MACHINE,strKeyPath, MultiValueName,iValues
  441. 				Result = Result&vbCRLF&"oReg.SetMultiStringValue "&g_long_HKEY&", """&l_Subkey&""", """&g_Value&""", ArrOfValue"
  442. 			End if	
  443.  
  444. 		ElseIf LCase(Left(l_Data, 8)) = "hex(03):" OR LCase(Left(l_Data, 4)) = "hex:" Then	'	*** BINARY Value (start) ****			
  445. 			If LCase(Left(l_Data, 8)) = "hex(03):" then 
  446. 				strBINARYValue=(right(l_Data, len(l_Data)-8))	'Get the Unicode values
  447. 				bDoingUnicode=True
  448. 			Else
  449. 				strBINARYValue=(right(l_Data, len(l_Data)-4))	'Get the ASCII values
  450. 				bDoingUnicode=False 'just in case
  451. 			End if
  452. 			'convert ,\ to ,_	(sneaky way to process one line at a time)
  453. 			strBINARYValue=Replace(strBINARYValue, ",\", ",_")
  454. 			'convert Hex values to &H hex values
  455. '			iValues = Array(&H01,&Ha2,&H10)
  456. 			strBINARYValue="&H"&Replace(strBINARYValue, ",", ",&H")
  457. 			strBINARYValue=Replace(strBINARYValue, ",&H_", ",_") 'Fix the ends
  458. 			Result="ArrOfValue = Array("&strBINARYValue&"	'Building array for handling BINARY Value"	'convert values into an array but don't finish the statement yet! (use _ )
  459. 			bDoingBINARY=TRUE	'
  460. 			bUsingStdRegProv=TRUE
  461. 			If LCase(right(l_Data, 5)) = "00,00" then 'if the end of the line is "00,00" => end Statement
  462. 							'			oReg.SetBinaryValue HKEY_LOCAL_MACHINE,strKeyPath,BinaryValueName,iValues
  463. 				Result = Result&vbCRLF&"oReg.SetBinaryValue "&g_long_HKEY&", """&l_Subkey&""", """&g_Value&""", ArrOfValue"
  464. 			End if	
  465.  
  466. 		ElseIf LCase(Left(l_Data, 7)) = "hex(2):" Then	'	*** EXPAND_SZ Value (start) ****			
  467. '			If LCase(Left(l_Data, 7)) = "hex(2):" then 
  468. 				strEXPANDSZValue=(right(l_Data, len(l_Data)-7))	'Get the Unicode values
  469. 				bDoingUnicode=True
  470. '			Else
  471. '				strEXPANDSZValue=(right(l_Data, len(l_Data)-4))	'Get the ASCII values
  472. '				bDoingUnicode=False 'just in case
  473. '			End if
  474. 			'convert ,\ to ,_	(sneaky way to process one line at a time)
  475. 			strEXPANDSZValue=Replace(strEXPANDSZValue, ",\", ",_")
  476. 			'convert Hex values to &H hex values
  477. '			iValues = Array(&H01,&Ha2,&H10)
  478. 			strEXPANDSZValue="&H"&Replace(strEXPANDSZValue, ",", ",&H")
  479. 			strEXPANDSZValue=Replace(strEXPANDSZValue, ",&H_", ",_") 'Fix the ends
  480. 			Result="ArrOfValue = Array("&strEXPANDSZValue&"	'Building array for handling EXPAND_SZ Value"	'convert values into an array but don't finish the statement yet! (use _ )
  481. 			bDoingEXPANDSZ=TRUE	'
  482. 			bUsingStdRegProv=TRUE
  483. 			If LCase(right(l_Data, 5)) = "00,00" then 'if the end of the line is "00,00" => end Statement
  484. 							'			oReg.SetBinaryValue HKEY_LOCAL_MACHINE,strKeyPath,strEXPANDSZValue,iValues
  485. 				Result = Result&vbCRLF&"oReg.SetExpandedStringValue "&g_long_HKEY&", """&l_Subkey&""", """&g_Value&""", ArrOfValue"
  486. 			End if	
  487. 		Else						'***	Unknown value type
  488. 			AddError "Unknown registry value type: " & sLine
  489. 			Result = "'Unknown value type" & sLine
  490. 		End If
  491.  
  492.  
  493. 	Else
  494. 		'Unknown registry line value
  495. 		AddError "Unknown registry line value: " & sRegLine
  496. 		Result = "'Unknown registry line Value" & sRegLine
  497. 	End If
  498. 	ConvertLine = Result
  499. End Function
  500.  
  501.  
  502.  
  503. Function HexToDec(sHex)
  504. 	'Converts a hexadecimal string into a decimal
  505. '	dim strNoKeyError
  506. '	On Error Resume Next	'Disable error checking
  507. 	HexToDec = CStr(CLng("&H" & sHex))
  508. '	strNoKeyError = Err.Description
  509. '	If NOT strNoKeyError="" then
  510. '		msgbox "error description="&strNoKeyError&vbcrlf&sRegLine
  511. '	End if
  512. '	Err.Clear
  513. '	On Error Goto 0		're-enable error checking
  514. End Function
  515.  
  516.  
  517. Sub AddError(sError)
  518. 	AppendLine g_Err, "[" & g_CurrentFile & "] - " & sError
  519. End Sub
  520.  
  521. Sub AppendStr(sVar, sStr)
  522. 	'Appends sStr to sVar.  Just cleaner than appending with "&" all the time
  523. 	sVar = sVar & sStr
  524. End Sub
  525.  
  526. Sub AppendLine(sVar, sStr)
  527. 	'Appends sStr to sVar and adds a vbCrLf
  528. 	AppendStr sVar, sStr & vbCrLf
  529. End Sub
  530.  
  531. Sub PrependStr(sVar, sStr)
  532. 	'Prepends sStr to sVar.  Just cleaner than appending with "&" all the time
  533. 	sVar = sStr & sVar
  534. End Sub
  535.  
  536. Sub PrependLine(sVar, sStr)
  537. 	'Prepends sStr to sVar and adds a vbCrLf
  538. 	PrependStr sVar, sStr & vbCrLf
  539. End Sub
  540.  

page last uploaded: 2017-07-06, 12:37