'*** Check for Code Red Worm ***
'Alan Kaplan for VA VISN 6
'www.akaplan.com/tools.html
'akaplan@msdinc.com www.msdinc.com
'also alan@akaplan.com, alan.kaplan@med.va.gov
'Last revision 8/9/2001
'This program searches entire domain for evidence of Code Red worm
'and dumps information into a spreadsheet
'Good example of checking for existence of files in remote directories
'You must have rights to admin shares on workstations for this to work.
'I hope you appreciate the irony of using VBS to look for virus/worms....


option explicit
Dim wsh, objreg,objcontainer,objremote,objregkey,dnameobj
dim key,key2,major,minor,ver,quote, command,username
dim rdname, colpcs,rserver
dim logfile,comma,message,cdname,title
dim fso,appendout,ofile
dim path,nf,server, drivelist, fnd, drive


'message format helpers..
comma = ","
quote = chr(34)

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

'*********** OPTIONAL EDIT HERE ***************************
'*** Name of log file. UNC path is okay. Leave extension as CSV
'*** to have it opened by Excel.  Change to TXT
'*** if Excel not loaded on workstation running script
logfile = "c:\codered.csv"	
'*********** EDIT ENDS ***************************

'Test for ADSI and current WSH, host set to Cscript, regobj installed
'Do not comment out!

SysTest

'get resource domain name 
key = "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\Currentversion\Winlogon\CachePrimaryDomain"
RDname = wsh.RegRead (key)


' Define dialog box variables.
message = "You will overwrite the logfile " & logfile & " if it exists." &vbCrLf & vbCrLf
message = message & "Please enter domain name to search:"
title = "Search for Code Red"

'get resource domain name, domain default
CDName = InputBox(message, title, RDName)
' Evaluate the user input.
If CDName = "" Then    ' Canceled by the user
    WScript.quit
End If


'on error resume next

'setup log
'logfile is set to append.
Const ForAppend = 8
set fso = CreateObject("Scripting.FileSystemObject")

'delete old log
	if (fso.FileExists(logfile))then
	set oFile = fso.GetFile (logfile)
	oFile.Delete
end if

'create header for log
set AppendOut = fso.OpenTextFile(logfile, ForAppend, True)
appendout.writeline "Computername,Reached,Status"

'run getinfo on all computers in resource domain
'This should work with with Win2k Active directory per docs....

DnameObj = "WinNT://" & cdname		'Case counts here!
wsh.Popup "Be patient, this may take some time",3,"Ready to Query Domain",64
Set objContainer=GetObject(DnameObj)
objContainer.Filter=Array("computer")

For Each colPCs in objContainer
	rserver = "\\" & colPCs.Name
	main rserver
Next


'Done.  open file with associated app, Excel if installed.
command = "cmd.exe /c start " & logfile  
wsh.Run command
wscript.quit			'The end


'Functions and Subroutines
Sub GetInfo()	'Main Routine
on error resume next

appendout.writeline colPCs.Name & ", okay"

End Sub


Sub EchoAndLog (message)
'Subroutine to echo to screen and write to log
	wscript.echo message
'appendout is defined as part of log setup
	AppendOut.WriteLine message
End Sub  

Sub SysTest()
on error resume next
' WSH version tested
Major = (ScriptEngineMinorVersion())
Minor = (ScriptEngineMinorVersion())/10
Ver = major + minor
'Need version 5.5
	If err.number or ver < 5.5 then
	message = "You have must load Version 5.5 (or later) of Windows Script Host" &vbCrLf
End If

'Test for ADSI
err.clear
key = "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Active Setup\Installed Components\{E92B03AB-B707-11d2-9CBD-0000F87A369E}\version"
key2 = wsh.RegRead (key)
if err <> 0 then
  	message = message & "ADSI must be installed on local workstation to continue" & vbCrLf
wsh.Popup message,0,"Workstation Setup Error",vbCritical
	WScript.Quit
	End if
	


'Test whether the host is CScript.exe.
'G. Born code...

If IsBatch = "TRUE" Then
If (Not IsCScript()) Then
    message = "You must set default host to cscript to run as a batch." &vbcrlf &_
	"Use the command wscript //h:cscript"	'popup closes to avoid desktop hell
	wsh.Popup message,3,"Workstation Setup Error",vbCritical
    WScript.Quit            ' Terminate script.
	End If
End if
End Sub 


Function IsCScript()
    ' Check whether CScript.exe is the host.
    If (InStr(UCase(WScript.FullName), "CSCRIPT") <> 0) Then
        IsCScript = True
    Else
        IsCScript = False
    End If
End Function



Sub main (server)
nf = 0
fnd = 0
err.clear

'check to see if you can reach hidden shares
check server & "\admin$\system32\cmd.exe"

if nf = 1 then
		echoandlog server & ",not reached"
		exit sub
	else
fnd = 0
End IF


drivelist = array("c","d","e")
for each drive in drivelist
	check server & "\" & drive & "$\inetpub\scripts\root.exe"
	check server & "\" & drive & "$\progra~1\common~1\system\MSADC\root.exe"
	check server & "\" & drive & "$\explorer.exe"
next



if fnd > 0 then
Wsh.Popup "Found Evidence of Code Red on " & server &vbcrlf & "Information in log",5,"Holy Crap!",16
		echoandlog server & ",reached,Infected"
	else
		echoandlog server & ",reached,Clean"
End IF

End Sub



sub check (path)
on error resume next
Set ofile = fso.Getfile(path)

'set found/not found 

if err then 
	nf = nf +1
 Else
	fnd = fnd +1
End if

err.clear

end sub

'*** Script Ends ***