asked on

Windows XP UserAssist Forensics

Similar to https://www.experts-exchange.com/questions/26953880/Windows-Registry-Forensics-using-Vbscript.html
Here are the windows XP differences from Windows7, most of the info I'm looking for are only found here:HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\UserAssist\{75048700-EF1F-11D0-9888-006097DEACF9}\Count
-rich

HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\UserAssist\{75048700-EF1F-11D0-9888-006097DEACF9}\Count

HRZR_EHACNGU:P:\JVAQBJF\flfgrz32\eqcpyvc.rkr        REG_BINARY      320000000600000050E9C6FA010DCC01
(ROT-13 -> UEME_RUNPATH:C:\WINDOWS\system32\rdpclip.exe )
32 00 00 00 | Unknown at this time...
06 00 00 00 | Count (note any value <6 will not contain a TimeStamp... meh?)
50 E9 C6 FA 01 0D CC 01 | TimeStamp: ---> 129492791440370000 ---> 5/7/2011 5:59:04 PM
The timestamp is still a 64-bit, little-endian number that can be transformed by the same methods in the question linked above.

Open in new window

Rich Rumble

ASKER

Your correct :) I'd like to use modify the script linked in the previous question to search for the registry entries HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\UserAssist\{75048700-EF1F-11D0-9888-006097DEACF9}\Count
And if exist, use the same Rot-13 routine's on the names, but alter the way the binary data is parsed to use a 16byte rather than the 72byte's seen in windows 7.
-rich

btan

Going to give it an attempt, ref the sample code linked in previous question - not good in VB though :)

a) search for the registry entries HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\UserAssist\{75048700-EF1F-11D0-9888-006097DEACF9}\Count. And if exist, use the same Rot-13 routine's on the names

strRoot = HKEY_CURRENT_USER
strPath = "Software\Microsoft\Windows\CurrentVersion\Explorer\UserAssist\{75048700-EF1F-11D0-9888-006097DEACF9}\Count"

ReadValuesRecursively strRoot, strPath

Sub ReadValuesRecursively(strRoot, strRegKeyPath)
      objRegistry.EnumKey strRoot, strRegKeyPath, arrSubkeys
      If TypeName(arrSubkeys) <> "Null" Then
            Wscript.Echo "Found the key"
            EnumValues strRoot, strRegKeyPath
      Else
            Wscript.Echo "Did NOT found the key"
      End If
End Sub

b) alter the way the binary data is parsed to use a 16byte rather than the 72byte's seen in windows 7.
> I am just tuning the EnumValues - Case REG_BINARY - portion of codes.
> Removing the script dealing with "focus" assuming it is something like Win XP
> I did not change UTC format

strTimesExecuted = 0
                              strHex = ""
                              For i = 7 To 4 Step -1
                                    strHex = strHex & Right("0" & Hex(arrValue(i)), 2)
                              Next
                              strTimesExecuted = Eval("&H" & strHex)
                              Wscript.Echo "Times Executed = " & strTimesExecuted

                              ' Extract the last time the program was ran (a 8 byte datetime) ..... little endian time stamp value
                              If UBound(arrValue) >= 15 Then
                                    strTimeStamp = ""
                                    For intBit = 8 To 15
                                          If strTimeStamp = "" Then
                                                strTimeStamp = arrValue(intBit)
                                          Else
                                                strTimeStamp = strTimeStamp & "," & arrValue(intBit)
                                          End If
                                    Next
                              End If

' Extract the last time the program was ran (a 8 byte datetime) in UTC. ..... little endian time stamp value
                              If UBound(arrValue) >= 23 Then
                                    strTimeStamp = ""
                                    For intBit = 16 To 23
                                          If strTimeStamp = "" Then
                                                strTimeStamp = arrValue(intBit)
                                          Else
                                                strTimeStamp = strTimeStamp & "," & arrValue(intBit)
                                          End If
                                    Next
                              End If

Not sure it can work as did not test it out

RobSampson

Hi, see how this goes for you. I haven't cross checked it with UserAssist.exe yet.....see what you get.

I'm not sure if the Times Executed value starts at 6 or not, in that if a program is executed once, it actually shows 6.

Regards,

Rob.

' UserAssist decryption script for Windows XP
' This script will enumerate and decrypt the registry values in the following registry key:
' HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\UserAssist
' on Windows XP

' Author: Rob Sampson and richrumble
' Experts-Exchange Member Profile for richrumble: http://www.experts-exchange.com/M_1119624.html
' Experts-Exchange Member Profile for Rob Sampson: http://www.experts-exchange.com/M_3820065.html
' Thread in which this script was created: http://www.experts-exchange.com/Programming/Languages/Visual_Basic/VB_Script/Q_27032776.html

' If blnCommandOutput is set to True, it will display detailed data in the
' CScript command prompt.  If it set to False it will output to HTML only
blnCommandOutput = True
strHTMLFile = "UserAssistInfo.html"

Set objShell = CreateObject("Wscript.Shell")
If blnCommandOutput = True Then
	If LCase(Right(Wscript.FullName, 11)) = "wscript.exe" Then
	    strPath = Wscript.ScriptFullName
	    strCommand = "%comspec% /k cscript  """ & strPath & """"
	    objShell.Run(strCommand), 1, True
	    Wscript.Quit
	End If
End If

Const HKEY_CURRENT_USER = &H80000001
Const REG_BINARY = 3

strComputer = "."
Set objRegistry = GetObject("winmgmts:\\" & strComputer & "\root\default:StdRegProv")

strRoot = HKEY_CURRENT_USER
strPath = "Software\Microsoft\Windows\CurrentVersion\Explorer\UserAssist"

strHTML = "<html>" & vbCrLf
strHTML = strHTML & "<style>" & vbCrLf
strHTML = strHTML & "th{font-family: Verdana, Arial, Helvetica, sans-serif;font-size: 10px;}" & VbCrLf
strHTML = strHTML & "td{font-family: Verdana, Arial, Helvetica, sans-serif;font-size: 10px;}" & VbCrLf
strHTML = strHTML & "</style>" & vbCrLf
strHTML = strHTML & "<body>" & VbCrLf
strHTML = strHTML & "<table>" & VbCrLf
strHTML = strHTML & "<table>" & vbCrLf
strHTML = strHTML & "<th>Name</th><th>Unknown Value</th><th>Times Executed</th><th>Last Run</th>" & vbCrLf

ReadValuesRecursively strRoot, strPath

strHTML = strHTML & "</table>" & VbCrLf
strHTML = strHTML & "</body>" & VbCrLf
strHTML = strHTML & "</html>"

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objOutput = objFSO.CreateTextFile(strHTMLFile, True)
objOutput.Write strHTML
objOutput.Close

WScript.Echo "Scan complete.  Please see " & strHTMLFile

Sub ReadValuesRecursively(strRoot, strRegKeyPath)
	EnumValues strRoot, strRegKeyPath
	objRegistry.EnumKey strRoot, strRegKeyPath, arrSubkeys
	If TypeName(arrSubkeys) <> "Null" Then
		For Each objSubkey In arrSubkeys
			ReadValuesRecursively strRoot, strRegKeyPath & "\" & objSubKey
		Next
	End If
End Sub

Sub EnumValues(strRootPath, strPath)
	If blnCommandOutput = True Then WScript.Echo "Enumerating " & strPath & "..."
	objRegistry.EnumValues strRootPath, strPath, arrValueNames, arrValueTypes
	If TypeName(arrValueNames) <> "Null" Then
		For intVal = LBound(arrValueNames) To UBound(arrValueNames)
			If blnCommandOutput = True Then WScript.Echo
		    Select Case arrValueTypes(intVal)
				Case REG_BINARY
					strHTML = strHTML & "<tr>" & VbCrLf
					objRegistry.GetBinaryValue strRootPath, strPath, arrValueNames(intVal), arrValue
					strValueName = rot13(arrValueNames(intVal))
					If blnCommandOutput = True Then WScript.Echo "Path: " & strPath & "\" & strValueName
					strHTML = strHTML & "<td>" & strValueName & "</td>"
					If blnCommandOutput = True Then WScript.Echo "Data Type: Binary"
					If blnCommandOutput = True Then WScript.Echo "Data Value (Decimal): " & Join(arrValue, ",")
					
					' Extact the unknown value
					strUnknown = 0
					strHex = ""
					For i = 3 To 0 Step -1
						strHex = strHex & Right("0" & Hex(arrValue(i)), 2)
					Next
					strUnknown = Eval("&H" & strHex)
					If blnCommandOutput = True Then Wscript.Echo "Times Executed = " & strUnknown
					strHTML = strHTML & "<td>" & strUnknown & "</td>"

					' Extact the times executed value
					strTimesExecuted = 0
					strHex = ""
					For i = 7 To 4 Step -1
						strHex = strHex & Right("0" & Hex(arrValue(i)), 2)
					Next
					strTimesExecuted = Eval("&H" & strHex)
					' Times Executed appears to start at 5, so a value of 6 means it was executed once
					'strTimesExecuted = strTimesExecuted - 5
					If blnCommandOutput = True Then Wscript.Echo "Times Executed = " & strTimesExecuted
					strHTML = strHTML & "<td>" & strTimesExecuted & "</td>"

					' Extact the little endian time stamp value
					If UBound(arrValue) >= 15 Then
						strTimeStamp = ""
						For intBit = 8 To 15
							If strTimeStamp = "" Then
								strTimeStamp = arrValue(intBit)
							Else
								strTimeStamp = strTimeStamp & "," & arrValue(intBit)
							End If
						Next
					End If
					
					If blnCommandOutput = True Then Wscript.Echo "Time Stamp Array Values: " & strTimeStamp
					If Trim(strTimeStamp) <> "" Then
						strLittleEndianTimeStamp = FormatNumber(littleEndian(Split(strTimeStamp, ",")), 0, 0, 0, 0)
						If blnCommandOutput = True Then WScript.echo "Little Endian Conversion: " & strLittleEndianTimeStamp
						Set objDateTime = CreateObject("WbemScripting.SWbemDateTime")
						On Error Resume Next
						Call objDateTime.SetFileTime(strLittleEndianTimeStamp, False)
						strConvertedTimeStamp = objDateTime.GetVarDate
						If Err.Number = 0 Then
							If blnCommandOutput = True Then Wscript.Echo "Little Endian Time Stamp = " & strConvertedTimeStamp
							strHTML = strHTML & "<td>" & strConvertedTimeStamp & "</td>"
						Else
							If blnCommandOutput = True Then WScript.Echo "Error translating time from value of " & strTimeStamp
							strHTML = strHTML & "<td>Error: " & strTimeStamp & "</td>"
						End If
					End If
			End Select
		Next
	End If
End Sub

Function rot13(rot13text)
	' Source: http://www.brettb.com/rot13_encoding_with_asp.asp
	rot13text_rotated = "" ' the function will return this String
	For i = 1 to Len(rot13text)
		j = Mid(rot13text, i, 1) ' take the next character in the String
		k = Asc(j) ' find out the character code
		if k >= 97 and k =< 109 Then
			k = k + 13 ' a ... m inclusive become n ... z
		elseif k >= 110 and k =< 122 Then
			k = k - 13 ' n ... z inclusive become a ... m
		elseif k >= 65 and k =< 77 Then
			k = k + 13 ' A ... m inclusive become n ... z
		elseif k >= 78 and k =< 90 Then
			k = k - 13 ' N ... Z inclusive become A ... M
		end if
		'add the current character to the string returned by the Function
		rot13text_rotated = rot13text_rotated & Chr(k)
	Next
	rot13 = rot13text_rotated
End Function

Function littleEndian(strValue)
	For i = LBound(strValue) to UBound(strValue) 
		oValue = oValue + (256^i)*strValue(i)
	Next
	littleEndian = oValue
End Function

Open in new window

Rich Rumble

ASKER

Seems to depend on the program, but the 3 I've tested so far they start at 6 and increment normally from there.
I'm not sure why anything less than 6 doesn't have a timestamp, but that seems to be the issue.
Can we combine the script's, but have them look at the byte length rather than what keys they are stored in? I think upgraded XP ->win7 will still use the same key as XP but in win7's format, I'm not 100% on that yet.
-rich

RobSampson

OK, I've had a go at combining them. See how this goes. It will do slightly different things depending on the array byte size.

Regards,

Rob.

' UserAssist decryption script for Windows XP and Windows 7
' This script will enumerate and decrypt the registry values in the following registry key:
' HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\UserAssist
' on Windows XP and Windows 7

' Author: Rob Sampson and richrumble
' Experts-Exchange Member Profile for richrumble: http://www.experts-exchange.com/M_1119624.html
' Experts-Exchange Member Profile for Rob Sampson: http://www.experts-exchange.com/M_3820065.html
' Threads in which this script was created:
' http://www.experts-exchange.com/Programming/Languages/Visual_Basic/VB_Script/Q_27032776.html
' http://www.experts-exchange.com/Programming/Languages/Visual_Basic/VB_Script/Q_26953880.html

' If blnCommandOutput is set to True, it will display detailed data in the
' CScript command prompt.  If it set to False it will output to HTML only
blnCommandOutput = False
strHTMLFile = "UserAssistInfo.html"

Set objShell = CreateObject("Wscript.Shell")
If blnCommandOutput = True Then
	If LCase(Right(Wscript.FullName, 11)) = "wscript.exe" Then
	    strPath = Wscript.ScriptFullName
	    strCommand = "%comspec% /k cscript  """ & strPath & """"
	    objShell.Run(strCommand), 1, True
	    Wscript.Quit
	End If
End If

Const HKEY_CURRENT_USER = &H80000001
Const REG_BINARY = 3

strComputer = "."
Set objRegistry = GetObject("winmgmts:\\" & strComputer & "\root\default:StdRegProv")

strRoot = HKEY_CURRENT_USER
strPath = "Software\Microsoft\Windows\CurrentVersion\Explorer\UserAssist"

strHTML = "<html>" & vbCrLf
strHTML = strHTML & "<style>" & vbCrLf
strHTML = strHTML & "th{font-family: Verdana, Arial, Helvetica, sans-serif;font-size: 10px;}" & VbCrLf
strHTML = strHTML & "td{font-family: Verdana, Arial, Helvetica, sans-serif;font-size: 10px;}" & VbCrLf
strHTML = strHTML & "</style>" & vbCrLf
strHTML = strHTML & "<body>" & VbCrLf
strHTML = strHTML & "<table>" & VbCrLf
strHTML = strHTML & "<table>" & vbCrLf
strHTML = strHTML & "<th>Name</th><th>Unknown (Win XP)</th><th>Times Executed</th><th>Focus Count (Win 7)</th><th>Focus Time (Win 7)</th><th>Last Run</th>" & vbCrLf

ReadValuesRecursively strRoot, strPath

strHTML = strHTML & "</table>" & VbCrLf
strHTML = strHTML & "</body>" & VbCrLf
strHTML = strHTML & "</html>"

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objOutput = objFSO.CreateTextFile(strHTMLFile, True)
objOutput.Write strHTML
objOutput.Close

WScript.Echo "Scan complete.  Please see " & strHTMLFile

Sub ReadValuesRecursively(strRoot, strRegKeyPath)
	EnumValues strRoot, strRegKeyPath
	objRegistry.EnumKey strRoot, strRegKeyPath, arrSubkeys
	If TypeName(arrSubkeys) <> "Null" Then
		For Each objSubkey In arrSubkeys
			ReadValuesRecursively strRoot, strRegKeyPath & "\" & objSubKey
		Next
	End If
End Sub

Sub EnumValues(strRootPath, strPath)
	If blnCommandOutput = True Then WScript.Echo "Enumerating " & strPath & "..."
	objRegistry.EnumValues strRootPath, strPath, arrValueNames, arrValueTypes
	If TypeName(arrValueNames) <> "Null" Then
		For intVal = LBound(arrValueNames) To UBound(arrValueNames)
			If blnCommandOutput = True Then WScript.Echo
		    Select Case arrValueTypes(intVal)
				Case REG_BINARY
					strHTML = strHTML & "<tr>" & VbCrLf
					objRegistry.GetBinaryValue strRootPath, strPath, arrValueNames(intVal), arrValue
					If UBound(arrValue) <= 15 Then
						strValueName = rot13(arrValueNames(intVal))
						If blnCommandOutput = True Then WScript.Echo "Path: " & strPath & "\" & strValueName
						strHTML = strHTML & "<td>" & strValueName & "</td>"
						If blnCommandOutput = True Then WScript.Echo "Data Type: Binary"
						If blnCommandOutput = True Then WScript.Echo "Data Value (Decimal): " & Join(arrValue, ",")
						
						' Extact the unknown value
						strUnknown = 0
						strHex = ""
						For i = 3 To 0 Step -1
							strHex = strHex & Right("0" & Hex(arrValue(i)), 2)
						Next
						strUnknown = Eval("&H" & strHex)
						If blnCommandOutput = True Then Wscript.Echo "Unknown Value (Win XP): " & strUnknown
						strHTML = strHTML & "<td>" & strUnknown & "</td>"
						
						' Extact the times executed value
						strTimesExecuted = 0
						strHex = ""
						For i = 7 To 4 Step -1
							strHex = strHex & Right("0" & Hex(arrValue(i)), 2)
						Next
						strTimesExecuted = Eval("&H" & strHex)
						' Times Executed appears to start at 5, so a value of 6 means it was executed once
						strTimesExecuted = strTimesExecuted - 5
						If blnCommandOutput = True Then Wscript.Echo "Times Executed = " & strTimesExecuted
						strHTML = strHTML & "<td>" & strTimesExecuted & "</td>"

						' Two other spacers for the Win 7 values that don't exist in this value
						strHTML = strHTML & "<td>N/A</td><td>N/A</td>"

						' Extact the little endian time stamp value
						If UBound(arrValue) >= 15 Then
							strTimeStamp = ""
							For intBit = 8 To 15
								If strTimeStamp = "" Then
									strTimeStamp = arrValue(intBit)
								Else
									strTimeStamp = strTimeStamp & "," & arrValue(intBit)
								End If
							Next
						End If
						
						If blnCommandOutput = True Then Wscript.Echo "Time Stamp Array Values: " & strTimeStamp
						If Trim(strTimeStamp) <> "" Then
							If strTimeStamp <> "0,0,0,0,0,0,0,0" Then
								strLittleEndianTimeStamp = FormatNumber(littleEndian(Split(strTimeStamp, ",")), 0, 0, 0, 0)
								If blnCommandOutput = True Then WScript.echo "Little Endian Conversion: " & strLittleEndianTimeStamp
								Set objDateTime = CreateObject("WbemScripting.SWbemDateTime")
								On Error Resume Next
								Call objDateTime.SetFileTime(strLittleEndianTimeStamp, False)
								strConvertedTimeStamp = objDateTime.GetVarDate
								If Err.Number = 0 Then
									If blnCommandOutput = True Then Wscript.Echo "Little Endian Time Stamp = " & strConvertedTimeStamp
									strHTML = strHTML & "<td>" & strConvertedTimeStamp & "</td>"
								Else
									If blnCommandOutput = True Then WScript.Echo "Error translating time from value of " & strTimeStamp
									strHTML = strHTML & "<td>Error: " & strTimeStamp & "</td>"
								End If
							Else
								If blnCommandOutput = True Then WScript.Echo "Time stamp is blank"
								strHTML = strHTML & "<td>N/A</td>"							
							End If
						End If
					Else
						strValueName = rot13(arrValueNames(intVal))
						If blnCommandOutput = True Then WScript.Echo "Path: " & strPath & "\" & strValueName
						strHTML = strHTML & "<td>" & strValueName & "</td>"
						If blnCommandOutput = True Then WScript.Echo "Data Type: Binary"
						If blnCommandOutput = True Then WScript.Echo "Data Value (Decimal): " & Join(arrValue, ",")
						
						' A spacer for the Win XP value that don't exist in this value
						strHTML = strHTML & "<td>N/A</td>"

						' Extact the times executed value
						strTimesExecuted = 0
						strHex = ""
						For i = 7 To 4 Step -1
							strHex = strHex & Right("0" & Hex(arrValue(i)), 2)
						Next
						strTimesExecuted = Eval("&H" & strHex)
						If blnCommandOutput = True Then Wscript.Echo "Times Executed = " & strTimesExecuted
						strHTML = strHTML & "<td>" & strTimesExecuted & "</td>"
	
						' Extact the focus count value
						strFocusCount = 0
						If UBound(arrValue) >= 11 Then
							strHex = ""
							For i = 11 To 8 Step -1
								strHex = strHex & Right("0" & Hex(arrValue(i)), 2)
							Next
							strFocusCount = Eval("&H" & strHex)
						End If
						If blnCommandOutput = True Then Wscript.Echo "Focus Count = " & strFocusCount
						strHTML = strHTML & "<td>" & strFocusCount & "</td>"
	
						' Extact the focus time value
						strFocusTime = 0
						If UBound(arrValue) >= 15 Then
							strHex = ""
							For i = 15 To 12 Step -1
								strHex = strHex & Right("0" & Hex(arrValue(i)), 2)
							Next
							strFocusTime = Eval("&H" & strHex)
						End If
						If blnCommandOutput = True Then Wscript.Echo "Focus Time = " & strFocusTime
						strHTML = strHTML & "<td>" & strFocusTime & "</td>"
	
						' Extact the little endian time stamp value
						If UBound(arrValue) >= 67 Then
							strTimeStamp = ""
							For intBit = 60 To 67
								If strTimeStamp = "" Then
									strTimeStamp = arrValue(intBit)
								Else
									strTimeStamp = strTimeStamp & "," & arrValue(intBit)
								End If
							Next
						End If
						
						If blnCommandOutput = True Then Wscript.Echo "Time Stamp Array Values: " & strTimeStamp
						If Trim(strTimeStamp) <> "" Then
							If strTimeStamp <> "0,0,0,0,0,0,0,0" Then
								strLittleEndianTimeStamp = FormatNumber(littleEndian(Split(strTimeStamp, ",")), 0, 0, 0, 0)
								If blnCommandOutput = True Then WScript.echo "Little Endian Conversion: " & strLittleEndianTimeStamp
								Set objDateTime = CreateObject("WbemScripting.SWbemDateTime")
								On Error Resume Next
								Call objDateTime.SetFileTime(strLittleEndianTimeStamp, False)
								strConvertedTimeStamp = objDateTime.GetVarDate
								If Err.Number = 0 Then
									If blnCommandOutput = True Then Wscript.Echo "Little Endian Time Stamp = " & strConvertedTimeStamp
									strHTML = strHTML & "<td>" & strConvertedTimeStamp & "</td>"
								Else
									If blnCommandOutput = True Then WScript.Echo "Error translating time from value of " & strTimeStamp
									strHTML = strHTML & "<td>Error: " & strTimeStamp & "</td>"
								End If
							Else
								If blnCommandOutput = True Then WScript.Echo "Time stamp is blank"
								strHTML = strHTML & "<td>N/A</td>"							
							End If
						End If
					End If
			End Select
		Next
	End If
End Sub

Function rot13(rot13text)
	' Source: http://www.brettb.com/rot13_encoding_with_asp.asp
	rot13text_rotated = "" ' the function will return this String
	For i = 1 to Len(rot13text)
		j = Mid(rot13text, i, 1) ' take the next character in the String
		k = Asc(j) ' find out the character code
		if k >= 97 and k =< 109 Then
			k = k + 13 ' a ... m inclusive become n ... z
		elseif k >= 110 and k =< 122 Then
			k = k - 13 ' n ... z inclusive become a ... m
		elseif k >= 65 and k =< 77 Then
			k = k + 13 ' A ... m inclusive become n ... z
		elseif k >= 78 and k =< 90 Then
			k = k - 13 ' N ... Z inclusive become A ... M
		end if
		'add the current character to the string returned by the Function
		rot13text_rotated = rot13text_rotated & Chr(k)
	Next
	rot13 = rot13text_rotated
End Function

Function littleEndian(strValue)
	For i = LBound(strValue) to UBound(strValue) 
		oValue = oValue + (256^i)*strValue(i)
	Next
	littleEndian = oValue
End Function

Open in new window

Rich Rumble

ASKER

Superior work again, many thanks! I want to turn this loose on the network, and since I"ll be using only one user to do it from a central location, we may have to scan the HKU registry keys and iterate through the user SID's looking for data that would be found there:

HKEY_USERS\USER_SID_HERE\Software\Microsoft\Windows\CurrentVersion\Explorer\UserAssist\{5E6AB780-7743-11CF-A12B-00AA004AE837}\Count

Is that an easy change, the path is nearly identical, but requires trying all the SID's in the hkey_users rather than hkey_currentuser... From my manual testing, running the script as the local admin account, I can get the userassist results from all users who log on the machine if I manually put their sid in the path. Again, this is very nice, it's going to help us understand much better where focus and time is spent across the enterprise.
-rich

RobSampson

Ok, I've done quite a rework on this now, and it will read from a text file of computers, or one computer (depending on the value you put for strSourceComputer) and report to a separate HTML file per computer.

I was thinking though....could the code above be run on a login script anyway, and produce the output for each user that logged on? Or can normal users not enumerate the keys properly?

Regards,

Rob.

' UserAssist decryption script for Windows XP and Windows 7
' This script will enumerate and decrypt the registry values in the following registry key:
' HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\UserAssist
' on Windows XP and Windows 7

' Author: Rob Sampson and richrumble
' Experts-Exchange Member Profile for richrumble: http://www.experts-exchange.com/M_1119624.html
' Experts-Exchange Member Profile for Rob Sampson: http://www.experts-exchange.com/M_3820065.html
' Threads in which this script was created:
' http://www.experts-exchange.com/Programming/Languages/Visual_Basic/VB_Script/Q_27032776.html
' http://www.experts-exchange.com/Programming/Languages/Visual_Basic/VB_Script/Q_26953880.html

' If blnCommandOutput is set to True, it will display detailed data in the
' CScript command prompt.  If it set to False it will output to HTML only
blnCommandOutput = False
' For the output file name, <COMPUTERNAME> will be automatically replaced with the computer
' that is being queried
strHTMLFile = "<COMPUTERNAME>UserAssistInfo.html"
' strSourceComputer can be set to a single computer name, or a text file only, with one computer
' name per line
strSourceComputer = "computers.txt"

Set objShell = CreateObject("Wscript.Shell")
If blnCommandOutput = True Then
	If LCase(Right(Wscript.FullName, 11)) = "wscript.exe" Then
	    strPath = Wscript.ScriptFullName
	    strCommand = "%comspec% /k cscript  """ & strPath & """"
	    objShell.Run(strCommand), 1, True
	    Wscript.Quit
	End If
End If
Set objNetwork = CreateObject("WScript.Network")

Const HKEY_CURRENT_USER = &H80000001
Const HKEY_USERS = &H80000003
Const REG_BINARY = 3
Dim objRegistry
Dim strHTML
Dim strRenamedHTMLFile

If Right(LCase(strSourceComputer), 4) <> ".txt" Then
	EnumComputer strSourceComputer
Else
	Set objFSO = CreateObject("Scripting.FileSystemObject")
	Set objInput = objFSO.OpenTextFile(strSourceComputer, 1, False)
	While Not objInput.AtEndOfStream
		strComputer = objInput.ReadLine
		If Trim(strComputer) <> "" Then
			If Ping(strComputer) = True Then
				EnumComputer strComputer
			End If
		End If
	Wend
	objInput.Close
End If

MsgBox "Scan complete."

Sub EnumComputer(strComputer)
	If strComputer = "." Then strComputer = objNetwork.ComputerName
	strRenamedHTMLFile = Replace(strHTMLFile, "<COMPUTERNAME>", strComputer)
	On Error Resume Next
	Set objRegistry = GetObject("winmgmts:\\" & strComputer & "\root\default:StdRegProv")
	If Err.Number = 0 Then
		On Error GoTo 0
		strPath = "Software\Microsoft\Windows\CurrentVersion\Explorer\UserAssist"
		
		strHTML = "<html>" & vbCrLf
		strHTML = strHTML & "<style>" & vbCrLf
		strHTML = strHTML & "th{font-family: Verdana, Arial, Helvetica, sans-serif;font-size: 10px;}" & VbCrLf
		strHTML = strHTML & "td{font-family: Verdana, Arial, Helvetica, sans-serif;font-size: 10px;}" & VbCrLf
		strHTML = strHTML & "</style>" & vbCrLf
		strHTML = strHTML & "<body>" & VbCrLf
		strHTML = strHTML & "<table>" & VbCrLf
		
		objRegistry.EnumKey HKEY_USERS, "", arrSIDkeys
		If TypeName(arrSIDkeys) <> "Null" Then
			For Each objSIDKey In arrSIDkeys
				If Len(objSIDKey) > 8 And InStr(objSIDKey, "Classes") = 0 Then
					strUserName = GetUsernameOfSID(objSIDKey)
					strHTML = strHTML & "<tr><td><b>Computer: </b>" & strComputer & "</td><td colspan=5><b>Username: </b>" & strUsername & "</td></tr>" & vbCrLf
					strHTML = strHTML & "<th>Name</th><th>Unknown (Win XP)</th><th>Times Executed</th><th>Focus Count (Win 7)</th><th>Focus Time (Win 7)</th><th>Last Run</th>" & vbCrLf
					' Enumerate through the UserAssist key for this SID
					ReadValuesRecursively HKEY_USERS, objSIDKey & "\" & strPath
					strHTML = strHTML & "<tr><td colspan=6>&nbsp;</td></tr>" & VbCrLf
				End If
			Next
		End If
		
		strHTML = strHTML & "</table>" & VbCrLf
		strHTML = strHTML & "</body>" & VbCrLf
		strHTML = strHTML & "</html>"
		
		Set objFSO = CreateObject("Scripting.FileSystemObject")
		Set objOutput = objFSO.CreateTextFile(strRenamedHTMLFile, True)
		objOutput.Write strHTML
		objOutput.Close
		If blnCommandOutput = True Then WScript.Echo "Scan complete.  Please see " & strRenamedHTMLFile
	Else
		If blnCommandOutput = True Then WScript.Echo "Error connecting to " & strComputer & ". Error " & Err.Number & ": " & Err.Description
		Err.Clear
		On Error GoTo 0
	End If
End Sub

Sub ReadValuesRecursively(strRoot, strRegKeyPath)
	EnumValues strRoot, strRegKeyPath
	objRegistry.EnumKey strRoot, strRegKeyPath, arrSubkeys
	If TypeName(arrSubkeys) <> "Null" Then
		For Each objSubkey In arrSubkeys
			ReadValuesRecursively strRoot, strRegKeyPath & "\" & objSubKey
		Next
	End If
End Sub

Sub EnumValues(strRootPath, strPath)
	If blnCommandOutput = True Then WScript.Echo "Enumerating " & strRootPath & "\" & strPath & "..."
	objRegistry.EnumValues strRootPath, strPath, arrValueNames, arrValueTypes
	If TypeName(arrValueNames) <> "Null" Then
		For intVal = LBound(arrValueNames) To UBound(arrValueNames)
			If blnCommandOutput = True Then WScript.Echo
		    Select Case arrValueTypes(intVal)
				Case REG_BINARY
					strHTML = strHTML & "<tr>" & VbCrLf
					objRegistry.GetBinaryValue strRootPath, strPath, arrValueNames(intVal), arrValue
					If UBound(arrValue) <= 15 Then
						strValueName = rot13(arrValueNames(intVal))
						If blnCommandOutput = True Then WScript.Echo "Path: " & strPath & "\" & strValueName
						strHTML = strHTML & "<td>" & strValueName & "</td>"
						If blnCommandOutput = True Then WScript.Echo "Data Type: Binary"
						If blnCommandOutput = True Then WScript.Echo "Data Value (Decimal): " & Join(arrValue, ",")
						
						' Extact the unknown value
						strUnknown = 0
						strHex = ""
						For i = 3 To 0 Step -1
							strHex = strHex & Right("0" & Hex(arrValue(i)), 2)
						Next
						strUnknown = Eval("&H" & strHex)
						If blnCommandOutput = True Then Wscript.Echo "Unknown Value (Win XP): " & strUnknown
						strHTML = strHTML & "<td>" & strUnknown & "</td>"
						
						' Extact the times executed value
						strTimesExecuted = 0
						strHex = ""
						For i = 7 To 4 Step -1
							strHex = strHex & Right("0" & Hex(arrValue(i)), 2)
						Next
						strTimesExecuted = Eval("&H" & strHex)
						' Times Executed appears to start at 5, so a value of 6 means it was executed once
						strTimesExecuted = strTimesExecuted - 5
						If blnCommandOutput = True Then Wscript.Echo "Times Executed = " & strTimesExecuted
						strHTML = strHTML & "<td>" & strTimesExecuted & "</td>"

						' Two other spacers for the Win 7 values that don't exist in this value
						strHTML = strHTML & "<td>N/A</td><td>N/A</td>"

						' Extact the little endian time stamp value
						If UBound(arrValue) >= 15 Then
							strTimeStamp = ""
							For intBit = 8 To 15
								If strTimeStamp = "" Then
									strTimeStamp = arrValue(intBit)
								Else
									strTimeStamp = strTimeStamp & "," & arrValue(intBit)
								End If
							Next
						End If
						
						If blnCommandOutput = True Then Wscript.Echo "Time Stamp Array Values: " & strTimeStamp
						If Trim(strTimeStamp) <> "" Then
							If strTimeStamp <> "0,0,0,0,0,0,0,0" Then
								strLittleEndianTimeStamp = FormatNumber(littleEndian(Split(strTimeStamp, ",")), 0, 0, 0, 0)
								If blnCommandOutput = True Then WScript.echo "Little Endian Conversion: " & strLittleEndianTimeStamp
								Set objDateTime = CreateObject("WbemScripting.SWbemDateTime")
								On Error Resume Next
								Call objDateTime.SetFileTime(strLittleEndianTimeStamp, False)
								strConvertedTimeStamp = objDateTime.GetVarDate
								If Err.Number = 0 Then
									If blnCommandOutput = True Then Wscript.Echo "Little Endian Time Stamp = " & strConvertedTimeStamp
									strHTML = strHTML & "<td>" & strConvertedTimeStamp & "</td>"
								Else
									If blnCommandOutput = True Then WScript.Echo "Error translating time from value of " & strTimeStamp
									strHTML = strHTML & "<td>Error: " & strTimeStamp & "</td>"
								End If
							Else
								If blnCommandOutput = True Then WScript.Echo "Time stamp is blank"
								strHTML = strHTML & "<td>N/A</td>"							
							End If
						End If
					Else
						strValueName = rot13(arrValueNames(intVal))
						If blnCommandOutput = True Then WScript.Echo "Path: " & strPath & "\" & strValueName
						strHTML = strHTML & "<td>" & strValueName & "</td>"
						If blnCommandOutput = True Then WScript.Echo "Data Type: Binary"
						If blnCommandOutput = True Then WScript.Echo "Data Value (Decimal): " & Join(arrValue, ",")
						
						' A spacer for the Win XP value that don't exist in this value
						strHTML = strHTML & "<td>N/A</td>"

						' Extact the times executed value
						strTimesExecuted = 0
						strHex = ""
						For i = 7 To 4 Step -1
							strHex = strHex & Right("0" & Hex(arrValue(i)), 2)
						Next
						strTimesExecuted = Eval("&H" & strHex)
						If blnCommandOutput = True Then Wscript.Echo "Times Executed = " & strTimesExecuted
						strHTML = strHTML & "<td>" & strTimesExecuted & "</td>"
	
						' Extact the focus count value
						strFocusCount = 0
						If UBound(arrValue) >= 11 Then
							strHex = ""
							For i = 11 To 8 Step -1
								strHex = strHex & Right("0" & Hex(arrValue(i)), 2)
							Next
							strFocusCount = Eval("&H" & strHex)
						End If
						If blnCommandOutput = True Then Wscript.Echo "Focus Count = " & strFocusCount
						strHTML = strHTML & "<td>" & strFocusCount & "</td>"
	
						' Extact the focus time value
						strFocusTime = 0
						If UBound(arrValue) >= 15 Then
							strHex = ""
							For i = 15 To 12 Step -1
								strHex = strHex & Right("0" & Hex(arrValue(i)), 2)
							Next
							strFocusTime = Eval("&H" & strHex)
						End If
						If blnCommandOutput = True Then Wscript.Echo "Focus Time = " & strFocusTime
						strHTML = strHTML & "<td>" & strFocusTime & "</td>"
	
						' Extact the little endian time stamp value
						If UBound(arrValue) >= 67 Then
							strTimeStamp = ""
							For intBit = 60 To 67
								If strTimeStamp = "" Then
									strTimeStamp = arrValue(intBit)
								Else
									strTimeStamp = strTimeStamp & "," & arrValue(intBit)
								End If
							Next
						End If
						
						If blnCommandOutput = True Then Wscript.Echo "Time Stamp Array Values: " & strTimeStamp
						If Trim(strTimeStamp) <> "" Then
							If strTimeStamp <> "0,0,0,0,0,0,0,0" Then
								strLittleEndianTimeStamp = FormatNumber(littleEndian(Split(strTimeStamp, ",")), 0, 0, 0, 0)
								If blnCommandOutput = True Then WScript.echo "Little Endian Conversion: " & strLittleEndianTimeStamp
								Set objDateTime = CreateObject("WbemScripting.SWbemDateTime")
								On Error Resume Next
								Call objDateTime.SetFileTime(strLittleEndianTimeStamp, False)
								strConvertedTimeStamp = objDateTime.GetVarDate
								If Err.Number = 0 Then
									If blnCommandOutput = True Then Wscript.Echo "Little Endian Time Stamp = " & strConvertedTimeStamp
									strHTML = strHTML & "<td>" & strConvertedTimeStamp & "</td>"
								Else
									If blnCommandOutput = True Then WScript.Echo "Error translating time from value of " & strTimeStamp
									strHTML = strHTML & "<td>Error: " & strTimeStamp & "</td>"
								End If
							Else
								If blnCommandOutput = True Then WScript.Echo "Time stamp is blank"
								strHTML = strHTML & "<td>N/A</td>"							
							End If
						End If
					End If
			End Select
		Next
	End If
End Sub

Function rot13(rot13text)
	' Source: http://www.brettb.com/rot13_encoding_with_asp.asp
	rot13text_rotated = "" ' the function will return this String
	For i = 1 to Len(rot13text)
		j = Mid(rot13text, i, 1) ' take the next character in the String
		k = Asc(j) ' find out the character code
		if k >= 97 and k =< 109 Then
			k = k + 13 ' a ... m inclusive become n ... z
		elseif k >= 110 and k =< 122 Then
			k = k - 13 ' n ... z inclusive become a ... m
		elseif k >= 65 and k =< 77 Then
			k = k + 13 ' A ... m inclusive become n ... z
		elseif k >= 78 and k =< 90 Then
			k = k - 13 ' N ... Z inclusive become A ... M
		end if
		'add the current character to the string returned by the Function
		rot13text_rotated = rot13text_rotated & Chr(k)
	Next
	rot13 = rot13text_rotated
End Function

Function littleEndian(strValue)
	For i = LBound(strValue) to UBound(strValue) 
		oValue = oValue + (256^i)*strValue(i)
	Next
	littleEndian = oValue
End Function

Function GetUsernameOfSID(strSID)
	Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
	Set objAccount = objWMIService.Get("Win32_SID.SID='" & strSID & "'")
	If objAccount.AccountName = "" Then
		GetUsernameOfSID = ""
	Else
		GetUsernameOfSID = objAccount.ReferencedDomainName & "\" & objAccount.AccountName
	End If
End Function

Function Ping(strComputer)
	Dim objShell, boolCode
	Set objShell = CreateObject("WScript.Shell")
	boolCode = objShell.Run("Ping -n 1 -w 300 " & strComputer, 0, True)
	If boolCode = 0 Then
		Ping = True
	Else
		Ping = False
	End If
End Function

Open in new window

Rich Rumble

ASKER

They can enumerate their own keys (typically), however our logon scripts are very extensive already and we are trying to avoid them. My Windows7 doesn't return anything for win32_sid (run from scriptomatic).
(304, 2) SWbemServicesEx: The security ID structure is invalid.

I figured you'd read and parse hku/(string_that_is_ONLY_45_chars_long ) -> and put each one into the path. But it's really your call, I'm in over my head :)
-rich

RobSampson

For the Win32_SID, I was just retrieving the "freindly" domain name of the account....if that doesn't work for you, I'll either find something else, or just leave it as the SID.....back in a couple of hours.

Rob.

ASKER CERTIFIED SOLUTION

RobSampson

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

Rich Rumble

ASKER

I think this is very nice, ty very much Rob!
-rich

RobSampson

No problem. It was a fun little project....something I haven't done before, and it's turned up some interesting results ;-)

Rob.

Rich Rumble

ASKER

Not sure if you have any interest in php, but...
https://www.experts-exchange.com/questions/27043700/Windows-PHP-Com-and-com-event-sink.html

It was a fun project to do in VBS, I knew it could be done once we figured out the nuances of the binary format.
-rich

RobSampson

Hey Rich,

Sorry, I'm not familiar enough with those techniques in PHP to be able to help you with that one.

Rob.