'==========================================================================
'
' NAME: IE_Data_Collector.vbs
'
' AUTHOR: Steve Paruszkiewicz , Microsoft
' LAST UPDATE  : 10/23/2007
'
' COMMENT: Collects Internet Explorer and Internet Explorer Policy Data
'			
' NOTE:  When running on Vista/Longhorn an admin token is required to collect
'		 Computer policy data (must be elevated)
'
'		This script is intended for Windows XP and higher OS levels
'==========================================================================
Option Explicit
RunMeWithCscript()	'ensure that cscript is the engine used to run this script


' #region Initialization of Variables
'========= Dim Global Vars ==============
Dim Network : Set Network = CreateObject("Wscript.Network")
Dim fso : Set fso = CreateObject("Scripting.FileSystemObject")
Dim Shell : Set Shell = CreateObject("Wscript.Shell")
Dim strUsername, strUserDomain, strDomainUsername, strComputer, strLogonDC
Dim IELogMissing : IELogMissing = False
strUsername = Network.Username : strUserDomain = Network.UserDomain
strDomainUsername = UCase(strUserDomain) & "\" & strUsername
strComputer = Network.ComputerName
strLogonDC = Shell.ExpandEnvironmentStrings("%logonserver%")
Dim arrAllGPOs : Set arrAllGPOs = CreateObject("Scripting.Dictionary")
Dim arrAllAppliedGPOs : Set arrAllAppliedGPOs = CreateObject("Scripting.Dictionary")
Dim arrAppliedComputerGPOs : Set arrAppliedComputerGPOs = CreateObject("Scripting.Dictionary")
Dim arrAppliedUserGPOs : Set arrAppliedUserGPOs = CreateObject("Scripting.Dictionary")
Dim arrDeniedComputerGPOs : Set arrDeniedComputerGPOs = CreateObject("Scripting.Dictionary")
Dim arrDeniedUserGPOs : Set arrDeniedUserGPOs = CreateObject("Scripting.Dictionary")
Dim strDataFold : strDataFold = strComputer & "_" & GetTimeStampString()
Dim strLocalDataStore : strLocalDataStore = GetThisScriptsFolder() & "\PSS_IE_Data\" & strDataFold
Dim doCollectPolicyData : doCollectPolicyData = True
Dim gErrData: gErrData = ""

'#endregion

WScript.Echo "Started data collection at: " & Now

CollectLocalData()
ExportRegKeys(strLocalDataStore)

	
If Left(getOS(),6) <> "Win2k-" Then		'disable policy collection for windows 2000 (doesn't support the wmi classes used)
 	doCollectPolicyData = True
Else
 	WScript.Echo "Windows 2000 Detected.... policy data will NOT be collected."
 	doCollectPolicyData = False
End If


If doCollectPolicyData Then
	EnumGPOs("user")
	EnumGPOs("computer")
	CollectAppliedPolicyData()
	GeneratePolicySummaries(strLocalDataStore)
	GetSuperVerboseGPResult(strLocalDataStore)
End If

'GenerateReportOutput()				'Displays policy information summary at end of script

WScript.Echo "Done collecting data at:  " & Now
ExitScript(strLocalDataStore)

'***** Writes file and folder directives to the cabinet directive file ******
Sub WriteFileDirectives(strInFold, ByRef Outfile)
	Dim filesString, infold, fold, file, dest
	Set infold = fso.GetFolder(strInfold)
	For Each file In inFold.Files
		
		If file.Name <> "cabdirect.ddf" Then outFile.WriteLine """" & file.path & """"
	Next
	For Each fold In inFold.subFolders
		dest = Right(fold.path,Len(fold.Path) - Len(strLocalDataStore))
		outfile.writeline ".set DestinationDir=" & dest
			WriteFileDirectives fold.path, outfile
	Next
End Sub

'**** Creates a makecab directive file and creates a cab of the data  - Then opens data folder ****
Sub ExitScript(strOpenFold)
	Dim Shell : Set Shell = CreateObject("WScript.Shell")
	Dim fold, file, errFile
	
	If gErrData <> "" Then							'Write any error data to error log
		Set errFile = fso.CreateTextFile(strOpenFold & "\!!ERRORLOG.txt",2,True)
		errFile.WriteLine "****** LOGFILE CREATED " & Now & " ******"
		errFile.WriteLine "****** Script Ran with errors - please review error data below ******" & vbCrLf
		errFile.Write gErrData
		errFile.Close
	End If
	
	Dim directiveFile : Set directiveFile = fso.CreateTextFile(strOpenFold & "\cabdirect.ddf",False)
	
	WScript.echo "Preparing CAB file..."
	With directiveFile
		.WriteLine ".OPTION EXPLICIT"
		.WriteLine ".Set CabinetNameTemplate=" & strDataFold & ".cab"
 		.WriteLine ".set DiskDirectoryTemplate="""& strOpenFold & """\cab"
		.WriteLine ".Set MaxDiskSize=CDROM"
		.WriteLine ".Set FolderSizeThreshold=2000000"
		.WriteLine ".Set CompressionType=MSZIP"
		.Writeline ".Set Cabinet=on"
		.WriteLine ".Set Compress=on"
	Set fold = fso.GetFolder(strOpenFold)
	End With
	WriteFileDirectives strOpenFold,directiveFile
	directiveFile.Close
	Shell.run "MakeCAB /v2 /f """ & strOpenFold & "\CABDIRECT.DDF"" /l """ & strOpenFold &"""",0,True
	If fso.FileExists(strOpenFold & "\cab\" & strDataFold & ".cab") Then
		WScript.Echo "Done preparing CAB file." & VbCrLf & "Script Exiting!"
	Else
		WScript.Echo "There was a problem preparing the CAB file.  You may have to compress the data manually" & VbCrLf & "...Script Exiting!"
	End If
	Shell.Run "explorer.exe """ & strOpenFold & """\cab"
	WScript.Quit
End Sub



'************																 *****************
' 			   Enumerates GPOs from WMI (RSOP) and adds their data to dictionary arrays 
'              EnumGPOs() can be passed either "user" or "computer" as the gpo type
'************																 *****************
Sub EnumGPOs(strGPOType)
	On Error Resume Next
	Dim objWMIService, SWBemlocator
	Dim objItem, subItem, isUserGPO, isComputerGPO
	Dim colItems, subColItems
	Dim objGPO, strGPOID
	Dim strComputer, UserName, Password, strCurUserSID
	Dim IsLocalGPO, IsLinkEnabled, IsGPOEnabled, IsFilterAllowed, IsGPOAccessDenied, VersionNotZero
	
	strGPOType = lCase(strGPOType)
	
	If strGPOType = "user" Then
		isUserGPO = True
		isComputerGPO = False
	ElseIf strGPOType = "computer" Then
		isUserGPO = False
		isComputerGPO = True
	Else
		fatalExit "An invalid gpoType string was passed to EnumGPOs(): " & strGPOType & " is not a valid gpo type"
	End If
	
	If isUserGPO Then strCurUserSID = Replace(GetCurrentUserSID(),"-","_")			'Replace dashes with underscores for WMI sid String
	
	strComputer = "." : UserName = "" : Password = ""
	
	Set SWBemlocator = CreateObject("WbemScripting.SWbemLocator")
	
	If isUserGPO Then
		Set objWMIService = SWBemlocator.ConnectServer(strComputer,"root\rsop\user\"&strCurUserSID,UserName,Password)
	Else
		Set objWMIService = SWBemlocator.ConnectServer(strComputer,"root\rsop\computer",UserName,Password)
	End If
	
	If TypeName(objWMIService) <> "Empty" Then
	
		Set colItems = objWMIService.ExecQuery("Select * from RSOP_gplink",,48)
		
		'Get The GPO_Link objects properties
		For Each objItem in colItems
				 
				If Not ucase(objItem.gpo) = UCase("RSOP_GPO.id=""LocalGPO""") Then
					IsLocalGPO = False
					strGPOID = Mid(objItem.gpo,InStr(ucase(objItem.gpo),"CN="),Len(objItem.gpo) - InStr(ucase(objItem.gpo),"CN="))	'strip out quotes and prefix RSOP_GPO.id=
				Else
					IsLocalGPO = True
					strGPOID = "LocalGPO"				'Set the GPOID for querying local gpo
				End If
				
				Set objGPO = New GPOData				'create instance of GPOData Class
				
				With objGPO
					.appliedOrder = objItem.appliedOrder			'populate GPOData class property values from RSOP_GPOLink class
					.linkEnabled = objItem.enabled
					.linkorder = objItem.linkorder
					.noOverride = objItem.noOverride
					.som = objItem.som
					.somOrder = objItem.somOrder
					
					If Right(objItem.som,1) = 1 Then				'Set the scope of management strings
						.somReason = "Normal"
					ElseIf Right(objItem.som,1) = 2 Then
						.somReason = "Loopback"
					Else
						.somReason = "Unknown"
					End If
					
				End With	
					IsLinkEnabled = objItem.enabled
				
				'Get the properties of the GPO associated with the link
				Set subColItems = objWMIService.ExecQuery("Select * from RSOP_GPO where id = '"&strGPOID&"'",,48)
					
					For Each subItem In subColItems
						IsGPOEnabled = subItem.Enabled
						IsFilterAllowed = subItem.FilterAllowed
						IsGPOAccessDenied = subItem.AccessDenied
						
						If subItem.version = 0 Then
							VersionNotZero = False
						Else
							VersionNotZero = True
						End If
						
						With objGPO									'populate GPOData class property values from RSOP_GPO class
							.accessDenied = subItem.accessDenied
							.GUIDName = subItem.GUIDName
							.policyID = subItem.ID
							.policyName = subItem.name
							.policyEnabled = subItem.enabled
							.fileSystemPath = subItem.fileSystemPath
							.policyVersion = subItem.Version
							.filterAllowed = subItem.filterAllowed
							.hasIEAKFold = IsIEMaintPol(subItem.FileSystemPath)
						End With
					Next
				
				If not objGPO.fileSystemPath = "" Then
					If Not arrAllGPOs.Exists(objGPO.fileSystemPath) Then arrAllGPOs.Add objGPO.fileSystemPath, objGPO	'Add gpo to all gpos array
				Else
					gErrData = gErrData & VbCrLf & UCase(strGPOType &"::objGPO.fileSystemPath was blank: " & strGPOID)
				End If
				
					If IsGPOEnabled And IsLinkEnabled And IsFilterAllowed And VersionNotZero And Not IsGPOAccessDenied Then
							
							'Add the data to applied gpos array
							If Not arrAllAppliedGPOs.Exists(objGPO.fileSystemPath) Then arrAllAppliedGPOs.Add objGPO.fileSystemPath, objGPO
							
							'Add the data to the applied user gpos array
							If isUserGPO Then If Not arrAppliedUserGPOs.Exists(objGPO.fileSystemPath) Then arrAppliedUserGPOs.Add objGPO.fileSystemPath,objGPO
							
							'Add the data to the applied computer gpos array
							If isComputerGPO Then If Not arrAppliedComputerGPOs.Exists(objGPO.fileSystemPath) Then arrAppliedComputerGPOs.Add objGPO.fileSystemPath,objGPO
							
					ElseIf IsGPOEnabled And IsLinkEnabled And IsGPOAccessDenied Then
							
							'Add the data the the denied user gpos array
							If isUserGPO Then If Not arrDeniedUserGPOs.Exists(objGPO.fileSystemPath) Then	arrDeniedUserGPOs.Add objGPO.fileSystemPath,objGPO
							
							'Add the data the the denied computer gpos array
							If isComputerGPO Then If not arrDeniedComputerGPOs.Exists(objGPO.fileSystemPath) Then arrDeniedComputerGPOs.Add objGPO.fileSystemPath,objGPO
							
					End If
				
		Next
	Else			'because TypeName(objWMIService) was "Empty"
		
		If isUserGPO Then
			WScript.Echo "ERROR: Could not enumerate user policies via WMI for user SID: " & strCurUserSID
			gErrData = gErrData & VbCrLf & "ERROR: Could not enumerate user policies via WMI for user SID: " & strCurUserSID & vbcrLf
		Else
			WScript.Echo "ERROR: Could not enumerate computer policies via WMI"
			gErrData = gErrData & VbCrLf & "ERROR: Could not enumerate computer policies via WMI" & vbCrLf
		End If
		
	End If 
End Sub

'************** Displays the names of the GPOs in the arrays ****************
Sub GenerateReportOutput()
	Dim item
	WScript.Echo VbCrLf & "The following Computer policies were applied:"
	WScript.Echo "============================================="
	For Each item In arrAppliedComputerGPOs.Items
		WScript.Echo item.policyName & " - " & item.somReason
	Next
	
	WScript.Echo VbCrLf & "The following User policies were applied:"
	WScript.Echo "============================================="
	For Each item In arrAppliedUserGPOs.Items
		WScript.Echo item.policyName & " - " & item.somReason
	Next
	
	WScript.Echo VbCrLf & "The following Computer policies were not applied due to [ACCESS DENIED]:"
	WScript.Echo 		  "========================================================================"
	For Each item In arrDeniedComputerGPOs.Items
		WScript.Echo item.PolicyName	 & " - " & item.somReason
	Next
	
	WScript.Echo VbCrLf & "The following User policies were not applied due to [ACCESS DENIED]:"
	WScript.Echo 		  "===================================================================="
	For Each item In arrDeniedUserGPOs.Items
		WScript.Echo item.PolicyName & " - " & item.somReason
	Next
End Sub


'******** Collects local data from the user's profile ******
Sub CollectLocalData()
	
	Dim strAppDataIE, strLocalAppDataIE, strSecTemplatePolDir, strLocalGroupPolicyDir
	Dim strLocalCustomDir, strLocalCustomDirX86
	Dim fso : Set fso = CreateObject("Scripting.FileSystemObject")
	Dim Shell : Set Shell = CreateObject("wscript.shell")
	Dim strCurrUserProf : strCurrUserProf = Shell.ExpandEnvironmentStrings("%userprofile%")
	Dim WinDir : WinDir = Shell.ExpandEnvironmentStrings("%WINDIR%")
	Dim ProgFiles 
	Dim ProgFilesX86 : ProgFilesX86 = Shell.ExpandEnvironmentStrings("%PROGRAMFILES(x86)%")
	
	If ProgFilesX86 <> "" Then								'Get program files for x86 and x64
		ProgFiles = Left(ProgFilesX86,Len(ProgFilesX86)-6)
	Else
		ProgFiles = Shell.ExpandEnvironmentStrings("%PROGRAMFILES%")
	End If
	
	
	
	If not fso.FolderExists(strLocalDataStore) Then		'Create the local data storage folder
		CreateFolder(strLocalDataStore)
	Else
		'The folder already exists
	End If
	
	strAppDataIE = strCurrUserProf & "\Application Data\Microsoft\Internet Explorer"
	strLocalAppDataIE = strCurrUserProf & "\Local Settings\Application Data\Microsoft\Internet Explorer"
	strSecTemplatePolDir = WinDir & "\security\templates\policies"
	strLocalGroupPolicyDir = WinDir & "\system32\GroupPolicy"
	strLocalCustomDir = ProgFiles & "\Internet Explorer\Custom"
	strLocalCustomDirX86 = ProgFilesX86 & "\Internet Explorer\Custom"
	
	
	If fso.FolderExists(strAppDataIE) Then																'Copy the IE Data from AppData Folder
		'WScript.Echo ("""" & strLocalDataStore & Right(strAppDataIE,Len(strAppDataIE)-2) & """")
		CreateFolder(strLocalDataStore & Right(strAppDataIE,Len(strAppDataIE)-2))
		fso.CopyFolder strAppDataIE,strLocalDataStore & Right(strAppDataIE,Len(strAppDataIE)-2),True    'Trim off drive letter and append path
		DeleteFolder strLocalDataStore & Right(strAppDataIE,Len(strAppDataIE)-2) & "\Quick Launch"		'Remove Quick Launch folder if it exists - we don't need it
	End If
	
	If fso.FolderExists(strLocalAppDataIE) Then														'Copy the IE Data from Local Settings ->AppData Folder
		CreateFolder(strLocalDataStore & Right(strLocalAppDataIE,Len(strLocalAppDataIE)-2))
		fso.CopyFolder strLocalAppDataIE,strLocalDataStore & Right(strLocalAppDataIE,Len(strLocalAppDataIE)-2),True    'Trim off drive letter and append path
	End If
	
	If fso.FolderExists(strSecTemplatePolDir) Then														'Copy the Security templates directory
		CreateFolder(strLocalDataStore & Right(strSecTemplatePolDir,Len(strSecTemplatePolDir)-2))
		fso.CopyFolder strSecTemplatePolDir,strLocalDataStore & Right(strSecTemplatePolDir,Len(strSecTemplatePolDir)-2),True    'Trim off drive letter and append path
	End If
	
	If fso.FolderExists(strLocalGroupPolicyDir) Then														'Copy the local GroupPolicy directory
		CreateFolder(strLocalDataStore & Right(strLocalGroupPolicyDir,Len(strLocalGroupPolicyDir)-2))
		fso.CopyFolder strLocalGroupPolicyDir,strLocalDataStore & Right(strLocalGroupPolicyDir,Len(strLocalGroupPolicyDir)-2),True    'Trim off drive letter and append path
	End If
	
	If fso.FileExists(Windir & "\Active Setup.log") Then
			fso.CopyFile Windir & "\Active Setup.log",strLocalDataStore & "\",True
	End If
	
	If IE7Installed And Not (getOS="Vista-Wrkstat" Or getOS="Win2k8-Srvr" Or getOS="Win2k8-Srvr-DC") Then	'Check for IE7.log but not on Vista or Windows 2008
		If fso.FileExists(Windir & "\ie7.log") Then
			fso.CopyFile Windir & "\ie7.log",strLocalDataStore & "\",True
			IELogMissing = False
		Else
			IELogMissing = True
			fso.CreateTextFile(strLocalDataStore & "\!!Cannot find IE7.LOG - Please remove Internet Explorer 7 and reinstall!!")
		End If
		
		If fso.FileExists(Windir & "\ie7_main.log") Then
			fso.CopyFile Windir & "\ie7_main.log",strLocalDataStore & "\",True
		End If
	End If
	
	'WScript.Echo "strLocalCustomDir ==>" & strLocalCustomDir & "<=="
	If fso.FolderExists(strLocalCustomDir) Then														'Copy the local custom folder
	
		CreateFolder(strLocalDataStore & Right(strLocalCustomDir,Len(strLocalCustomDir)-2))
		fso.CopyFolder strLocalCustomDir,strLocalDataStore & Right(strLocalCustomDir,Len(strLocalCustomDir)-2),True    'Trim off drive letter and append path
	
	End If
	
	If fso.FolderExists(strLocalCustomDirx86) Then														'Copy the local custom folder from x86

		CreateFolder(strLocalDataStore & Right(strLocalCustomDirx86,Len(strLocalCustomDirx86)-2))
		fso.CopyFolder strLocalCustomDirx86,strLocalDataStore & Right(strLocalCustomDirx86,Len(strLocalCustomDirx86)-2),True    'Trim off drive letter and append path
	
	End If
	
End Sub


'********** Checks the policy for the IEAK folder **************
Function IsIEMaintPol(strPolServerPath)
	Dim fso : Set fso = CreateObject("Scripting.FileSystemObject")
	Dim IEPolFold
	
	If fso.FolderExists(strPolServerPath) Then
		IEPolFold = strPolServerPath & "\Microsoft\IEAK"
		If fso.FolderExists(IEPolFold) Then
			IsIEMaintPol = True
		Else
			IsIEMaintPol = False
		End If
	Else
		IsIEMaintPol = False
	End If
End Function


'********* Enumerates the applied Computer group policies ********
Sub CollectAppliedPolicyData()
	On Error Resume next	
	Dim objItem, strDestFold, intRemove
    For Each objItem In arrAllAppliedGPOs.Items
		If Not objItem.FileSystemPath = Empty Then
			strDestFold = Replace(objItem.FileSystemPath,objItem.guidname,objItem.policyName)				'Change output folder path to name instead of guid
			If Left(objItem.FileSystemPath,2) = "\\" Then
				'replace domain with logondc
				strDestFold = strLogonDC & "\" & Right(strDestFold,Len(strDestFold)-InStr(ucase(strDestFold),UCase("\SysVol\")))
				intRemove = 1		'UNC
			Else
				intRemove = 2		'Drive
			End If
			
			If Not strDestFold = "" Then	
				strDestFold = (strLocalDataStore & Right(strDestFold,Len(strDestFold)-intRemove))		'Strip drive or \\ w/intRemove
				CreateFolder(strDestFold)
				Dim Shell : Set Shell = CreateObject("Wscript.Shell")
				fso.CopyFolder objItem.FileSystemPath, strDestFold
				If Err.number <> 0 Then
					gErrData = gErrData & VbCrLf & "Error copying: " & objItem.FileSystemPath & " reason: " & Err.Number & "  - " & Err.Description
					Err.Clear
				Else
					'*** Add log file data here to log all policies being collected
					CreatePolicyDataFile objItem, strDestFold						'Create a file with the original GUID in the destination folder
				End If
				
				'WScript.Echo "NewPath: " & strDestFold
			End If
		End If
	Next
		'WScript.Echo x
End Sub


 '************* Creates a file with the original GUID name that contains the policy's properties ***********
 Sub CreatePolicyDataFile(objGPO, strDestFold)
 	Dim outfile
 	Const FORAPPEND = 8
 	strDestfold = fso.GetFolder(strDestfold).ParentFolder			'change destination to policy parent folder
 	If Not fso.FileExists(strDestFold & "\" & objGPO.guidname & ".txt") Then
 		set outfile = fso.CreateTextFile(strDestFold & "\" & objGPO.guidname & ".txt",False)
 	Else	
 		set outfile = fso.OpenTextFile(strDestFold & "\" & objGPO.guidname & ".txt",FORAPPEND,False)
 		
 	End If
 	If objGPO.policyname = "Local Group Policy" Then
 		outfile.WriteLine "*******     This is the Local Group Policy Object     *******"
 	Else 
 		outfile.WriteLine "*******     This policy's folder was renamed from " & objGPO.guidname & " to " & objGPO.policyname & "     *******"
 	End If
 	outfile.WriteLine "Policy Name: " & objGPO.policyName
    outfile.WriteLine "GUID Name: " & objGPO.GUIDName
    outfile.WriteLine "ID: " & objGPO.policyID
    outfile.WriteLine "File System path: " & objGPO.FileSystemPath
    outfile.WriteLine "Access Denied: " & objGPO.AccessDenied
    outfile.WriteLine "GPO Enabled: " & objGPO.policyEnabled
    
    outfile.WriteLine "IEAK Policy: "  & objGPO.hasIEAKfold
    outfile.WriteLine "Filter Allowed: " & objGPO.FilterAllowed
    outfile.WriteLine "GPO Version: " & objGPO.policyVersion
    outfile.WriteLine "Link Applied Order: " & objGPO.appliedOrder
	outfile.WriteLine "GPO Link Order: " & objGPO.linkorder
	outfile.WriteLine "GPO Link Enabled: " & objGPO.linkEnabled
	outfile.WriteLine "No Overide: " & objGPO.noOverride
	outfile.WriteLine "Applied at: " & objGPO.som
	outfile.WriteLine "Applied order: " & objGPO.somOrder
	outfile.WriteLine "Method applied: " & objGPO.somReason			'Normal = 1     Loopback = 2
	outfile.WriteLine
 	
 	outfile.Close
 End Sub
 '************* Creates a summary file with data for all policies ***********
 Sub GeneratePolicySummaries(strDestFold)
 	Dim outfile, objGPO
 	set outfile = fso.CreateTextFile(strDestFold & "\All_Policies_Summary.txt",True)
 	outfile.WriteLine "*******     Group policy summary information for user " & UCase(strUsername) & " on computer " & UCase(strComputer)& "     *******"
 
 	For Each objGPO In arrAllGPOs.items
	 	
	 	outfile.WriteLine "Policy Name: " & objGPO.policyName
	    outfile.WriteLine "GUID Name: " & objGPO.GUIDName
	    outfile.WriteLine "ID: " & objGPO.policyID
	    outfile.WriteLine "File System path: " & objGPO.FileSystemPath
	    outfile.WriteLine "Access Denied: " & objGPO.AccessDenied
	    outfile.WriteLine "GPO Enabled: " & objGPO.policyEnabled
	    
	    outfile.WriteLine "IEAK Policy: "  & objGPO.hasIEAKfold
	    outfile.WriteLine "Filter Allowed: " & objGPO.FilterAllowed
	    outfile.WriteLine "GPO Version: " & objGPO.policyVersion
	    outfile.WriteLine "Link Applied Order: " & objGPO.appliedOrder
		outfile.WriteLine "GPO Link Order: " & objGPO.linkorder
		outfile.WriteLine "GPO Link Enabled: " & objGPO.linkEnabled
		outfile.WriteLine "No Overide: " & objGPO.noOverride
		outfile.WriteLine "Applied at: " & objGPO.som
		outfile.WriteLine "SOM Applied order: " & objGPO.somOrder
		outfile.WriteLine "Method applied: " & objGPO.somReason			'Normal = 1     Loopback = 2
		outfile.WriteLine
 	Next
 	outfile.Close
 	
 	set outfile = fso.CreateTextFile(strDestFold & "\Applied_Policies_Summary.txt",True)
 	outfile.WriteLine "******* Applied Group policy summary information for user " & UCase(strUsername) & " on computer " & UCase(strComputer)& "     *******"
 
 	For Each objGPO In arrAllAppliedGPOs.Items
	 	
	 	outfile.WriteLine "Policy Name: " & objGPO.policyName
	    outfile.WriteLine "GUID Name: " & objGPO.GUIDName
	    outfile.WriteLine "ID: " & objGPO.policyID
	    outfile.WriteLine "File System path: " & objGPO.FileSystemPath
	    outfile.WriteLine "Access Denied: " & objGPO.AccessDenied
	    outfile.WriteLine "GPO Enabled: " & objGPO.policyEnabled
	    
	    outfile.WriteLine "IEAK Policy: "  & objGPO.hasIEAKfold
	    outfile.WriteLine "Filter Allowed: " & objGPO.FilterAllowed
	    outfile.WriteLine "GPO Version: " & objGPO.policyVersion
	    outfile.WriteLine "Link Applied Order: " & objGPO.appliedOrder
		outfile.WriteLine "GPO Link Order: " & objGPO.linkorder
		outfile.WriteLine "GPO Link Enabled: " & objGPO.linkEnabled
		outfile.WriteLine "No Overide: " & objGPO.noOverride
		outfile.WriteLine "Applied at: " & objGPO.som
		outfile.WriteLine "SOM Applied order: " & objGPO.somOrder
		outfile.WriteLine "Method applied: " & objGPO.somReason			'Normal = 1     Loopback = 2
		outfile.WriteLine
 	Next
 	outfile.Close
 End Sub



'*******   Returns the current User's SID as a string ******
Function GetCurrentUserSID()
		
	'On Error Resume Next
	Dim strComputer, strUser, strSID, intCount
	Dim objWMIService, objItem, SWBemlocator, colItems, strDomain
	Dim network : Set network = CreateObject("WScript.Network")
	strUser = network.username
	strDomain = network.UserDomain
	strComputer = "."
	Set SWBemlocator = CreateObject("WbemScripting.SWbemLocator")
	Set objWMIService = SWBemlocator.ConnectServer(strComputer,"root\CIMV2")
	Set colItems = objWMIService.ExecQuery("Select * from Win32_UserAccount where name = '" & strUser & "'" _ 
					& " and domain = '" & strDomain & "'",,48)
	
 	intCount = 0
	For Each objItem In colItems
		strSID = Cstr(objItem.SID)
		intCount = intCount + 1
 	Next
 	
 	If intCount > 0 Then
 		GetCurrentUserSID = strSID
 	Else
 		GetCurrentUserSID = "NOTFOUND"
 	End If

  	
End Function

'********** Creates folders and subfolders given a path string (works with UNC) ****************
Sub CreateFolder(strFldPath)
	Dim fso : Set fso = CreateObject("Scripting.FileSystemObject")
	Dim fldArray, x, intStartIndex, blnUNC, strDestFold : strDestFold = ""
	
	If Left(strFldPath,2) = "\\"  Then 
		blnUNC = True
		intStartIndex = 3										'Start at the first folder in UNC path
	Else
		blnUNC = False
		intStartIndex = 0
	End If
	
	fldArray = Split(strFldPath,"\")														'Split folders into array
	
	If fldArray(intStartIndex) = "" Then
		fatalExit "Error in CreateFolder(): fldArray was blank"
	End If
	
	For x = intStartIndex To UBound(fldArray)

		If strDestFold = "" Then
			If blnUNC Then 
				strDestFold = "\\" & fldArray(x-1) & "\" & fldArray(x)					'Prefix UNC with server and share
			Else
				strDestFold = fldArray(x)												
			End If
		Else
			strDestFold = strDestFold & "\" & fldArray(x)								'Append each folder to end of path
		End If
		'WScript.Echo "Dest: " & cstr(strDestFold)
		If Not fso.FolderExists(strDestFold) Then
				fso.CreateFolder(strDestFold)
		End If
	Next
End Sub

'*********** Deletes folder ****************
Sub DeleteFolder(strFldPath)
	Dim fso : Set fso = CreateObject("Scripting.FileSystemObject")
	If fso.folderexists(strFldPath) Then fso.deletefolder strFldPath,True
End Sub

'*********** Returns a string of current time for use in file names ****************
Function GetTimeStampString()
	Dim sMon, sDay, sYear, sHour, sMin, sSec
	sMon = AddZero(Month(Now))
	sDay = AddZero(Day(Now))
	sYear = AddZero(Year(Now))
	sHour = AddZero(Hour(Now))
	sMin = AddZero(Minute(Now))
	sSec = AddZero(Second(Now))
	GetTimeStampString = sMon&"_"&sDay&"_"&sYear&"__"&sHour&"_"&sMin&"_"&sSec 
End Function

'***** Adds a leading zero of the string passed is only one char *********
Function AddZero(ByRef strInt1)
	If (Len(strInt1) < 2) Then
		strInt1 = "0" & Cstr(strInt1)
	End If
	AddZero = strInt1
End Function

'***** Returns this script's parent folder as a string *********
Function GetThisScriptsFolder()
	Dim fso : Set fso = CreateObject("Scripting.FileSystemObject")
	GetThisScriptsFolder = fso.GetFile(WScript.ScriptFullName).ParentFolder
End Function

'********** Checks to see if IE7 is installed ******************
Function IE7Installed
	Dim Shell : Set Shell = CreateObject("Wscript.Shell")
	Dim IEVer : IEVer = Left(Shell.RegRead("HKLM\Software\Microsoft\Internet Explorer\Version"),1)	'Extract Major Version Number
	If IEVer = 7 Then
		IE7Installed = True
	Else
		IE7Installed = False
	End If
	
End Function

Sub ExportRegKeys(strDestFold)
	Dim Shell : Set Shell = CreateObject("Wscript.Shell")
	strDestFold = """" & strDestFold & """"
	
	'Collect Client side group policy extention information
	Shell.Run "reg.exe export ""HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon\GPExtensions"" " _ 
			  & strDestFold & "\HKLM_GPExtensions.reg.txt",0,True
	Shell.Run "reg.exe export ""HKEY_CURRENT_USER\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon\GPExtensions"" " _ 
			  & strDestFold & "\HKCU_GPExtensions.reg.txt",0,True
			  
	'Collect applied Group policy History information
	Shell.Run "reg.exe export ""HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Group Policy\History"" " _ 
			  & strDestFold & "\HKLM_GPHistory.reg.txt",0,True
	Shell.Run "reg.exe export ""HKEY_CURRENT_USER\SOFTWARE\Microsoft\Windows\CurrentVersion\Group Policy\History"" " _ 
			  & strDestFold & "\HKCU_GPHistory.reg.txt",0,True
			  
	Shell.Run "reg.exe export ""HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer"" " _ 
			  & strDestFold & "\HKCU_Software_IE.reg.txt",0,True
	Shell.Run "reg.exe export ""HKEY_LOCAL_MACHINE\Software\Microsoft\Internet Explorer"" " _ 
			  & strDestFold & "\HKLM_Software_IE.reg.txt",0,True
			  
	Shell.Run "reg.exe export ""HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Internet Settings"" " _ 
			  & strDestFold & "\HKCU_Internet_Settings.reg.txt",0,True
	Shell.Run "reg.exe export ""HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Internet Settings"" " _ 
			  & strDestFold & "\HKLM_Internet_Settings.reg.txt",0,True
			  
	Shell.Run "reg.exe export ""HKEY_CURRENT_USER\Software\Policies\Microsoft\Internet Explorer"" " _ 
			  & strDestFold & "\HKCU_Policies_IE.reg.txt",0,True
	Shell.Run "reg.exe export ""HKEY_LOCAL_MACHINE\Software\Policies\Microsoft\Internet Explorer"" " _ 
			  & strDestFold & "\HKLM_Policies_IE.reg.txt",0,True
			  
	Shell.Run "reg.exe export ""HKEY_CURRENT_USER\Software\Policies\Microsoft\Internet Explorer"" " _ 
			  & strDestFold & "\HKCU_Policies_IE.reg.txt",0,True
	Shell.Run "reg.exe export ""HKEY_LOCAL_MACHINE\Software\Policies\Microsoft\Internet Explorer"" " _ 
			  & strDestFold & "\HKLM_Policies_IE.reg.txt",0,True
	
	'Collect Active Setup information for IE ESC for Administrators
	Shell.Run "reg.exe export ""HKLM\SOFTWARE\Microsoft\Active Setup\Installed Components\{A509B1A7-37EF-4b3f-8CFC-4F3A74704073}"" " _ 
			  & strDestFold & "\HKLM_Active_Setup_ESC_Admins.reg.txt",0,True
	
	'Collect Active Setup information for IE ESC for Users
	Shell.Run "reg.exe export ""HKLM\SOFTWARE\Microsoft\Active Setup\Installed Components\{A509B1A8-37EF-4b3f-8CFC-4F3A74704073}"" " _ 
			  & strDestFold & "\HKLM_Active_Setup_ESC_Users.reg.txt",0,True
	
	'Collect OC Manager information to see if IEHardening is enabled
	Shell.Run "reg.exe export ""HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\Setup\OC Manager\Subcomponents"" " _ 
			  & strDestFold & "\HKLM_OC_Manager.reg.txt",0,True
	

	'Collect the Active Setup keys
 	Shell.Run "reg.exe export ""HKEY_CURRENT_USER\Software\Microsoft\Active Setup"" " _ 
 			& strDestFold & "\HKCU_ActiveSetup_All.reg.txt",0,True
 	Shell.Run "reg.exe export ""HKEY_LOCAL_MACHINE\Software\Microsoft\Active Setup"" " _ 
 			& strDestFold & "\HKLM_ActiveSetup_All.reg.txt",0,True
 			
 	'Collect the IEAK keys		
 	Shell.Run "reg.exe export ""HKEY_CURRENT_USER\Software\Microsoft\IEAK"" " _ 
 			& strDestFold & "\HKCU_IEAK.reg.txt",0,True
 	Shell.Run "reg.exe export ""HKEY_LOCAL_MACHINE\Software\Microsoft\IEAK"" " _ 
 			& strDestFold & "\HKLM_IEAK.reg.txt",0,True
 			
 			'-TODO:HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer & HKLM

End Sub

Sub GetSuperVerboseGpresult(strDestFold)
	Dim outputFile
	CreateFolder(strDestFold)
	outputFile = fso.GetFolder(strDestFold).ShortPath & "\gpresult.log"
	Shell.Run "cmd.exe /c gpresult.exe /z >> " & outputFile,0,True
End Sub

Sub fatalExit(exitstring)
	set errFile = fso.CreateTextFile(strLocalDataStore& "\!!ERRORLOG.txt",2,True)
	errFile.writeline exitstring
	errFile.Write gErrData
	WScript.quit
End Sub


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Function name:   getOS 
' Determines OS by reading reg val & comparing to known values
' OS type returned as:
'    "Win95A", "Win95B", "Win98", "Win98SE", "WinME"
'    "WinNT4-Wrkstat", "WinNT4-Srvr", "WinNT4-Srvr-DC"
'    "Win2K-Wrkstat", "Win2K-Srvr", "WinXP-Wrkstat"
'   "Win2k3-Srvr", "Winwk3-Srvr-DC", "Vista-Wrkstat", "Win2k8-Srvr"
'  "Win2k8-Srvr-DC"
'  
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function getOS()
	On Error Resume Next
	Dim oFSO, oShell
  	Const sModule = "getOS"

  	Set oFSO = CreateObject("Scripting.FileSystemObject")
  	Set oShell = CreateObject("Wscript.Shell")

	Dim sOStype, sOSversion
	sOStype = oShell.RegRead("HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\ProductOptions\ProductType")
  
	If Err.Number <> 0 Then
	    ' Hex(Err.Number)="80070002"
	    ' - Could not find this key, OS must be Win9x
	    Err.Clear
	    sOStype = oShell.RegRead("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\VersionNumber")
	    If Err.Number <> 0 Then
	      GetOS = "Unknown Win9x"
	      ' Could not pinpoint exact Win9x type
	      Exit Function  ' >>>
    	End If
	End If

	If sOStype = "LanmanNT" _
	Or sOStype = "ServerNT" _
	OR sOStype = "WinNT" Then
	    Err.Clear
	    sOSversion = oShell.RegRead(_
	      "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\CurrentVersion")
	    If Err.Number<>0 Then
		    GetOS = "Unknown NTx"
      		' Could not determine NT version
      		Exit Function  ' >>>
    	End If
  	End If

	If sOSversion = "4.0" Then
    	Select Case sOStype
      	Case "LanmanNT"
        	sOStype = "WinNT4-Srvr-DC"
        	' From HKLM\SYSTEM\CurrentControlSet\Control\ProductOptions\ProductType
      	Case "ServerNT"
        	sOStype = "WinNT4-Srvr"
        	' From HKLM\SYSTEM\CurrentControlSet\Control\ProductOptions\ProductType
      	Case "WinNT"
        	sOStype = "WinNT4-Wrkstat"
        	' From HKLM\SYSTEM\CurrentControlSet\Control\ProductOptions\ProductType
    	End Select
 	 
 	 ElseIf sOSversion = "5.0" Then
    	sOStype = "Win2K"
    	Dim sTmp
    	sTmp = oShell.RegRead(_
      	"HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\ProductOptions\ProductType")
    	If sTmp = "WinNT" Then
      		sTmp = "-Wrkstat"
      		sOStype = sOStype & sTmp
    	ElseIf sTmp = "ServerNT" Then
      		sTmp = "-Srvr"
      		sOStype = sOStype & sTmp
    	Else
      		GetOS = "Unknown Win2K"
      		' Could not pinpoint exact Win2K type
      		Exit Function  ' >>>
      	End If
      
      ElseIf sOSversion = "5.1" Then
    	sOStype = "WinXP"
    	sTmp = oShell.RegRead(_
      	"HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\ProductOptions\ProductType")
    	If sTmp = "WinNT" Then
      		sTmp = "-Wrkstat"
      		sOStype = sOStype & sTmp
    	ElseIf sTmp = "ServerNT" Then
      		sTmp = "-Srvr"
      		sOStype = sOStype & sTmp
    	Else
      		GetOS = "Unknown WinXP"
      		' Could not pinpoint exact WinXP type
      		Exit Function  ' >>>
      		
   		End If
	  ElseIf sOSversion = "5.2" Then
    	sOStype = "Win2K3"
    	sTmp = oShell.RegRead(_
      	"HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\ProductOptions\ProductType")
    	If sTmp = "WinNT" Then
      		sTmp = "-Wrkstat"
      		sOStype = sOStype & sTmp
    	ElseIf sTmp = "ServerNT" Then
      		sTmp = "-Srvr"
      		sOStype = sOStype & sTmp
		ElseIf sTmp = "LanmanNT" Then
        	sOStype = "Win2k3-Srvr-DC"
    	Else
      		GetOS = "Unknown Windows 2003"
      		' Could not pinpoint exact Win2K3 type
      		Exit Function  ' >>>
      End If
	
	  ElseIf sOSversion = "6.0" Then
    	sOStype = "Win2k8"		'Vista or Longhorn (Windows Server 2008)
    	sTmp = oShell.RegRead(_
      	"HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\ProductOptions\ProductType")
    	If sTmp = "WinNT" Then
      		sTmp = "-Wrkstat"
			sOStype = "Vista"	'reset OS type to Vista so we return Vista-Wrkstat
      		sOStype = sOStype & sTmp
    	ElseIf sTmp = "ServerNT" Then
      		sTmp = "-Srvr"
      		sOStype = sOStype & sTmp	'We will return Win2k8-Srvr 
		ElseIf sTmp = "LanmanNT" Then
        	sOStype = "Win2k8-Srvr-DC"
    	Else
      		GetOS = "Unknown Windows Vista/Longhorn"
      		' Could not pinpoint exact Vista/Windows 2008 type
      		Exit Function  ' >>>
      End If
  	Else
    	Select Case sOStype
      	Case "4.00.950"
        	sOStype = "Win95A"
      	Case "4.00.1111"
        	sOStype = "Win95B"
      	Case "4.03.1214"
        	sOStype = "Win95B"
      	Case "4.10.1998"
        	sOStype = "Win98"
      	Case "4.10.2222"
	        sOStype = "Win98SE"
    	Case "4.90.3000"
        	sOStype = "WinME"   ' Windows Me
      	Case Else
        	MsgBox "sOStype = " & sOStype & vbCrLf & "Could not recognize" &_
        	" this particular OS.  Please contact your system administrator.",_
        	vbCritical, "Error in module: " & sModule
    	End Select
  	End If
  	GetOS = sOStype
 	' --- CleanUp
	Set oFSO = Nothing
  	Set oShell = Nothing
  	
End Function


'************																 *****************
'						Class for storing gpo and gpo link data
'			
'			For more information on these values see the following
'			topics under MSDN: RSOP_GPO and RSOP_GPLink
'				
'************																 *****************
Class GPOData
	
	'RSOP_GPLink properties
	Public appliedOrder
	Public linkEnabled
	Public linkorder
	Public noOverride
	Public som
	Public somOrder
	Public somReason	'Normal = 1     Loopback = 2
	
	'RSOP_GPO properties
	Public policyName
  	Public GUIDName
    Public accessDenied
    Public policyEnabled
    Public policyVersion
    Public fileSystemPath
    Public filterAllowed
 	Public policyID
 	Public hasIEAKFold    
 	
End Class


'*********************************************************************************
'	Subroutine: RunMeWithCscript()	
'
'	Author: Steve Paruszkiewicz, Microsoft (stevepar@microsoft.com)
'	Last Modified:  July 18, 2007
'	
'	Purpose:
'	Forces the currently running script to use Cscript.exe as the Script Engine
'	If the script is already running with cscript.exe the sub exits and continues the script
'
'	Sub Attempts to call the script with its original arguments.  Arguments that contain a space
'	will be wrapped in double quotes when the script calls itself again.
'	To verify your command string you can echo out the scriptCommand variable	
'
'	Usage:  Add a call to this sub (RunMeWithCscript) to the beggining of your script to ensure
'	        that cscript.exe is used as the script engine
'**********************************************************************************		
Sub RunMeWithCscript()

	Dim scriptEngine, engineFolder, Args, arg, scriptName, argString, scriptCommand

	scriptEngine = Ucase(Mid(Wscript.FullName,InstrRev(Wscript.FullName,"\")+1))
	engineFolder = Left(Wscript.FullName,InstrRev(Wscript.FullName,"\"))
	argString = ""
	
	If scriptEngine = "WSCRIPT.EXE" Then	
		Dim Shell : Set Shell = CreateObject("Wscript.Shell")
		Set Args = Wscript.Arguments
		
		For each arg in Args						'loop though argument array as a collection to rebuild argument string
			If instr(arg," ") > 0 Then arg = """" & arg & """"	'if the argument contains a space wrap it in double quotes
			argString = argString & " " & Arg
		Next

		'Create a persistent command prompt for the cscript output window and call the script with its original arguments	
		scriptCommand = "cmd.exe /k " & engineFolder & "cscript.exe """ & Wscript.ScriptFullName & """" & argString

		Shell.Run scriptCommand,,False
		Wscript.Quit
	Else
		Exit Sub					'Already Running with Cscript Exit this Subroutine
	End If


End Sub