Private Function is64bit()
	Dim filesys : Set filesys = CreateObject("Scripting.FileSystemObject")
	Dim bln64bit : bln64bit = False
	If filesys.FolderExists("C:\Program Files (x86)") then bln64bit = True
	is64bit = bln64bit
End Function

'======================================================
' VBScript Source File
' NAME: Java Runtime Environment Installation
' AUTHOR: Andrew J Healey
' DATE  : 2010.07.15
' COMMENT: This script will install the jre references based on processor, existing 
' 				   installations, and operating system.  This script is to be run at startup
'				   under the Local System account. No user interaction is required for 
'				   this script to work properly.
'======================================================
 
Option Explicit
 
If isClientOperatingSystem = False Then wscript.quit
 
Dim jreVerMajor, jreVerMinor
Dim strCommand, strPathToInstall, strInstallFile, strArguments
 
'============== BEGIN CONFIGURATION SECTION =================
jreVerMajor = "jre1.5.0_" 'As string
jreVerMinor = 9 'As Integer for <> operations
strPathToInstall = "\\servername\Software\Java\" 'Point to share \\servername\share\folder\
strInstallFile = "jre-1_5_0_09-windows-i586-p.exe"
strArguments = "/s /v /qn ADDLOCAL=jrecore,extra IEXPLORER=1 REBOOT=Suppress JAVAUPDATE=0 SYSTRAY=0 WEBSTARTICON=0"
strCommand = strPathToInstall & strInstallFile & " " & strArguments
'============== END CONFIGURATION SECTION =================
 
If checkForJRE(jreVerMajor, jreVerMinor) = False Then
	Call InstallJava(strCommand)
End If
 
Private Function checkForJRE(ByVal jreVerMajor, ByVal jreVerMinor)
	Dim jrePath
	Dim blnMajorFound : blnMajorFound = False
	Dim blnMinorFound : blnMinorFound = False
 
	If is32bit Then
		jrePath = "C:\Program Files\Java\"
	Else
		jrePath = "C:\Program Files (x86)\Java\"
	End If
 
	On Error Resume Next
		Dim objFSO : Set objFSO = CreateObject("Scripting.FileSystemObject")
		Dim objFolder : Set objFolder = objFSO.GetFolder(jrePath)
		Dim colSubfolders : Set colSubfolders = objFolder.Subfolders
		Dim objSubfolder
 
		For Each objSubfolder in colSubfolders
			If Left(objSubfolder.Name,Len(jreVerMajor)) = jreVerMajor Then
				blnMajorFound = True
				If CInt(Right(objSubfolder.Name,2)) >= jreVerMinor Then
					blnMinorFound = True
				End If
			End If
		Next
 
		If Err.Number <> 0 Then
			chechForJRE = True
			Exit Function
		End If
 
		If blnMajorFound = False And blnMinorFound = False Then
			checkForJRE = False
		Else
			checkForJRE = True
		End If
	On Error GoTo 0
 
	Set objSubfolder = Nothing
	Set colSubfolders = Nothing
	Set objFolder = Nothing
	Set objFSO = Nothing
	jrePath = Empty
	blnMajorFound = Null
	blnMinorFound = Null
	jreVerMajor = Empty
	jreVerMinor = Empty
End Function 
 
Private Function is32bit()
	'Get processor architecture; do not use remotely
	const HKEY_LOCAL_MACHINE = &H80000002
	Dim oReg,strKeyPath,strValueName
	Dim strValue
	On Error Resume Next
		Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
 
		strKeyPath = "SYSTEM\CurrentControlSet\Control\Session Manager\Environment"
		strValueName = "PROCESSOR_ARCHITECTURE"
		oReg.GetStringValue HKEY_LOCAL_MACHINE,strKeyPath,strValueName,strValue
 
		If Err.Number <> 0 or strValue = "x86" Then
			is32bit = True
		Else
			is32bit = False
		End If
		Err.Clear
	On Error GoTo 0
 
	Set oReg = Nothing
	strKeyPath = Empty
	strValueName = Empty
End Function 
 
Private Function InstallJava(ByVal strCommand)
	On Error Resume Next
		Dim objWshShell, intRC
 
		Set objWshShell = WScript.CreateObject("WScript.Shell")
		intRC = objWshShell.Run(strCommand, 0, True)
 
		If intRC <> 0 Or Err.Number <> 0 Then
			InstallJava = "Failed"
		Else
			InstallJava = "Success"
		End If
	On Error GoTo 0
	Set objWshShell = Nothing
	intRC = Empty
End Function 
 
Private Function isClientOperatingSystem()
	Dim objWMIService, objItem, colItems
	Dim strOS
 
	On Error Resume Next
		' WMI Connection to the object in the CIM namespace
		Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
 
		' WMI Query to the Win32_OperatingSystem
		Set colItems = objWMIService.ExecQuery("Select * from Win32_OperatingSystem")
 
		' For Each... In Loop (Next at the very end)
		For Each objItem in colItems
			strOS = objItem.Caption
		Next
 
		If InStr(strOS,"Windows 7") <> 0 Or InStr(strOS,"XP") <> 0 Or InStr(strOS,"2000 Professional") <> 0 Or InStr(strOS,"Vista") <> 0 Then
			isClientOperatingSystem = True
		Else
			isClientOperatingSystem = False
		End If
 
		If Err.Number <> 0 Then isClientOperatingSystem = False
 
		strOS = Empty
		Set objItem = Nothing
		Set colItems = Nothing
		Set objWMIService = Nothing
	On Error GoTo 0
End Function

'==========================================================================
' VBScript Source File
' NAME: get-bad-hosts.vbs
' AUTHOR: Andrew J Healey
' WEB: http://halfloaded.com/
' DATE  : Dec 21 2009
' COMMENT: This script will return data in csv format for use in determining
'	hack, lockout or bad logon attempts
' PROCESS: 1) query event log for event id 529; 2) parse data to return
'	useful data; 3) output to screen
' USAGE: cscript /nologo get-bad-hosts.vbs c:\bad-hosts.csv
'==========================================================================
 
Option Explicit
On Error Resume Next
 
Dim strComputer, objWMIService, colLoggedEvents
Dim objEvent, objRegEx, colMatches, strMatch
Dim strUserName, strWorkstation, strIPAddress, strDomain
 
'Change to name of computer to query remote machine
strComputer = "."
Set objWMIService = GetObject("winmgmts:" _
    & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
 
'Event 529 in the security log are "Failure Audit" for a "Logon/Logoff"
Set colLoggedEvents = objWMIService.ExecQuery _
        ("Select * from Win32_NTLogEvent Where Logfile = 'Security' and " _
            & "EventCode = '529'")
 
'Write header to screen
wscript.echo chr(34) & "User Name" & chr(34) & "," & _
			 chr(34) & "Workstation" & chr(34) & "," & _
			 chr(34) & "Source IP" & chr(34) & "," & _
			 chr(34) & "Windows Domain" & chr(34) & "," & _
			 chr(34) & "Date/Time" & chr(34)
 
'Loop through all events matching criteria above: 529 in sec log
For Each objEvent in colLoggedEvents
	'Use regex to parse any ip addresses from event
	' if no address found, goto next record
	Set objRegEx = CreateObject("VBScript.RegExp")
	objRegEx.Global = True
	objRegEx.IgnoreCase = True
 
	'Will return the line of the user name that was used
	objRegEx.Pattern = "(\tUser Name:.*\n)"
	Set colMatches = objRegEx.Execute(objEvent.Message)
	For Each strMatch in colMatches
	   strUserName = strMatch.Value
	Next
 
	'Will return the line of the workstation name that was used
	objRegEx.Pattern = "(\tWorkstation Name:.*\n)"
	Set colMatches = objRegEx.Execute(objEvent.Message)
	For Each strMatch in colMatches
	   strWorkstation = strMatch.Value
	Next
 
	'Will return the line of the source ip address
	objRegEx.Pattern = "(\tSource Network Address:.*\n)"
	Set colMatches = objRegEx.Execute(objEvent.Message)
	For Each strMatch in colMatches
	   strIPAddress = strMatch.Value
	Next
 
	'Will return the line of the domain that was used
	objRegEx.Pattern = "\tDomain:(.*\n)"
	Set colMatches = objRegEx.Execute(objEvent.Message)
	For Each strMatch in colMatches
	   strDomain = strMatch.Value
	Next
 
	'Output clean csv line for easy reading in spreadsheet program
	wscript.echo chr(34) & GetCleanText(strUserName) & chr(34) & "," & _
				 chr(34) & GetCleanText(strWorkstation) & chr(34) & "," & _
				 chr(34) & GetCleanText(strIpAddress) & chr(34) & "," & _
				 chr(34) & GetCleanText(strDomain) & chr(34) & "," & _
				 chr(34) & WMIDateStringToDate(objEvent.TimeWritten) & chr(34)
Next
 
Private Function GetCleanText(byVal strText)
	'This will cleanup the text and return only necessary data
	' I'm sure there is a better way to do this :)
	dim tmp,txt
	tmp = Split(strText,":")
	txt = tmp(1)
	txt = Replace(txt,vbTab,"")
	txt = Replace(txt,vbCrLf,"")
	txt = Trim(txt)
	GetCleanText = txt
End Function
 
Private Function WMIDateStringToDate(byVal dtmEventDate)
	'Borrowed from the "Hey, Scripting Guy! BLOG"
	' --> Search: WMIDateStringToDate
    WMIDateStringToDate = CDate(Mid(dtmEventDate, 5, 2) & "/" & _
        Mid(dtmEventDate, 7, 2) & "/" & Left(dtmEventDate, 4) _
            & " " & Mid (dtmEventDate, 9, 2) & ":" & _
                Mid(dtmEventDate, 11, 2) & ":" & Mid(dtmEventDate, _
                    13, 2))
End Function

'==========================================================================
' VBScript Source File
' NAME: move-pst-to-network
' AUTHOR: Andrew J Healey & Nate Stevenson
' WEB: http://halfloaded.com/
' DATE  : 2010.14.2009
' COMMENT: This script will move any mapped PST files that are located on
'	local disks to a network share.
' PROCESS: 1) determine if laptop; 2) determine if outlook installed
'	3) determine local drives; 4) check for local pst's; 5) move pst's
'	to network; 6) remap pst files
'==========================================================================
 
Option Explicit
 
'Determine if a laptop (remove if you don't care)
If IsLaptop() = True Then
	wscript.echo "Computer is a laptop or the chassis could not be determined."
	wscript.echo "Exiting."
	wscript.quit
End If
 
'Determine if outlook is installed
If IsOutlookInstalled() = False Then
	wscript.echo "Could not launch Outlook."
	wscript.echo "Exiting."
	wscript.quit
End If
 
'Get user name
Dim WshNetwork : Set WshNetwork = WScript.CreateObject("WScript.Network")
Dim user : user = lcase(WshNetwork.UserName)
Set WshNetwork = Nothing
 
Dim strNetworkPath
'=========================================================================
' Configuration Section
strNetworkPath = "\\servername\homes\" & user & "\"
' End Configuration Section
'=========================================================================
'Fix network path if forgot to include trailing slash...
If Not Right(strNetworkPath,1) = "\" Then strNetworkPath = strNetworkPath & "\"
 
'Determine if network path is writable
If IsPathWritable(strNetworkPath) = False Then
	wscript.echo "Remote path is not writable."
	wscript.echo "Exiting."
	wscript.quit
End If
 
'Instatiate objects
Dim objOutlook, objNS, objFSO, objFolder
Set objOutlook = CreateObject("Outlook.Application")
Set objNS = objOutlook.GetNamespace("MAPI")
Set objFSO = CreateObject("Scripting.FileSystemObject")
 
'Sort through all stores in outlook and add all local pst
' paths into an array. Then remove the store from outlook.
Dim pstFiles
Dim count : count = -1
Dim arrPaths()
For Each objFolder In objNS.Folders
	If GetPSTPath(objFolder.StoreID) <> "" Then
		pstFiles = GetPSTPath(objFolder.StoreID)
		If IsStoredLocal(pstFiles) = True Then
			If objFSO.FileExists(strNetworkPath & Mid(pstFiles,InStrRev(pstFiles,"\") + 1)) = True Then
				wscript.echo "A pst file already exists with the same name." & vbCrLf & _
						vbTab & "Source: " & pstPath & vbCrLf & _
						vbTab & "Target: " & strNetworkPath & Mid(pstPath,InStrRev(pstPath,"\") + 1)
			Else
				count = count + 1
				ReDim Preserve arrPaths(count)
				arrPaths(count) = pstFiles
				objOutlook.Session.RemoveStore objFolder
			End If
		End If
	End If
Next
 
objOutlook.Session.Logoff
objOutlook.Quit
Set objOutlook = Nothing
Set objNS = Nothing
 
if count < 0 then
	wscript.echo "No local PST Files Found."
	wscript.quit
End If
 
'If local PST files were found, move them to the new location
' Echo output if the file already exists
Dim pstPath
For Each pstPath in arrPaths
	On Error Resume Next
		objFSO.MoveFile pstPath, strNetworkPath
		If Err.Number <> 0 Then
			wscript.sleep 5000
			objFSO.MoveFile pstPath, strNetworkPath
		End If
	Err.Clear
	On Error GoTo 0
Next
Set objFSO = Nothing
 
'Re-open outlook
Set objOutlook = CreateObject("Outlook.Application")
Set objNS = objOutlook.GetNamespace("MAPI")
 
'Re-map Outlook folders
For Each pstPath in arrPaths
	objNS.AddStore strNetworkPath & Mid(pstPath,InStrRev(pstPath,"\") + 1)
Next
 
objOutlook.Session.Logoff
objOutlook.Quit
Set objOutlook = Nothing
Set objNS = Nothing
wscript.echo "Done."
wscript.quit
 
Private Function GetPSTPath(byVal input)
	'Will return the path of all PST files
	' Took Function from: http://www.vistax64.com/vb-script/
	Dim i, strSubString, strPath
	For i = 1 To Len(input) Step 2
		strSubString = Mid(input,i,2)
		If Not strSubString = "00" Then
			strPath = strPath & ChrW("&H" & strSubString)
		End If
	Next
 
	Select Case True
		Case InStr(strPath,":\") > 0
			GetPSTPath = Mid(strPath,InStr(strPath,":\")-1)
		Case InStr(strPath,"\\") > 0
			GetPSTPath = Mid(strPath,InStr(strPath,"\\"))
	End Select
End Function
 
Private Function IsLaptop()
	'Determine if the computer is a mobile machine
	On Error Resume Next
		'Instantiate objects
		Dim objWMIService, colChassis, objChassis, strChassisType
		Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
		Set colChassis = objWMIService.ExecQuery("Select * from Win32_SystemEnclosure")
 
		'Check chassis type
		'http://msdn.microsoft.com/en-us/library/aa394474%28VS.85%29.aspx
		For Each objChassis in colChassis
			For  Each strChassisType in objChassis.ChassisTypes
				If (strChassisType >= 8 And strChassisType <=12) Or (strChassisType = 14) Then
					IsLaptop = True
					Exit For
				Else
					IsLaptop = False
				End If
			Next
		Next
	If Err.Number <> 0 Then IsLaptop = False
	On Error GoTo 0
	Set colChassis = Nothing
	Set objWMIService = Nothing
	objChassis = Null
End Function 
 
Private Function IsOutlookInstalled()
	'Function will return false if unable to launch outlook
	' This adds some overhead but it is ultimately the best
	' way to truly determine if script will function properly.
	On Error Resume Next
		Set objOutlook = CreateObject("Outlook.Application")
		If Err.Number <> 0 Then
			IsOutlookInstalled = False
			Exit Function
		End If
	On Error GoTo 0
	IsOutlookInstalled = True
	objOutlook.Session.Logoff
	objOutlook.Quit
	Set objOutlook = Nothing
End Function
 
Private Function IsPathWritable(byVal strPath)
	'Check to make sure the path is writable. If it is not, no
	' need to continue processing.
	On Error Resume Next
		Set objFSO = CreateObject("Scripting.FileSystemObject")
		Dim min : min = 1
		Dim max : max = 1000
		Dim rand : rand = Int((max - min + 1) * Rnd + min)
		Dim fullFileName : fullFileName = strPath & "temporary-" & rand & ".txt"
		Dim objFile : Set objFile = objFSO.CreateTextFile(fullFileName, True)
		objFile.WriteLine("Test file creation of " & fullFileName)
		objFile.Close
		If objFSO.FileExists(fullFileName) Then
			IsPathWritable = True
			objFSO.DeleteFile(fullFileName)
		Else
			IsPathWritable = False
		End If
	If Err.Number <> 0 Then IsPathWritable = False
	On Error GoTo 0
	Set objFile = Nothing
	Set objFSO = Nothing
	rand = Null
	max = Null
	min = Null
	fullFileName = Null
End Function
 
Private Function IsStoredLocal(ByVal fullFileName)
	'Check if the PST is stored locally or on a mapped or removable drive
	On Error Resume Next
		Dim objDisk, objWMIService, colDisks
		Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
		Set colDisks = objWMIService.ExecQuery("SELECT * FROM Win32_LogicalDisk")
		For Each objDisk in colDisks
			If objDisk.DriveType = 3 Then
				If InStr(fullFileName,objDisk.DeviceID) > 0 Then
					IsStoredLocal = True
					Exit For
				Else
					IsStoredLocal = False
				End If
			End If
		Next
	If Err.Number <> 0 Then IsLocalDrive = False
	On Error GoTo 0
End Function

'==========================================================================
' VBScript Source File
' NAME: Active Directory Admin Audit
' AUTHOR: Andrew J Healey
' DATE  : 2009.04.16
' COMMENT: This script will check all the domains within a forest
'		and report all the members of the following groups: Schema
'		Admins, Enterprise Admins and Domain Admins. See notes to
'		expand on the groups.
'==========================================================================

'Define Constants
Const adUseClient = 3
Const ForWriting = 2
 
'Set the path and filename for the dump of sensitive users
'  Folder must exist!
fileTemp = "C:\AD Admin Audit.txt"
 
'Create tmp file and report file
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objTempFile = objFSO.OpenTextFile(fileTemp, ForWriting, True)
 
'Query RootDSE and return array with all AD domains in forest
Set adoComm = CreateObject("ADODB.Command")
Set adoConn = CreateObject("ADODB.Connection")
adoConn.Provider = "ADsDSOObject"
adoConn.cursorLocation = adUseClient
adoConn.Open "Active Directory Provider"
adoComm.ActiveConnection = adoConn
 
Set objRootDSE = GetObject("LDAP://RootDSE")
strBase   =  "<GC://" & objRootDSE.Get("rootDomainNamingContext") & ">;"
strFilter = "(objectcategory=domainDNS);"
strAttrs  = "distinguishedName;"
strScope  = "subtree"
 
strQuery = strBase &amp; strFilter &amp; strAttrs &amp; strScope
adoComm.CommandText = strQuery
adoComm.Properties("Page Size") = 50
adoComm.Properties("Timeout") = 30
adoComm.Properties("Cache Results") = False
 
Set adoRS = adoComm.Execute
 
'Start Loop
Do Until adoRS.EOF
	'Parse ad search results to create well formed DNS domain
	strDomain = Replace(adoRS.Fields(0).Value,"DC=","")
	strDomain = Replace(strDomain,",",".")
	Call GrpAll(strDomain)
	adoRS.MoveNext
Loop
adoRS.Close
adoConn.Close
wscript.quit
 
Function GrpAll(x)
	'To search for more groups, edit the "strFilter" line. It uses a simple
	' LDAP or (|) so multiple groups can be added. It uses ADO record sets
	' to loop so it doesn't have to find all of them, just one. Every domain
	' will contain at least the Domain Admins group.
	Set adoCommand = CreateObject("ADODB.Command")
	Set adoConnection = CreateObject("ADODB.Connection")
	adoConnection.Provider = "ADsDSOObject"
	adoConnection.cursorLocation = adUseClient
	adoConnection.Open "Active Directory Provider"
	adoCommand.ActiveConnection = adoConnection
 
	strBase   = ";"
	strFilter = "(&amp;(objectCategory=group)(|((name=Enterprise Admins*)" &amp; _
				"(name=Domain Admins*)(name=Schema Admins*))));"
	strAttrs  = "name,member;"
	strScope  = "subtree"
 
	strQuery = strBase &amp; strFilter &amp; strAttrs &amp; strScope
	adoCommand.CommandText = strQuery
	adoCommand.Properties("Page Size") = 5000
	adoCommand.Properties("Timeout") = 30
	adoCommand.Properties("Cache Results") = False
 
	Set adoRecordset = adoCommand.Execute
 
	objTempFile.WriteLine "Group report for domain: " &amp; x
 
	adoRecordset.MoveFirst
 
	Do Until adoRecordset.EOF
	    objTempFile.WriteLine vbTab &amp; adoRecordset.Fields(0).Value
		For Each strMember in adoRecordset.Fields(1).Value
			objTempFile.WriteLine vbTab &amp; vbTab &amp; strMember
		Next
	    adoRecordset.MoveNext
	Loop
 
	adoRecordset.Close
	adoConnection.Close
End Function

strFolder = "C:\Folder\"
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace(strFolder)
Set objFSO = CreateObject("Scripting.FileSystemObject")
 
For Each strFileName in objFolder.Items
    If len(objFSO.GetExtensionName(strFileName)) > 0 Then
        Set objFile = objFSO.GetFile(strFolder & strFileName.Name)
        If DateDiff("N",objFile.DateLastModified,Now()) > 59 Then
            objFSO.DeleteFile(strFolder & strFileName.Name),True
        End If
    End If
Next