'========================================================================================================
'========================================================================================================
' ### Script: forensics.vbs
' ### ScriptVersion: 42
' ### Created: 09/14/05
' ### Contact: Tim Chovanak - tim-at-blackpondfarm.com
' ### Description: Runs through some quick basic checks of a WinXP, Win2k, or newer system to outline info
' ###              that might be of value when investigating an incident, such as those involving 
' ###              inappropriate use of computing resources, child pornography, computer fraud, etc. 
' ###              Can be used locally or against a remote machine. Requires Admin perms.
'========================================================================================================
'========================================================================================================
Option Explicit
On Error Resume Next

'Set our variables
Dim WshShell,Wshnetwork,Wshfile
Dim strServer,systemdrive,ServerRoot
Dim stroutputFile
Dim objReg
Dim INST,OSObject

'Set constants for the WMI Registry Provider
Const HKCR=&H80000000 'HKEY_CLASSES_ROOT
Const HKCU=&H80000001 'HKEY_CURRENT_USER
Const HKLM=&H80000002 'HKEY_LOCAL_MACHINE
Const HKU=&H80000003 'HKEY_USERS
Const HKCC=&H80000005 'HKEY_CURRENT_CONFIG


'Set up our environment
Set WshShell = WScript.CreateObject("WScript.Shell")
Set Wshnetwork = wscript.CreateObject("Wscript.Network")
Set Wshfile = wscript.CreateObject("Scripting.FileSystemObject")


'Check to ensure we're using cscript
If InStr(1, wscript.fullname, "cscript.exe", 1) = 0 Then VerifyCscript

'Show splash screen
Call SCRIPTHELP()

'Parse the command line
GetArgs()


'Use WMI to connect and get the root system drive
Set OSObject = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strServer).InstancesOf("Win32_OperatingSystem") 
	IF Err.Number <> 0 THEN
		wscript.echo "Unable to connect to " & strServer & ". Ensure the computer" 
		wscript.echo "is online and that you have Admin permissions."
		wscript.quit
	END IF

	'Get the system drive in the event the OS is on something other than c:\
	For Each INST in OSObject
		ServerRoot = "\\" & strServer & "\" & LEFT(INST.SystemDirectory,1) & "$\"
		SystemDrive = LEFT(INST.SystemDirectory,1)
	next

'Connect to the registry using wmi, see:
'http://msdn.microsoft.com/library/default.asp?url=/library/en-us/wmisdk/wmi/setbinaryvalue_method_in_class_stdregprov.asp
Set objReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strServer & "\root\default:StdRegProv")


'Set our output file
strOutputFile = strServer & ".log"
If (Wshfile.fileexists(strOutputFile)) Then Wshfile.deletefile(strOutputFile)


'Run through all the subs and functions to get our data
FullMealDeal()


'end of script
'========================================================================================================
'========================================================================================================
Sub FullMealDeal()
On error resume next
Dim INST
dim OS,w3wpfile


'Display and log the start time
Screenout "Starting at " & Time & " " & Date & " on server " & strServer
screenout ""


'Display and log the OS Version
screenout "Operating System configuration"
Get_OS
screenout ""


'Dump the local administrators
Screenout "Local Administrators"
Group_Query()
Screenout ""

'Dump local user accounts, show whether the accounts are active
Screenout "Local User Accounts"
User_Query()
Screenout ""

'Dump user profiles on the system
Screenout "User Profiles"
Profile_Query()
Screenout ""

'Dump disk configurations
Screenout "Disk configurations"
get_disks
Screenout ""


'Log finish time, close our input file
finish_up


End Sub
'========================================================================================================
'========================================================================================================
Sub Get_OS()
On error resume next
Dim INST,objZone
Dim strKeyPath

'Get our OS version, SP level, owner, system directory
For Each INST in OSObject
	Screenout "  " & INST.Caption & " " & INST.CSDVersion
	Screenout "  Registered Owner: " & INST.RegisteredUser
	Screenout "  Registered Organization: " & INST.Organization
	Screenout "  Original Install Date: " & FormatTime(inst.InstallDate)
	Screenout "  System Directory: " & INST.SystemDirectory
	Screenout "  Last Reboot: " & FormatTime(inst.LastBootUpTime)
	Screenout "  Time Zone Bias: " & INST.CurrentTimeZone/60 & " hours"
next

'We will need this later if we need to verify any timed events/stamps on the box
Set ObjZone = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strServer).InstancesOf("Win32_TimeZone") 
for each inst in ObjZone
	Screenout "  Time Zone: " & inst.StandardName
next

GET_Shutdown()


END sub
'========================================================================================================
'========================================================================================================
Sub Get_Shutdown()
On error resume next
Dim strKeyPath,INST,Temp,strhexkeyvalue,i

'Get last SHUTDOWN time
'Not yet implemented -- need to be able to parse the time out of the hex values
exit sub
	strKeyPath = "SYSTEM\CurrentControlSet\Control\Windows"
		objReg.GetBinaryValue HKLM, strKeyPath, "ShutdownTime", Temp

			For i = 0 To UBound(Temp)
wscript.echo "raw: " & Temp(i)
wscript.echo "asc: " & asc(Temp(i))
wscript.echo "chr: " & chr(Temp(i))
wscript.echo "hex: " & hex(Temp(i))

				strhexkeyvalue = strhexkeyvalue & hex(temp(i))
			next

Screenout "  Last Shutdown: " & strhexkeyvalue
Screenout "  Last Shutdown2: " & formatdatetime(strhexkeyvalue,2)

END Sub
'========================================================================================================
'========================================================================================================
Sub Group_Query()
On error resume next
Dim objGroup,User,UserName

'Use ADSI to dump the local Administrators
set objGroup = GetObject("WinNT://" & strServer & "/Administrators,group")
	For each User in objGroup.Members
		UserName = Replace(User.ADsPath,"WinNT://","")
		UserName = Replace(UserName,"/","\")
		Screenout "  " & UserName
	Next


END Sub
'========================================================================================================
'========================================================================================================
Sub User_Query()
On error resume next
Dim objUsers,USER,Profile,KeyPath,strKeyPath,INST,arrSubKeys,temp

'Use WMI to dump local user accounts, along with profile info and any typed URLs
'First print out a legend:
Screenout "  User Name" & CHR(9) & "Profile Path"

	Set objUsers = GetObject("winmgmts:{impersonationLevel=impersonate}!//" & strServer & "/root/cimv2").ExecQuery("Select * from Win32_UserAccount WHERE Domain = '" & strServer & "'")
	For Each USER In objUsers
		Profile = ""
		KeyPath = "SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProfileList\" & user.SID
		objReg.GetExpandedStringValue HKLM, KeyPath, "ProfileImagePath", Profile
		IF LEN(Profile) > 3 THEN	
			Profile = Replace(Profile,systemdrive & ":\",ServerRoot)
			Screenout "  " & User.Name & CHR(9) & Profile

			strKeyPath = User.SID & "\SOFTWARE\Microsoft\Internet Explorer\TypedURLs"
			objReg.EnumValues HKU, strKeyPath, arrSubKeys
			IF Not IsNull(arrSubKeys) THEN
				Screenout "  Typed URLs:"
				For Each INST In arrSubKeys
					objReg.GetStringValue HKU, strKeyPath, INST, Temp
					screenout "    " & Temp
				Next
				Screenout ""
			END IF

			strKeyPath = User.SID & "\SOFTWARE\Microsoft\MediaPlayer\Player\RecentFileList"
			objReg.EnumValues HKU, strKeyPath, arrSubKeys
			IF Not IsNull(arrSubKeys) THEN
				Screenout "  Recent MediaPlayer Files:"
				For Each INST In arrSubKeys
					objReg.GetStringValue HKU, strKeyPath, INST, Temp
					screenout "    " & Temp
				Next
			END IF

			Dim newKeyPath,arrSubKey,INSTANCE
			strKeyPath = User.SID & "\SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\ComDlg32\OpenSaveMRU"
			objReg.EnumKey HKU, strKeyPath, arrSubKeys
			IF Not IsNull(arrSubKeys) THEN
				Screenout "  Recent files:"
				For Each INST In arrSubKeys
					newKeyPath = User.SID & "\SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\ComDlg32\OpenSaveMRU" & "\" & INST
					objReg.EnumValues HKU, newKeyPath, arrSubKey
					IF Not IsNull(arrSubKey) THEN
						For Each INSTANCE In arrSubKey
							objReg.GetStringValue HKU, newKeyPath, INSTANCE, Temp
							IF INSTR(Temp,":") > 0 THEN screenout "    " & Temp
						Next
					END IF
				Next
			END IF

	ELSE
		Screenout "  " & User.Name & CHR(9) & "(Inactive)"
	END IF	
   Next


END SUB
'========================================================================================================
'========================================================================================================
Sub Profile_Query()
On error resume next
Dim strKeyPath,arrSubKeys,subkey,KeyPath,SID,objFile,strDate,Profile,Temp
Dim Index
Dim INST,objFolder
Dim Position,strUser

'Dump all locally-stored profiles for local and domain accounts
'Then dump the Internet Explorer history
strKeyPath = "SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProfileList"
objReg.EnumKey HKLM, strKeyPath, arrSubKeys
For Each SID In arrSubKeys
	Profile = ""
	KeyPath = strKeyPath & "\" & SID
	objReg.GetExpandedStringValue HKLM, KeyPath, "ProfileImagePath", Profile
		Profile = Replace(Profile,systemdrive & ":\",ServerRoot)
		Set objFile = wshFile.GetFile(Profile & "\ntuser.dat")
		strDate = objFile.DateLastModified
		Screenout "  SID: " & SID
		Screenout "  Profile Path: " & Profile
		Screenout "  Profile Date: " & strDate

		'Determine the user name from the profile, helps filter index.dat file
		'Note: This is inaccurate -- if the user is renamed the profile might not reflect it
		'so later on in the script we'll catch other lines
		Position = InStrRev(Profile, "\")
		struser = lcase(mid(Profile,Position+1))

		'Get the main index.dat file under \History.IE5
		Index = Profile & "\Local Settings\History\History.IE5\"
		Get_History Index,struser

		'Get index files under the main \History.IE5\ directory
		Set objFolder = wshFile.GetFolder(Profile & "\Local Settings\History\History.IE5\")
		For Each INST In objFolder.SubFolders
			IF LEN(INST) > 5 THEN
				Index = INST & "\"
				GET_History Index,struser
			END IF
		Next
		Index = ""
		Profile = ""

		screenout ""	

Next


END SUB
'========================================================================================================
'========================================================================================================
Function Get_History(index,struser)
On error resume next
Dim wshTempFile,Length,strIndex,n,strAscii,temp
Dim Line,Position

'Get Internet Explorer history for each profile
index = index & "index.dat"

IF Wshfile.FileExists(index) THEN
	Set wshtempFile = Wshfile.GetFile(Index)
	Length = WshTempFile.Size
	Screenout "  Index file: " & Index
ELSE
	'no index file, exit
	Screenout "  Index file " & index & " doesn't exist"
	Screenout ""
	Exit function
END IF


Set wshtempfile = wshfile.OpenTextFile(Index, 1)
	strIndex = wshtempFile.Read(Length)
	wshtempfile.close

	For n = 1 to Length
		strAscii = Asc(Mid(strIndex, n, 1))
'IF strAscii > 3 THEN screenout strAscii
		IF strAscii = 16 THEN
			temp = temp & " "
		ELSEIF strAscii = 11 THEN
			temp = temp & chr(13) & chr(10)
		ELSEIF strAscii > 31 and strAscii < 128 THEN
'screenout chr(strAscii)
			temp = temp & chr(strAscii)
		END IF
	Next

	'The "URL " text shows up shortly after the URL string, so insert CRLF to mark the end of our line
	strIndex = Replace(Temp,"URL ",chr(13) & chr(10) & "URL ")

	'Insert CRLF just before Visited to help mark the start of our line
	strIndex = Replace(strIndex,"Visited:",chr(13) & chr(10) & "Visited:")


'Now, dump to a temp file for a little more parsing 
Temp = "temp-" & strServer & ".txt"
If (Wshfile.fileexists(temp)) Then Wshfile.deletefile(temp)
Set wshTempFile = Wshfile.createtextfile(Temp, 1)
	wshTempfile.write(strIndex)
	wshTempfile.Close
	wscript.DisconnectObject wshTempfile
	Set wshTempfile = Nothing
	If Err.number <> 0 Then Err.Clear

'Open the text file, then...
'This is ugly, but it works. Basically, the data in the index.dat file before the URL contains the date.
'We haven't yet decoded the date, so we don't have any characters we can use to delineate the beginning of
'a URL. So, we first try the username as identified by the profile name, but since the user and profile might
'not match we also look for other strings with both an @ and a : within the string. In both cases, we then 
'parse the string slightly to get a consistent start point.
Set wshtempfile = wshfile.OpenTextFile(temp, 1)
	Do While wshtempfile.AtEndOfStream <> true
		line = wshtempFile.ReadLine
		Position = INSTR(lcase(Line),struser)
		IF Position > 0 THEN
			'We have a username match, just print the line starting at the username
			Screenout "    " & mid(Line,Position)
		ELSE
			'Print other lines containing @ and :, starting at the last space chr before the @ symbol
			IF INSTR(Line,"@") > 1 AND INSTR(Line,":") > 1 THEN
				Position = INSTR(Line,"@")
				Position = InStrRev(Line," ",Position)
				Line = mid(line,position)
				IF INSTR(Line,"HASH") < 1 THEN screenout "    ?:" & Line
			END IF
		END IF
	Loop
	wshTempfile.Close
	Wshfile.deletefile(temp)


Err.Clear

END FUNCTION
'========================================================================================================
'========================================================================================================
Function Get_Disks
dim objDisk,INST,LogicalDrive,strKeyPath,arrSubKeys,Temp,i,strHexKeyValue
On error resume next

'Dump current hard disks, plus binary data from other attached drives

Set objDISK = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strServer).ExecQuery("SELECT * FROM Win32_LogicalDisk WHERE Description = 'Local Fixed Disk'")
For Each INST in ObjDISK
	LogicalDrive = LogicalDrive & " " & INST.DeviceID
next

	screenout "  Logical drive(s): " & LogicalDrive
	Screenout ""



	strKeyPath = "SYSTEM\MountedDevices"
	objReg.EnumValues HKLM, strKeyPath, arrSubKeys
	For Each INST In arrSubKeys
		Screenout "  " & INST
		objReg.GetBinaryValue HKLM, strKeyPath, INST, Temp
			For i = 0 To UBound(Temp)
				IF ISNumberic(Temp(i)) OR not IsNULL(Temp(i)) THEN
					IF temp(i) <> 00 THEN strhexkeyvalue = strhexkeyvalue & chr(temp(i))
				ELSE
					'do nothing
				END IF
			next

			IF LEN(strhexkeyvalue) > 5 THEN 
				'Search for USB devices
				temp = strhexkeyvalue
				IF INSTR(Temp,"#") > 1 THEN
					'Look for Temp in USBSTOR
					GET_USB(Temp)
				END IF

				'Print the binary data
				Screenout "    " & strhexkeyvalue

			END IF
			strhexkeyvalue = ""
			temp = ""
			Screenout ""
	Next



END FUNCTION
'========================================================================================================
'========================================================================================================
SUB GET_USB(temp)
On error resume next
Dim Position1,Position2,Position3
Dim INST,KEY
Dim strKeyPath,newKeyPath
Dim arrSubKeys,arrSubKey2
Dim strValue,strParent


'Match any of the mounted disks with USB devices

	Position1 = instr(temp,"#")
	Position2 = instr(Position1+1,temp,"#")
	Position3 = instr(Position2+1,temp,"#")-4
	temp = mid(temp,position2+1,Position3-Position2)

	strKeyPath = "SYSTEM\CurrentControlSet\Enum\USBSTOR"

	objReg.EnumKey HKLM, strKeyPath, arrSubKeys
	For Each INST In arrSubKeys
		newKeyPath = strKeyPath & "\" & INST
		objReg.EnumKey HKLM, newKeyPath, arrSubKey2
		For Each KEY In arrSubKey2
			newKeyPath = newKeyPath & "\" & Key
			objReg.GetStringValue HKLM, newKeyPath, "FriendlyName", strValue
			objReg.GetStringValue HKLM, newKeyPath, "ParentIdPrefix", strParent
			IF temp = strParent THEN
				Screenout "    REMOVABLE USB DEVICE: " & strValue
			END IF
		next

	next




END SUB
'========================================================================================================
'========================================================================================================
Sub finish_up
On error resume next
Dim Temp

'Log completion time
Screenout "Ending at " & Time & " " & Date
Screenout ""

'Open the output file in notepad
'Temp = WshShell.Run("notepad.exe " & strOutputFile,1,true)

'Quit
wscript.quit


END SUB
'========================================================================================================
'========================================================================================================
Function screenout(text)
Dim wsherrorlogfile
On Error Resume Next
    
If (Wshfile.fileexists(strOutputFile)) Then
'If our output file exists, open it, write our data, and close
        Set wsherrorlogfile = Wshfile.OpenTextFile(strOutputFile, 8)
	wsherrorlogfile.writeline (text)
	wscript.echo(text)
	wsherrorlogfile.Close
	wscript.DisconnectObject wsherrorlogfile
	Set wsherrorlogfile = Nothing
	If Err.number <> 0 Then Err.Clear

Else
'File doesn't yet exist, create our output file and write our first line of text
	Set wsherrorlogfile = Wshfile.createtextfile(strOutputFile, 1)
	wsherrorlogfile.writeline (text)
	wscript.echo(text)
	wsherrorlogfile.Close
	wscript.DisconnectObject wsherrorlogfile
	Set wsherrorlogfile = Nothing
	If Err.number <> 0 Then Err.Clear
End If

End Function
'========================================================================================================
'========================================================================================================
Function GetArgs()
On Error Resume Next
Dim a,argtext,strArgs

For a = 0 To wscript.arguments.count - 1
	argtext = argtext & wscript.arguments(a) & " "
	strArgs = wscript.arguments(a)
next

	If strArgs <> "" Then
		strServer=strArgs
		if left(strserver,2)= "\\" THEN
			strserver=mid(strserver,3)
		End if

	Else
		strServer = wshNetwork.ComputerName
	End If

	If ParseArgument("-?") Then
		Call SCRIPTHELP()
		Exit Function
	End If

	If ParseArgument("/?") Then
		Call SCRIPTHELP()
		Exit Function
	End If

	If Err.number <> 0 Then
        	LogError "End of Arguments Function", Err.number
	        Err.Clear
	End If
    
End Function
'========================================================================================================
'========================================================================================================
Private Function FormatTime(strDate)
	Dim str
	str =  Mid(strDate,9,2) & ":" _
	& Mid(strDate,11,2) & ":" _
	& Mid(strDate,13,2) & " " _
	& Mid(strDate,5,2) & "-" _
	& Mid(strDate,7,2) & "-" _
	& Mid(strDate,1,4)
	FormatTime = str
End Function
'========================================================================================================
'========================================================================================================
Function ParseArgument(strtext)
Dim a
On Error Resume Next
    
    For a = 0 To wscript.arguments.count - 1
        If wscript.arguments(a) = strtext Then ParseArgument = a + 1
    Next

End Function
'========================================================================================================
'========================================================================================================
Private Sub Scripthelp()
	WScript.Echo
	WScript.Echo "====================================================="
	WScript.Echo "Remotely gather information about a target computer's"
	wscript.echo "configuration and users for investigative purposes."
	wscript.echo ""
	WScript.Echo "Assume local machine if no computer name is provided."
	WScript.Echo ""
	WScript.Echo "Usage: FORENSICS.VBS [computer_name]"
	Wscript.Echo
	Wscript.Echo "tim@blackpondfarm.com"
	Wscript.Echo
	WScript.Echo "====================================================="
	Wscript.Echo
	Wscript.Sleep 1000

End Sub
'========================================================================================================
'========================================================================================================
Function VerifyCscript()
Dim temp

	REM ###### Sets up Vbscript to always run in command window ######
		temp = wshshell.Run("cmd /c ""wscript //h:cscript //nologo //s 1>nul 2>nul""", 0, true)
		temp = MsgBox ("The script has changed the default output of Windows Scripting Host to the command prompt." &_
		vbCrLf & "This is pop up is normal, just re-run the script!", 0, "WSH default changed to cscript.")
		wscript.quit

End Function
'========================================================================================================
'========================================================================================================