VBS/HTA and registry - help

**Gerry** · 6th July 2009, 12:44 PM

I'm trying to read registry entries and append them to a text file (from a HTA app). I'd prefer not to call an external program (regedit or cmd). I'm having problems getting some of the extracted values to match.

This is one of the keys I am trying to extract:

Code:

[HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProfileList\S-1-5-21-1885954632-1506356648-996637233-11986]
"ProfileImagePath"=hex(2):25,00,53,00,79,00,73,00,74,00,65,00,6d,00,44,00,72,\
  00,69,00,76,00,65,00,25,00,5c,00,44,00,6f,00,63,00,75,00,6d,00,65,00,6e,00,\
  74,00,73,00,20,00,61,00,6e,00,64,00,20,00,53,00,65,00,74,00,74,00,69,00,6e,\
  00,67,00,73,00,5c,00,73,00,77,00,69,00,6e,00,73,00,74,00,61,00,6c,00,6c,00,\
  00,00
"Sid"=hex:01,05,00,00,00,00,00,05,15,00,00,00,48,62,69,70,a8,2d,c9,59,31,7a,67,\
  3b,d2,2e,00,00
"Flags"=dword:00000000
"State"=dword:00000100
"CentralProfile"=""
"ProfileLoadTimeLow"=dword:dcd1fad3
"ProfileLoadTimeHigh"=dword:01c9e828
"Guid"="{7af97ce6-1ae2-49ce-8c84-ab4b503b16e3}"
"RefCount"=dword:00000000

And this is how it looks after my extraction:

Code:

[HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProfileList\[S-1-5-21-1885954632-1506356648-996637233-11986]
"ProfileImagePath"=hex(2):
"Sid"=hex:
"Flags"=dword:0
"State"=dword:256
"CentralProfile"=""
"ProfileLoadTimeLow"=dword:-590218541
"ProfileLoadTimeHigh"=dword:30009384
"Guid"="{7af97ce6-1ae2-49ce-8c84-ab4b503b16e3}"
"RefCount"=dword:0

As you can see most of the values have been mangled. The "ProfileImagePath" and "Sid" are blank because the script returns a "Type Mismatch" error so I commented the code out. I'm not very proficient with VBS/HTA and have mostly hacked my script together with a lot of help from Google so far. My problem is with extracting and appending registry value types properly. This is my code:

Code:

objRegistry.EnumValues HKEY_LOCAL_MACHINE, strKeyPath, arrValueNames, arrValueTypes

For i=0 To UBound(arrValueNames)
	objRegFile.Write """" & arrValueNames(i) & """="
	Select Case arrValueTypes(i)
		Case REG_SZ
			objRegistry.GetStringValue HKEY_LOCAL_MACHINE, strKeyPath, arrValueNames(i), strValue
			objRegFile.WriteLine """" & strValue & """"
		Case REG_EXPAND_SZ ' AKA hex(2)
			'objRegistry.GetExpandedStringValue HKEY_LOCAL_MACHINE, strKeyPath, arrValueNames(i), strValue ' Type mismatch here
			objRegFile.WriteLine "hex(2):" & strValue
		Case REG_BINARY ' AKA hex
			'objRegistry.GetBinaryValue HKEY_LOCAL_MACHINE, strKeyPath, arrValueNames(i), strValue ' Type mismatch here
			objRegFile.WriteLine "hex:" & strValue
		Case REG_DWORD
			objRegistry.GetDWORDValue HKEY_LOCAL_MACHINE, strKeyPath, arrValueNames(i), strValue
			objRegFile.WriteLine "dword:" & strValue
		Case REG_MULTI_SZ ' AKA hex(7)
			objRegistry.GetMultiStringValue HKEY_LOCAL_MACHINE, strKeyPath, arrValueNames(i), strValue
			objRegFile.WriteLine "hex(7):" & strValue
	End Select 
Next

Any help much appreciated.

**apeo** · 6th July 2009, 01:43 PM

Having a look.

Edit: Can you post up the whole script.

**Gerry** · 6th July 2009, 02:54 PM

Here you go. Please be aware it's still "rough" and needs tidying up. I have quite a few debug message boxes in there and some comments to myself. I still need to implement some error checking and a restore subroutine, and I may also split some code off from the "BackupProfile" subroutine into their own subs for reusability...

The idea is to be able to backup and restore local profiles without staff being present - until we get them onto network storage that is. To do that I need to get some info out of some registry keys (thanks to srochford for telling me which keys and which info is needed). I thought I'd try and automate it all in one script...

Code:

<SCRIPT Language="VBScript">
	' Ignore any errors
	On Error Resume Next

	' define some constants
	Const HKEY_LOCAL_MACHINE = &H80000002
	Const STR_GUID_PATH = "SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProfileGuid"
	Const ROOT_PROFILE_PATH = "HKLM\Software\Microsoft\Windows NT\CurrentVersion\ProfileList\"
	Const SID_STRING = "SidString"
	Const REG_SZ = 1
	Const REG_EXPAND_SZ = 2
	Const REG_BINARY = 3
	Const REG_DWORD = 4
	Const REG_MULTI_SZ = 7
	strComputer = "."

	Dim arrProfiles()

Sub Window_Onload
	'window.resizeTo 640,480 'Causes errors - there is a known workaround I need to implement
	GetProfiles()
End Sub

Function GetProfiles
	output_area.innerHTML = ""
	' Create a shell
	Set WSHShell = CreateObject("WScript.Shell") 
	
	' Open the Registry
	Set objRegistry=GetObject("winmgmts:\\.\root\default:StdRegProv")
	
	' Extract the ProfileGUID entries from the registry returned in arrGUIDs
	objRegistry.EnumKey HKEY_LOCAL_MACHINE, STR_GUID_PATH, arrGUIDs
	 
	' Process each of the entries in the ProfileGUID
	intX = 0
	For Each objSubkey In arrGUIDs
	
	    ' Extract the SID from the GUID entry
		strRegPath = STR_GUID_PATH & "\" & objSubkey
	    objRegistry.GetExpandedStringValue HKEY_LOCAL_MACHINE, strRegPath, SID_STRING, sidString
	
		' Extract the profile path from the ProfileList sub tree in the registry relating to the current GUID / SID
		strProfileRegPath = ROOT_PROFILE_PATH & sidString
		strRegKey = strProfileRegPath & "\ProfileImagePath"
		strProfilePath = WSHShell.RegRead (strRegKey)
		
		' Replace %systemdrive% with "c:"
		strProfilePath = replace(strProfilePath,"%SystemDrive%","C:")
		
		' Extract username from profilePath
		strUsername = Right(strProfilePath, Len(strProfilePath)-InStrRev(strProfilePath,"\"))
		
		' might need to drop "STAFF" from end of user name, add code here
		
		' validity checking goes here
		' exclude IT support from back-up
		' exclude profiles of users no longer on the network
		' exclude profiles of users who last used the system >= 3 months ?
		
		' Put profile information into an array
		ReDim Preserve arrProfiles(intX)
		' Comma delimeted data, use "Split" to recover
		arrProfiles(intX) = strUsername & "," & objSubkey & "," & sidString & "," & strProfileRegPath & "," & strProfilePath
		
		' Create mutually exclusive radio buttons for the profile names
		output_area.innerHTML = output_area.innerHTML & "<input type=""radio"" name=""ProfileOption"" value=""" & intX & """>" & strUsername & "<br><br>"
		intX = intX + 1
	Next
	output_area.innerHTML = output_area.innerHTML & "<input id=runbutton  class=""button"" type=""button"" value=""Backup"" name=""backup_button""  onClick=""BackupProfile"">"
End Function

Sub BackupProfile
	For Each objOption In ProfileOption
		If objOption.Checked Then
			'output_area.innerHTML = "<br>" & objOption.value & " chosen<br>" ' Debug
			strChosenProfile = objOption.value
		End If
	Next
	
	' Use strChosenProfile to select the correct data from arrProfiles
	arrProfile = Split(arrProfiles(strChosenProfile),",")
	strUsername = arrProfile(0)
	strGUID = arrProfile(1)
	strSID = arrProfile(2)
	strProfileRegPath = arrProfile(3)
	strProfilePath = arrProfile(4)
	
	'debug
	output_area.innerHTML = "Debug Message:<br>" & strUsername & "<br>" & strGUID & "<br>" & strSID & "<br>" & strProfileRegPath & "<br>" & strProfilePath
	
	' code to export Profile Registry Entries
	Set objShell = CreateObject("WScript.Shell")
	Set objFSO = CreateObject("Scripting.FileSystemObject")
	
	strScriptPath = location.pathname 'Full path to script
		
	MsgBox strScriptPath,0, "strScriptPath" 'Debug
	
	Set objFile = objFSO.GetFile(strScriptPath)

	strScriptFolder = objFSO.GetParentFolderName(objFile) ' Folder where script located
	
	MsgBox strScriptFolder,0, "strScriptFolder" 'Debug
	
	strRootBackupFolder = strScriptFolder & "\Backups"
	strProfileBackupFolder = strRootBackupFolder & "\" & strUsername
	strBackupRegFile = strUsername & ".reg"
	
	MsgBox strProfileBackupFolder,0, "strProfileBackupFolder" 'Debug
	MsgBox strBackupRegFile,0, "strBackupRegFile" 'Debug
	
	' Create "Backup" folder if it doesn't already exist
	If objFSO.FolderExists(strRootBackupFolder) Then
		Set objBackupFolder = objFSO.GetFolder(strRootBackupFolder)
		MsgBox strRootBackupFolder & " already created " ' Debug
	Else
		Set objBackupFolder = objFSO.CreateFolder(strRootBackupFolder)
		MsgBox "Just created " & strRootBackupFolder' Debug
	End If
	' Create folder for profilename
	If objFSO.FolderExists(strProfileBackupFolder) Then
		Set objBackupFolder = objFSO.GetFolder(strProfileBackupFolder)
		MsgBox strProfileBackupFolder & " already created " ' Debug
	Else
		Set objBackupFolder = objFSO.CreateFolder(strProfileBackupFolder)
		MsgBox "Just created " & strProfileBackupFolder' Debug
	End If
	
	' Create registry backup file
	' ProfileGuid bit:
	Set objRegFile = objFSO.CreateTextFile(strProfileBackupFolder & "\" & strBackupRegFile, True, True)
	objRegFile.WriteLine "Windows Registry Editor Version 5.00"
	objRegFile.WriteBlankLines(1)
	MsgBox "[HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProfileGuid\" & strGUID & "]" ' Debug
	objRegFile.WriteLine "[HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProfileGuid\" & strGUID & "]"
	objRegFile.WriteLine """SidString""=""" & strSID & """"
	objRegFile.WriteBlankLines(1)
	
	Dim arrValueNames
	Dim arrValueTypes
	'ProfileList bit:
	objRegFile.WriteLine "[HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProfileList\[" & strSID & "]"
	MsgBox "[HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProfileList\[" & strSID & "]" ' Debug
	
	Set objRegistry=GetObject("winmgmts:\\.\root\default:StdRegProv")
	'Set objRegistry=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\default:StdRegProv")

	strKeyPath = ROOT_PROFILE_PATH & strSID ' Includes "HKLM\" - need to remove
	MsgBox "strKeyPath:" & strKeyPath 'Debug
	'strKeyPath = Right(strKeyPath, len(strKeyPath)-InStr(strKeyPath,"\"))
	strKeyPath = "SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProfileList" & "\" & strSID ' Debug
	MsgBox "strKeyPath:" & strKeyPath 'Debug
	
	MsgBox "HKLM: " & HKEY_LOCAL_MACHINE & vbCrLf & "strKeyPath: " & strKeyPath & vbCrLf & "arrValueNames: " & arrValueNames & vbCrLf & "arrValueTypes: " & arrValueTypes 'Debug
	objRegistry.EnumValues HKEY_LOCAL_MACHINE, strKeyPath, arrValueNames, arrValueTypes
	
	For i=0 To UBound(arrValueNames)
		objRegFile.Write """" & arrValueNames(i) & """="
		Select Case arrValueTypes(i)
			Case REG_SZ
				objRegistry.GetStringValue HKEY_LOCAL_MACHINE, strKeyPath, arrValueNames(i), strValue
				objRegFile.WriteLine """" & strValue & """"
			Case REG_EXPAND_SZ ' AKA hex(2)
				'objRegistry.GetExpandedStringValue HKEY_LOCAL_MACHINE, strKeyPath, arrValueNames(i), strValue
				objRegFile.WriteLine "hex(2):" & strValue
			Case REG_BINARY ' AKA hex
			    'objRegistry.GetBinaryValue HKEY_LOCAL_MACHINE, strKeyPath, arrValueNames(i), strValue
			    objRegFile.WriteLine "hex:" & strValue
			Case REG_DWORD
				objRegistry.GetDWORDValue HKEY_LOCAL_MACHINE, strKeyPath, arrValueNames(i), strValue
				objRegFile.WriteLine "dword:" & strValue
			Case REG_MULTI_SZ ' AKA hex(7)
				objRegistry.GetMultiStringValue HKEY_LOCAL_MACHINE, strKeyPath, arrValueNames(i), strValue
				objRegFile.WriteLine "hex(7):" & strValue
		End Select 
	Next
	
	objRegFile.Close
	Set objRegFile = Nothing
	
	' Code to back up user data goes here
	' Call MS's Backup with the profile name?
	' Something like:
	' %SystemRoot%\system32\ntbackup.exe backup "C:\Documents and Settings\profilename" /j "profilename backup" /f "logical disk path and filename.bkf" /v:yes /r:no /l:s /hc:on
	' If I use that, don't want temp files and any other useless crap
End Sub

</SCRIPT>

<html>
<head>
<title>Profile Backup</title>

<HTA:APPLICATION ID="objPB"
     APPLICATIONNAME="ProfileBackup"
     SCROLL="yes"
     SINGLEINSTANCE="yes"
	 VERSION="0.1"
	 SINGLEINSTANCE="yes"
	 SYSMENU="yes"
>
</head>

<body>
<center>
<H1>Please choose a profile to backup</H1>
<span id=output_area></span>
<br><br>
</center>
</body>
</html>

**apeo** · 6th July 2009, 03:42 PM

Ok, I've just skimmed it and is there any reason why you want to export the information out as how regedit would export it out? That is:

Code:

"ProfileImagePath"=hex(2):25,00,53,00,79,00,73,00,74,00,65,00,6d,00,44,00,72,\
  00,69,00,76,00,65,00,25,00,5c,00,44,00,6f,00,63,00,75,00,6d,00,65,00,6e,00,\
  74,00,73,00,20,00,61,00,6e,00,64,00,20,00,53,00,65,00,74,00,74,00,69,00,6e,\
  00,67,00,73,00,5c,00,73,00,77,00,69,00,6e,00,73,00,74,00,61,00,6c,00,6c,00,\
  00,00
"Sid"=hex:01,05,00,00,00,00,00,05,15,00,00,00,48,62,69,70,a8,2d,c9,59,31,7a,67,\
  3b,d2,2e,00,00
"Flags"=dword:00000000

Are you planning on using another application to do something else with the data? Could you not just have say ProfileImagePath="c:\documents and settings\user"?

**Gerry** · 6th July 2009, 04:15 PM

I'd rather not use regedit to export the data. I think I've narrowed the problem down to the way I handle the data types. I think using "strValue" for each data type isn't going to work, I think I need to do some conversion to and from Long/Hex/Binary...

**apeo** · 7th July 2009, 08:23 AM

Originally Posted by Gerry

I'd rather not use regedit to export the data. I think I've narrowed the problem down to the way I handle the data types. I think using "strValue" for each data type isn't going to work, I think I need to do some conversion to and from Long/Hex/Binary...

My point is why are you trying export the information out as tho it was exported from regedit for example you could have the info exported as:

Code:

ProfileImagePath="c:\documents and settings\user"

Instead of what you are trying to do right now which is:

Code:

"ProfileImagePath"=hex(2):25,00,53,00,79,00,73,00,74,00,65,00,6d,00,44,00,72,\
  00,69,00,76,00,65,00,25,00,5c,00,44,00,6f,00,63,00,75,00,6d,00,65,00,6e,00,\
  74,00,73,00,20,00,61,00,6e,00,64,00,20,00,53,00,65,00,74,00,74,00,69,00,6e,\
  00,67,00,73,00,5c,00,73,00,77,00,69,00,6e,00,73,00,74,00,61,00,6c,00,6c,00,\
  00,00

**Gerry** · 7th July 2009, 09:45 AM

Originally Posted by apeo

My point is why are you trying export the information out as tho it was exported from regedit for example you could have the info exported as:

Code:

ProfileImagePath="c:\documents and settings\user"

I haven't tested this, I thought I'd have to keep the data in the same format...

**apeo** · 7th July 2009, 10:59 AM

Well if you are using vbs to do all the exporting and import then no you dont need it in the same format.

You may find this useful:

WMI Tasks: Registry (Windows)

LinkBack

Thread Tools

Search Thread

VBS/HTA and registry - help

Similar Threads

Computer Information Tool HTA script

Registry

Registry cleaner

Drive Space Report HTA

HTA For Controlling Workstation Internet Access

Thread Information

Users Browsing this Thread

Posting Permissions