'Dependencies
' BrowseListFilter.wsc (Requires support tools)
' regobji.exe (installed)

Option Explicit
Dim g_strScriptPath, SnareVersion, InstallLocation, InstallKey, OpKey, g_objShell, intError
Dim ConfigAudit, ConfigChecksum, ConfigClientname, ConfigCritAudit, ConfigDelimiter, ConfigFileAudit, ConfigFileExport, NetworkDestination, NetworkDestPort, NetworkSyslog, NetworkSyslogDest, NetworkSyslogDynamicCritic, RemoteAccessKey, RemoteAccessKeySet, RemoteAllow, RemoteRestrict, RemoteRestrictIP, RemoteWebPort, RemoteWebPortChange, StatusApp, StatusSys, StatusSec, StatusDNS, StatusDS, StatusFRS
Dim intObjCount : intObjCount = 0
Dim getObj : getObj = 0
Dim Objective(20)

Set g_objShell = WScript.CreateObject("WScript.Shell")

InstallKey = "HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\Snare_is1\"
OpKey = "HKLM\SOFTWARE\InterSect Alliance\AuditService\"

InstallLocation		= g_objShell.RegRead(InstallKey & "InstallLocation")
SnareVersion		= g_objShell.RegRead(InstallKey & "DisplayVersion")

on error resume next
ConfigAudit		= g_objShell.RegRead(OpKey & "Config\" & "Audit")
ConfigChecksum		= g_objShell.RegRead(OpKey & "Config\" & "Checksum")
ConfigClientname	= g_objShell.RegRead(OpKey & "Config\" & "Clientname")
ConfigCritAudit		= g_objShell.RegRead(OpKey & "Config\" & "CritAudit")
ConfigDelimiter		= g_objShell.RegRead(OpKey & "Config\" & "Delimiter")
ConfigFileAudit		= g_objShell.RegRead(OpKey & "Config\" & "FileAudit")
ConfigFileExport	= g_objShell.RegRead(OpKey & "Config\" & "FileExport")
NetworkDestination	= g_objShell.RegRead(OpKey & "Network\" & "Destination")
NetworkDestPort		= g_objShell.RegRead(OpKey & "Network\" & "DestPort")
NetworkSyslog		= g_objShell.RegRead(OpKey & "Network\" & "Syslog")
NetworkSyslogDest	= g_objShell.RegRead(OpKey & "Network\" & "SyslogDest")
NetworkSyslogDynamicCritic = g_objShell.RegRead(OpKey & "Network\" & "SyslogDynamicCritic")
RemoteAccessKey		= g_objShell.RegRead(OpKey & "Remote\" & "AccessKey")
RemoteAccessKeySet	= g_objShell.RegRead(OpKey & "Remote\" & "AccessKeySet")
RemoteAllow		= g_objShell.RegRead(OpKey & "Remote\" & "Allow")
RemoteRestrict		= g_objShell.RegRead(OpKey & "Remote\" & "Restrict")
RemoteRestrictIP	= g_objShell.RegRead(OpKey & "Remote\" & "RestrictIP")
RemoteWebPort		= g_objShell.RegRead(OpKey & "Remote\" & "WebPort")
RemoteWebPortChange	= g_objShell.RegRead(OpKey & "Remote\" & "WebPortChange")
StatusApp		= g_objShell.RegRead(OpKey & "Status\" & "LOG_TYPE_APPLICATION")
StatusSys		= g_objShell.RegRead(OpKey & "Status\" & "LOG_TYPE_SYSTEM")
StatusSec		= g_objShell.RegRead(OpKey & "Status\" & "LOG_TYPE_SECURITY")
StatusDNS		= g_objShell.RegRead(OpKey & "Status\" & "LOG_TYPE_DNS")
StatusDS		= g_objShell.RegRead(OpKey & "Status\" & "LOG_TYPE_DS")
StatusFRS		= g_objShell.RegRead(OpKey & "Status\" & "LOG_TYPE_FRS")
on error goto 0
do while getObj = 0
	on error resume next
	Objective(intObjCount) = g_objShell.RegRead(OpKey & "Objective\" & "Objective" & intObjCount)
	intError = Err
	on error goto 0
	If intError Then
		intObjCount = intObjCount - 1
		getObj = 1
	else
		intObjCount = intObjCount + 1
	End If
	if intObjCount = 20 then getObj = 1
Loop

g_strScriptPath = Left(wscript.ScriptFullName,instrrev(wscript.ScriptFullName,"\"))

Const g_intNewThread = 50
Const rvString = 1
Const rvLong = 4
Dim g_objArgs, g_objText, g_objFSO
Dim g_OutFile : g_OutFile = "logs/SnareInstall-"
Set g_objFSO = CreateObject("Scripting.FileSystemObject")
Set g_objArgs = WScript.Arguments

If g_objArgs.Count = 0 Then
	PrintList(ServerList())
elseif g_objArgs.Count = 1 and g_objArgs(0) = "go" Then
	ThreadCollect(ServerList())
elseif g_objArgs.Count = 2 Then
	if not g_objFSO.FolderExists("logs") then
		g_objFSO.createfolder "logs"
	end if
	g_OutFile = g_OutFile & UCase(g_objArgs(1)) & ".log"
	Set g_objText = g_objFSO.OpenTextFile(g_OutFile, 8, True)
	SnareInit g_objArgs(0), UCase(g_objArgs(1))
else
	wscript.echo "Invalid command"
	wscript.quit
end if

'-------------------------------

function PrintList(arrSvr)
	Dim strSvr
	for each strSvr in arrSvr
		wscript.echo strSvr
	next
end function

function ThreadCollect (arrSvr)
	Dim wshShell, objThread
	Dim strSvr
	Dim i, intFreeThread, intWait, intThreadLimit : intThreadLimit = 10	'Threadlimit must be less than 100

	Set  wshShell = CreateObject("Wscript.Shell")

	if not g_objFSO.FolderExists("tmp") then
		g_objFSO.createfolder "tmp"
	end if

	for each strSvr in arrSvr
		intWait = 0
		intFreeThread = 0
		Do While intFreeThread = 0
			if intWait > g_intNewThread then
				intThreadLimit = intThreadLimit + 1
				intWait = 0
			end if
			for i = 1 to intThreadLimit
				If Not g_objFSO.fileExists(g_strScriptPath & "tmp\Thread" & i & ".txt") Then
					set objThread = g_objFSO.CreateTextFile (g_strScriptPath & "tmp\Thread" & i & ".txt", True)
					objThread.close
					intFreeThread = 1
					intWait = 0
					wshShell.Run "cscript SnareInstaller_auto_hostlist_threaded.vbs " & i & " " & strSvr,1,0
					Exit For
				End If
			Next
			If intFreeThread = 0 Then Wscript.Sleep(1000)
			intWait = intWait + 1
		Loop
	next
end function

function SnareInit (strThread, strSvr)

	Dim objRegistry, objRemoteRegistry, objRegKey
	Dim CNameKey, CName

	' Declare Required variables
	CNameKey = "\HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\ComputerName\ActiveComputerName\"
	g_objText.Write "[START], " & strSvr & ", " & Now & ",   PreCheck." + vbcrlf

	' Create necessary scripting objects
	Set objRegistry = CreateObject("RegObj.Registry")

	g_objText.Write "[START], " & strSvr & ", " & Now & ",   Program started." + vbcrlf

	'On error Resume Next
	' Check server and create output file
	g_objText.Write "[INFO], " & strSvr & ", " & Now & ",    " & strSvr & " - checking remote connectivity." + vbcrlf
	' Ensure machine is a Windows NT computer that is currently available (Connect to Admin$ share)
	If g_objFSO.FolderExists("\\" + strSvr + "\Admin$") then
		Set objRemoteRegistry = objRegistry.RemoteRegistry(strSvr)
		Set objRegKey = objRemoteRegistry.RegKeyFromString(CNameKey)
		CName = ucase(objRegKey.Values("ComputerName").Value)
		If CName = strSvr Then
			' Supported server - Do stuff to strSvr
			g_objText.Write "[INFO], " & strSvr & ", " & Now & ",    " & strSvr & " is valid - checking installation status" + vbcrlf
			CheckSnareAgent(strSvr)
		Else
			g_objText.Write "[ERROR], " & strSvr & ", " & Now & ",   " & strSvr & " not valid, should be " & CName & " - this is a virtual server" + vbcrlf
		End If
	Else
		g_objText.Write "[ERROR], " & strSvr & ", " & Now & ",   " & strSvr & " not valid - no ADMIN$ share" + vbcrlf
	End If
	' Write the conclusion for the report
	g_objText.Write "[FINISH], " & strSvr & ", " & Now & ",  Server complete." + vbcrlf
	g_objText.Write "###########################################################################" + vbcrlf
	g_objText.Close

	'Just in case there is no thread
	on error resume next
	g_objFSO.DeleteFile g_strScriptPath & "tmp\Thread" & strThread & ".txt"
	on error goto 0
	
	' Inform that the report is finished
	' wscript.echo("Goodbye")
end function

'-------------------------------------------------------------------------'

Sub CheckSnareAgent(strSvr)
	Dim objService, ServiceKey, objWMIService, intRet, intSrv, intErr: intErr = 0
	Dim objRegistry, objRemoteRegistry, objRegKey, objKey
	
	Set objRegistry = CreateObject("RegObj.Registry")
	
	ServiceKey = "\HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Services\Snare"
	on error resume next
	Set objService = GetObject("WinNT://" & strSvr & "/Snare")
	intSrv = Err
	on error goto 0
	If intSrv = 0 Then
		' Snare Service detected OK.
		g_objText.Write "[INFO], " & strSvr & ", " & Now & ",    Agent already installed" + vbcrlf

		' Set the startup status to "Automatic"
		Set objRemoteRegistry = objRegistry.RemoteRegistry(strSvr)
		'on error resume next
		Set objRegKey = objRemoteRegistry.RegKeyFromString(ServiceKey)
		'on error goto 0
		objRegKey.Values("Start").Value = "2" 'was 3, DM changed to 2
		g_objText.Write "[INFO], " & strSvr & ", " & Now & ",    Service startup configuration set to default" + vbcrlf

		' Check current status of service - test if it is running
		If objService.Status <> 4 Then
			g_objText.Write "[ERROR], " & strSvr & ", " & Now & ",   Service was already stopped - reinstalling now" + vbcrlf
			' Install Snare agent
			InstallSnareAgent(strSvr)
		Else
			g_objText.Write "[INFO], " & strSvr & ", " & Now & ",    Service already running, stopping service to make changes" + vbcrlf
			objService.stop
			Wscript.Sleep 100
			Set objService = GetObject("WinNT://" & strSvr & "/Snare")
			If objService.Status <> 4 Then
				g_objText.Write "[INFO], " & strSvr & ", " & Now & ",    Service stopped for changes" + vbcrlf
			else
'				g_objText.Write "[ERROR], " & strSvr & ", " & Now & ",   Service not stopped, going in for the kill" + vbcrlf
'				Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strSvr & "\root\cimv2") 
'				objWMIService.Security_.Privileges.AddAsString "SeDebugPrivilege", True
'
'				Set colProcess = objWMIService.ExecQuery ("Select * from Win32_Process where name='snarecore.exe'")
'
'				For Each objProcess in colProcess
'					intRet = objProcess.Terminate()
'					if intRet = 0 then
'						g_objText.Write "[INFO], " & strSvr & ", " & Now & ",    Service has now been stopped" + vbcrlf
'					else
						g_objText.Write "[ERROR], " & strSvr & ", " & Now & ",   Service was not stopped, this server requires immediate attention" + vbcrlf
						intErr = 1
'					end if
'				Next
			end if
			if intErr = 0 then
				InstallSnareAgent(strSvr)
			end if
		End If
	Else
		g_objText.Write "[ALERT], " & strSvr & ", " & Now & ", Agent not installed on " & strSvr & " - commencing installation" + vbcrlf
		' Install Snare agent
		InstallSnareAgent(strSvr)
	End If

End Sub

'-------------------------------------------------------------------------'
Sub InstallSnareAgent(strSvr)

	'On Error Resume Next

	Dim InstallPath, objKey, objRemoteRegistry, objRegistry, objRegRootKey, intError, objService, objShell, intObj

	Set objShell    = CreateObject("WScript.Shell")
	Set objRegistry = CreateObject("RegObj.Registry")
	Set objRemoteRegistry = objRegistry.RemoteRegistry(strSvr)

	InstallPath = "\\" & strSvr & "\" & replace(InstallLocation, ":","$")
	g_objText.Write "[INFO], " & strSvr & ", " & Now & ",    " & InstallPath + vbcrlf

	' Create Installation Directory (If it doesn't already exist)
	If Not g_objFSO.FolderExists(InstallPath) Then
		newFolder = g_objFSO.CreateFolder(InstallPath)
		g_objText.Write "[INFO], " & strSvr & ", " & Now & ",    Installation directory created" + vbcrlf
	End If

	' Copy installation files - overwriting if they exist
	g_objFSO.CopyFile InstallLocation & "SnareCore.exe", InstallPath & "SnareCore.exe", True
	g_objFSO.CopyFile InstallLocation & "Readme.txt", InstallPath & "Readme.txt", True
	g_objFSO.CopyFile InstallLocation & "unins000.dat", InstallPath & "unins000.dat", True
	g_objFSO.CopyFile InstallLocation & "unins000.exe", InstallPath & "unins000.exe", True

	If g_objFSO.FileExists(InstallPath & "SnareCore.exe") Then
		g_objText.Write "[INFO], " & strSvr & ", " & Now & ",    Executable files copied" + vbcrlf

		' Delete any existing registry keys
		on error resume next
		Set objKey = objRemoteRegistry.RegKeyFromString("\HKEY_LOCAL_MACHINE\Software\InterSect Alliance")
		intError = Err
		on error goto 0
		If intError = 0 Then
			Set objRegRootKey = objKey.Parent
			objRegRootKey.SubKeys.Remove (objKey)
		End If
		on error resume next
		Set objKey = objRemoteRegistry.RegKeyFromString("\HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Uninstall\Snare_is1")
		intError = Err
		on error goto 0
		If intError = 0 Then
			Set objRegRootKey = objKey.Parent
			objRegRootKey.SubKeys.Remove (objKey)
		End If

		' Create registry new keys
		Set objKey = objRemoteRegistry.RegKeyFromString("\HKEY_LOCAL_MACHINE\Software")
		objKey.SubKeys.Add "InterSect Alliance"
		Set objKey = objRemoteRegistry.RegKeyFromString("\HKEY_LOCAL_MACHINE\Software\InterSect Alliance")
		objKey.SubKeys.Add "AuditService"
		Set objKey = objRemoteRegistry.RegKeyFromString("\HKEY_LOCAL_MACHINE\Software\InterSect Alliance\AuditService")
		objKey.SubKeys.Add "Config"
		objKey.SubKeys.Add "Network"
		objKey.SubKeys.Add "Objective"
		objKey.SubKeys.Add "Remote"
		Set objKey = objRemoteRegistry.RegKeyFromString("\HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Uninstall")
		objKey.SubKeys.Add "Snare_is1"
		g_objText.Write "[INFO], " & strSvr & ", " & Now & ",    Registry keys created" + vbcrlf

		' Set values under the Snare Config key
		Set objKey = objRemoteRegistry.RegKeyFromString("\HKEY_LOCAL_MACHINE\Software\InterSect Alliance\AuditService\Config")
		objKey.Values.Add "Audit", ConfigAudit, rvLong
		objKey.Values.Add "Clientname", ConfigClientname, rvString
		objKey.Values.Add "CritAudit", ConfigCritAudit, rvLong
		objKey.Values.Add "Delimiter", ConfigDelimiter, rvString
		objKey.Values.Add "FileAudit", ConfigFileAudit, rvLong
		objKey.Values.Add "FileExport", ConfigFileExport, rvLong
		g_objText.Write "[INFO], " & strSvr & ", " & Now & ",    Registry values set under Snare Config key" + vbcrlf

		' Set values under the Snare Network key
		Set objKey = objRemoteRegistry.RegKeyFromString("\HKEY_LOCAL_MACHINE\Software\InterSect Alliance\AuditService\Network")
		objKey.Values.Add "Destination", NetworkDestination, rvString
		objKey.Values.Add "DestPort", NetworkDestPort, rvLong
		objKey.Values.Add "Syslog", NetworkSyslog, rvLong
		objKey.Values.Add "SyslogDest", NetworkSyslogDest, rvLong
		objKey.Values.Add "SyslogDynamicCritic", NetworkSyslogDynamicCritic, rvLong
		g_objText.Write "[INFO], " & strSvr & ", " & Now & ",    Registry values set under Snare Network key" + vbcrlf

		' Set values under the Snare Objective key
		Set objKey = objRemoteRegistry.RegKeyFromString("\HKEY_LOCAL_MACHINE\Software\InterSect Alliance\AuditService\Objective")
		For intObj = 0 to intObjCount
			g_objText.Write "[INFO], " & strSvr & ", " & Now & ",     Objective" & intObj & ": " & Objective(intObj) + vbcrlf
			objKey.Values.Add "Objective" & intObj, Objective(intObj), rvString
		Next
		g_objText.Write "[INFO], " & strSvr & ", " & Now & ",    Registry values set under Snare Objective key" + vbcrlf

		' Set values under the Snare Remote key
		Set objKey = objRemoteRegistry.RegKeyFromString("\HKEY_LOCAL_MACHINE\Software\InterSect Alliance\AuditService\Remote")
		objKey.Values.Add "AccessKey", RemoteAccessKey, rvLong
		objKey.Values.Add "AccessKeySet", RemoteAccessKeySet, rvString
		objKey.Values.Add "Allow", RemoteAllow, rvLong
		objKey.Values.Add "Restrict", RemoteRestrict, rvLong
		objKey.Values.Add "RestrictIP", RemoteRestrictIP, rvString
		objKey.Values.Add "WebPort", RemoteWebPort, rvLong
		objKey.Values.Add "WebPortChange", RemoteWebPortChange, rvLong
		g_objText.Write "[INFO], " & strSvr & ", " & Now & ",    Registry values set under Snare Remote key" + vbcrlf

		' Set values under the Windows Uninstall key
		Set objKey = objRemoteRegistry.RegKeyFromString("\HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Uninstall\Snare_is1")
		objKey.Values.Add "DisplayIcon", InstallLocation & "SnareCore.exe", rvString
		objKey.Values.Add "DisplayName", "Snare version " & SnareVersion, rvString
		objKey.Values.Add "DisplayVersion", SnareVersion, rvString
		objKey.Values.Add "Inno Setup: App Path", InstallLocation, rvString
		objKey.Values.Add "Inno Setup: Icon Group", "InterSect Alliance", rvString
		objKey.Values.Add "Inno Setup: Setup Version", "5.1.6", rvString
		objKey.Values.Add "Inno Setup: User", "Security", rvString
		objKey.Values.Add "Publisher", "InterSect Alliance Pty Ltd", rvString
		objKey.Values.Add "UninstallString", InstallLocation & "unins000.exe", rvString
		objKey.Values.Add "URLInfoAbout", "http://www.intersectalliance.com/", rvString
		g_objText.Write "[INFO], " & strSvr & ", " & Now & ",    Registry values set under Windows Uninstall key" + vbcrlf

		' Create the service (Using SC.EXE)
		Set objKey = objRemoteRegistry.RegKeyFromString("\HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion")
		objShell.Run "sc \\" & strSvr & " create SNARE binPath= " & Chr(34) & InstallLocation & "SnareCore.exe" & Chr(34) & " start= auto DisplayName= SNARE ",0,1
		' ensure that the service is set to restart on failure
		objShell.Run "sc \\" & strSvr & " failure SNARE reset= 3600 actions= restart/1000",0,1
		g_objText.Write "[INFO], " & strSvr & ", " & Now & ",    Service created" + vbcrlf

		' Start the service
		Set objService = GetObject("WinNT://" & strSvr & "/Snare")
		objService.start
		g_objText.Write "[INFO], " & strSvr & ", " & Now & ",    Service started" + vbcrlf
		'msgbox ("successful install: " & strSvr)
	Else
		g_objText.Write "[ERROR], " & strSvr & ", " & Now & ", Unable to copy executable files - installation failed" + vbcrlf
		wscript.echo "FAILED install: " & strSvr
	End If

End Sub

'-------------------------------------------------------------------------'

function ServerList ()
	Dim strNameSpace, strQuery1, strDomain, strSvr
	Dim dctServers
	Dim wshNetwork
	Dim objConnection, objCommand, objRecordSet, objBaseLDAP, objCol, objBrowseList
	Dim intSvrCount  :  intSvrCount = 0

	' Bind to the root of our LDAP AD.
	Set objBaseLDAP = GetObject("LDAP://RootDSE")

	' Return the namespace text string.
	Err.Clear
	strNameSpace = objBaseLDAP.get("DefaultNamingContext")

	If Err.Number Then
		wscript.echo Err.Description
		wscript.quit
	End If
	Set objConnection = CreateObject("ADODB.Connection")
	Set objCommand = CreateObject("ADODB.Command")
	
	' Open the connection object using ADSI OLE DB provider.
	objConnection.Open "Provider=ADsDSOObject;"

	' Link the connection object to the command object's
	' ActiveConnection property.
	objCommand.ActiveConnection = objConnection

	' Build the LDAP query string...serach entire AD for computer
	' objects containing the word Server in the OS field. Return
	' the computer name of each instance found.
	strQuery1 = "<LDAP://" & strNameSpace & ">;" &_
		    "(&(objectCategory=Computer)(operatingSystem=*Server*));" &_
		    "Name,ADsPath,operatingSystem;subtree"

	' Write the query string into the command object.
	objCommand.CommandText = strQuery1

	' Run the query against AD and trap for error.
	Err.Clear
	Set objRecordSet = objCommand.Execute

	' If nothing returned then log error and quit the script.
	If objRecordSet.RecordCount = 0 Then
		wscript.echo "ERROR: No data found"
	End If

	Set dctServers = CreateObject("Scripting.Dictionary")

	' Loop the record set.
	While Not objRecordSet.EOF
		if not dctServers.Exists(objRecordSet.Fields("Name")) then
			strSvr = objRecordSet.Fields("Name")
			dctServers.Add UCase(strSvr), "Server"
		end if
		objRecordSet.MoveNext
	Wend
	' Kill the connection object.
	objConnection.Close

	set wshNetwork = CreateObject("WScript.Network")
	strDomain = UCase(wshNetwork.UserDomain)
	on error resume next
	set objBrowseList = GetObject("script:" & g_strScriptPath & "BrowseListFilter.wsc")
	if Err.Number Then
		wscript.echo "BrowseList Windows Script Component required"
		wscript.quit
	end if
	on error goto 0
	objBrowseList.Domain = strDomain
	objBrowseList.Filter = "Server"
	for each strSvr in objBrowseList.GetBrowseList
		strSvr = UCase(Replace(strSvr,"\\",""))
		if not dctServers.Exists(strSvr) then
			dctServers.Add UCase(strSvr), "Server"
		end if
	next
	'if objBrowseList.Count <= 0 then

	ServerList = dctServers.keys
End Function