Cyber Threat Scanner

You never know when you’ll be called upon to do an immediate scan of your systems for known intrusive files. Even with the best maintained and accurate antivirus applications running, there is always a possibility of something getting through. In general, antivirus updates are only as current as known viruses. Unfortunately, fixes are not available until shortly after a new intrusion has been discovered. So someone is bound to be the unwitting recipient of an attack or intrusion.

I'm sure that most of us have very secure systems and might have never had an intrusion beyond the occasional desktop virus triggered by a user opening an enticing email or downloading questionable files over the Internet. Of course we administrators are ever mindful of such events and help keep our systems safe by avoiding being logged on as administrators when performing non-administrative tasks such as opening our mail and accessing the Internet.

In any event, there is a vital need to have a system in place that can scan your computer systems at a moment’s notice for intrusive files that might have entered your systems via virus attack, worms, hackers, malware, or other means. In many businesses nowadays, there is also the need to comply with security initiatives that require us to scan for specific files on occasion even if we have not necessarily experienced problems. Aside from a very resource-intensive effort to have the IT staff frantically perform manual scans of all systems, not much is available with the major Windows systems that allow you to run these scans easily and effectively across an entire domain.

The Application

I created the Cyber Threat Scanner, which wraps two third-party utilities within a VBScript. I made the choice to use these utilities instead of pure VBScript simply to overcome the lengthy processing time that would be involved if the application were written purely in VBScript.

The first utility is a freeware package from Mythicsoft called Agent Ransack, which is the search engine beneath the Cyber Threat Scanner application's hood that scans for the files you'e looking for. You can download Agent Ransack at www.mythicsoft.com/agentransack/Page.aspx?page=download. The second utility is a public domain utility called MD5deep, which can produce MD5 hashes of files and can perform hash comparisons of the files against a list of known intrusive file hashes. You can download MD5deep.exe at md5deep.sourceforge.net/ .

To actually make this application function quickly and scan many systems at the same time it was necessary to make it a multithreaded application. This is not a true multithreaded application by definition but rather a pseudo-multithreaded application that calls a secondary script multiple times. This secondary script is what actually performs the search activity against multiple servers—and because all the secondary scripts run simultaneously, it’s loosely considered to be multithreaded.

This is an extremely sensitive and important process, and with that comes a good bit of preparation before running the main VBScript file. You must:

To make this preparation process more streamlined and less stressful, I also created an HTML Application (HTA) called CyberScanPrep.hta that ties these preparation requirements together.Figure 1 is a snapshot of what the prep application looks like, complete with the general Help screen that the application provides. Additionally, each of the individual input areas offers detailed context-sensitive help about the specific entry.

Entering Information

In most cases, you’ll be provided with filenames and associated MD5 hashes of the intrusive files by your security department or management. When hash strings of intrusive files are provided, you can precisely determine whether a file that has the same name of an intrusive file is actually an intrusive file or not and greatly reduce the amount of work you have to perform after the scan is done. I have, however, left the application open to the possibility that you might simply need to search for files without hashes, in which case you would simply check a check box within the prep application. However, this is not the norm; you should, in most cases if not all, receive hash strings with the request to search for particular cyber threat files.

The first input box in the prep application is designed to hold the 32-character hash strings and associated filenames. To avoid mistakes and to overstate the obvious, you should always copy and paste the strings from a document that you received from security or management. After pasting a hash string, add two blank spaces and enter the associated filename. If you have more than one hash string to enter make sure you use a carriage return after each entry and then enter the next one. Continue to do this until you have entered all the hash strings.

Keep in mind that this application is limited to searching for a maximum of nine files (the maximum allowed by the free version of Agent Ransack). I personally have never had to search for more than just a few, but should you be confronted with a request to search for more than nine files, you should have another person set up this application on another machine and run the process to search for the additional files.

If for whatever reason you do not receive hash strings with the list of files to search for, make sure you put a check mark in the Do not use HashList check box. It's important to note that checking or clearing the check box determines whether the application performs a hash check against files found and the hash strings contained within the HashList.txt file. If a hash file is used, only files found that have matching hashes will be considered “Found” intrusive files.

Entering Regular Expressions

The second input box is for the list of files you want to search for. Agent Ransack allows for a great deal of flexibility when searching for files letting you enter regular expressions of the files you're looking for. For those with experience with regular expressions, this should be pretty straightforward. Just enter a regular expression for each file you want to search for. Remember that you're limited to nine entries.

For those not experienced with entering regular expressions, take a look at the example that is just above the input box. You’ll see that it starts with a caret character, followed by an open parenthesis, the filename, a forward slash, a period, the file extension, a closing parenthesis, and the dollar sign.v

The main points to understand here are:

For the most part you'll be asked to look for specific filenames, so you won’t have to have an extensive knowledge of regular expressions. Simply follow the example of entering caret, parenthesis, filename, backslash, period, file extension, close parenthesis, and dollar sign. If you do have to come up with a more complex regular expression, you can launch AgentRansack.exe and use the “Expression Builder” to establish the correct regular expression.

The next entry on the prep application requires that you create a server list. Then click the radio button indicating that you have done so.

Finally, click Perform readiness check. If you have not completed the required preparation, you'll be alerted as to what you need to do. If you have completed the preparation, you'll receive an All Set notification and you can then run the main VBScript file (MultiThreadSearch.vbs) which .Web Listing 1 shows. I don't run the scan directly from the prep application for two reasons. First, HTAs aren't well behaved when they run long processes; they are like blobs on the screen that you can't do anything with until the process completes. Second, I prefer to do a last-minute spot check of key files before launching the MultiThreadSearch script. The prep app takes care of creating the HashList.txt file that contains the hash strings and it also takes care of creating the SearchList.txt file that contains the regular expressions Agent Ransack will use.

The default multithread setting is 20, meaning it will scan up to 20 servers at a time. You can easily change this setting by editing MultiThreadSearch.vbs and adjusting the TotalThreads variable. Keep this number between 15 and 30.

The application is designed to use and create all the necessary files within one parent folder. So be sure you create an appropriate folder and copy all the downloadable files from this article into that folder. You must also download and copy AgentRansack.exe and MD5deep.exe into this same folder before running the MultiThreadSearch.vbs script.

The Process

The first phase of the process uses Agent Ransack to produce log files of files found on every drive of every server contained within the ServerList.txt file. It writes these log files to the RansackLogs folder. If one or more files is found on a server that matches the search criteria (regular expression) contained within the SearchList.txt file, the log file will have a size greater than zero. If no files are found, the log file will have a file size of zero.

The second phase steps through each of the Agent Ransack-produced log files (those with file size greater than zero), reads the filename within the text file and runs the MD5deep utility to produce a hash for the file found, compares that with the hash strings within the HashList.txt file, and writes the file size, hash string, and the filename to a hash results log file in the HashLogs folder if a matching hash string is found.

After all the Agent Ransack log files have been read and all the hash results log files have been written, the final stage of the process reads all the hash results logs, compiles all the data found within the hash results logs, and produces the Results.txt file. This is the file you'll use to determine if any intrusive files were found. If files are found, the results text files will show the server and complete paths of the files in question.

When the process finishes it creates .sav files of all significant files involved. These are copies of major contributing setup files involved with the search. A copy of the following files will be made with a .sav extension:

When the main process is run again to do a new search, the .sav files are moved to archive folders along with the major log files from the HashLogs folder and the RansackLogs folder that were produced from the previous run, in effect producing archives of all your scans.

The archive folders are named with specific dates that coincide with the original run date. When you're considering how to construct your list of servers to scan, you can create your own ServerList.txt file or you can create a server list automatically by running another utility script I created called CreateServerList.vbs, which .Web Listing 2 shows.

It's important to note that the ServerList.txt file produced by this script will:

The CreateServerList.vbs file will also produce a file called NoPingResponseServers.txt, which will contain any servers that could not be pinged. These servers will not be included in the ServerList.txt file. The main process (MultiThreadSearch.vbs) will also produce an ErrorFile.txt file; if any servers cannot be accessed via the script, they will be written to this file.

If you’d rather not use the prep application, it's import to note that you'll need to pay particular attention to the MD5batch.cmd file and edit it appropriately before you begin the search. The cmd file includes clear comments on which line needs to be open and which line needs to be commented out. Basically, the command file can produce an output file containing the hash string of any file passed to it. However, the cmd file contains one command that will compare the hash of a given file with a list of given hashes contained within the HashList.txt file. The cmd file also contains another command that will not compare the hash with the HashList.txt file. You can use only one of these command lines; the other must be commented out.

If the MD5batch.cmd file is set to use the HashList.txt file, be sure that you remove any previous hashes and enter the new hash or hashes into the HashList.txt file. Each hash line must start with the 32-character hash and be followed by two spaces and the filename that is associated with that hash.

Note that If you specify that you want to use a HashList.txt file within the MD5deep.cmd file, the Results.txt file will contain only file information of files that have matching hash strings. In other words, even if you find a matching filename, if the hashes don’t match, you'll not see it reported in the Results.txt file. If you do not specify that you want to use the HashList.txt file, hash strings will appear in the Results.txt file for all files found matching the filename search criteria.

If you decide not to use the prep application, you'll also need to manually create the SearchList.txt file. This file will contain the list of filenames that you want to search for; they must be expressed in the form of regular expressions. Remember, there’s a limitation of nine entries.

Depending on the machine you run the solution on and how many threads you want to spawn at one time, this application could be very resource and process intensive. You might want to set it up to run on a more powerful segregated computer. Also, be aware that the application could run for a very long time depending on how many servers you have, how many files were found, and the size of the files found.

I hope you won’t have to use this application very often. However, if you do, I’m certain that it will help make the experience more tolerable and your day at work a whole lot less stressful.

Web Listing 1
MultiThreadSearch.vbs

'*******************************************************************
 ****************************************************** 
 '***       !!!READ THIS BEFORE RUNNING THIS SCRIPT!!! 
'***
'*** MultiThreadSearch.vbs - Jim Turner - Multi-threaded app to search 
 for Cyber Threat files or any files for that matter. 
'***
'*** You must perform some prep work before running this! 
'***
'*** Set the number of Threads you want to run at one time by modifying 
 the TotalThreads variable value. 
'***
'*** The quickest and easiest way to do the prep work before running this 
 script is to run the CyberScanPrep.hta
'*** When you have all of the data entered you can Perform the Readiness 
 Check.  When you receive the 'All Set' message
'*** you can then run this script. 
'************************************************************************
 *************************************************
CONST ForReading = 1
CONST ForWriting = 2
On Error Resume Next

TotalThreads = 20

'*** Check for existance of MD5Deep application
CheckDeep = "md5deep.exe -help"
Set ShellCheck = CreateObject("WSCript.shell")
ShellCheck.Run CheckDeep,2
If Err.number  0 Then
 Msgbox "MD5Deep.exe is not in your PATH... Terminating script!" 
 Wscript.Quit
End If

'*** This was originally set to test if agentransack.exe was present
'*** However, it opens a splash window if the application is present. 
'*** It does Not effect this application, but it could cause some 
 confusion. 
'CheckSack = "agentransack.exe -h"
'Set ShellCheck = CreateObject("WSCript.shell")
'ShellCheck.Run CheckSack,2
'If Err.number  0 Then
' Msgbox "AgentRansack.exe is not in your PATH... Terminating script!" 
' Wscript.Quit
'End If

path = WScript.ScriptFullName : path = Left(path,InstrRev(path,"")) 

Set FSO1 = CreateObject("Scripting.FileSystemObject")

If Not FSO1.FileExists(Path & "serverlist.txt") Then
 Msgbox "ServerList.txt cannot be found... Terminating script!" 
 Wscript.Quit
End If

'*** If MD5batch.cmd file is set to use Hashlist.txt
'*** Check to make sure HashList.txt exists
Set MD5cmdFile = FSO1.OpenTextFile("MD5batch.cmd",ForReading,False) 

cmdlist = MD5cmdFile.ReadAll
MD5cmdFile.Close
MD5cmdArray = Split(cmdList,VBCRLF) 

For Each cmdItem In MD5cmdArray
 If Trim(cmdItem)  "" Then
  If Instr(Ucase(cmdItem),"REM") = 0 Then
   If Instr(Ucase(cmdItem),"HASHLIST.TXT")  0 Then
    If Not FSO1.FileExists(Path & "Hashlist.txt") Then
     Msgbox "HashList.txt cannot be found... Terminating script!" 
     Wscript.Quit
    End If
   End If
  End If
 End If
Next

'*** AgentRansack has limit of 9 regular expressions in its search
'*** Terminate process if more than 9 exist
Set SearchListFile = FSO1.OpenTextFile("SearchList.txt",ForReading,False) 

Srchlist = SearchListFile.ReadAll
SearchListFile.Close
SrchListArray = Split(SrchList,VBCRLF) 
SrchCount = 0

For Each SrchItem In SrchListArray
 If Trim(SrchItem)  "" Then
  If Left(SrchItem,1)  ";" Then
   SrchCount = SrchCount + 1
  End If
 End If
Next

If SrchCount > 9 Then
 Msgbox "Too Many Regular Expressions in SearchList.txt... Limit of 9 
 uncommented regular expressions.  Terminating Script!" 
 Wscript.Quit
End If

If SrchCount = 0 Then
 Msgbox "No Regular Expressions in SearchList.txt. You must have at least 
 one... Terminating Script!" 
 Wscript.Quit
End If

'*** Set up temp db for sorting results list later on
Set DRS = CreateObject("ADODB.Recordset")
DRS.Fields.Append "Size",201,256,adFldIsNullable
DRS.Fields.Append "Hash",201,256,adFldIsNullable
DRS.Fields.Append "File",201,256,adFldIsNullable
DRS.Open

'*** Set up error listing file to capture general errors. 
Set ErrorFile = FSO1.CreateTextFile(Path & "ErrorFile.txt",True) 
ErrorFile.Close

'*** Setup Archive folder to store Previous Run Data
'*** If RansackLogs and or HashLogs Folders exists rename them and move 
 them To Archive folder
If Not FSO1.FolderExists(Path & "Archive") Then
 Set newfolder = FSO1.CreateFolder(Path & "Archive")
End If

ArcDateFolder = ""
If FSO1.FolderExists(Path & "RansackLogs") Then
 Set objFolder = FSO1.GetFolder(Path & "RansackLogs")
 FolderDate = objFolder.DateCreated
 DateTime = Replace(FolderDate,"/","-") 
 DateTime = Replace(DateTime,":","-") 

 ArcDateFolder = Path & "ArchiveArchive" & DateTime
 Set newfolder = FSO1.CreateFolder(ArcDateFolder) 

 NewFolder2 = Path & "RansackLogs" & DateTime
 FSO1.MoveFolder Path & "RansackLogs",NewFolder2  'Rename
 FSO1.MoveFolder NewFolder2, ArcDateFolder & ""'Move

'*** Move previous run settings files to Archive
 If FSO1.FileExists(Path & "SearchList.sav") Then
  FSO1.MoveFile Path & "*.sav",newfolder
 End If

End If

FolderDate = ""
DateTime = ""

If FSO1.FolderExists(Path & "HashLogs") Then
 Set objFolder = FSO1.GetFolder(Path & "HashLogs")
 FolderDate = objFolder.DateCreated
 DateTime = Replace(FolderDate,"/","-") 
 DateTime = Replace(DateTime,":","-") 
 NewFolder1 = Path & "HashLogs" & DateTime
 FSO1.MoveFolder Path & "HashLogs",NewFolder1
 FSO1.MoveFolder NewFolder1, ArcDateFolder & ""
End If

'*** Create Log folders
If Not FSO1.FolderExists(Path & "RansackLogs") Then
 Set newfolder = FSO1.CreateFolder(Path & "RansackLogs")
End If

If Not FSO1.FolderExists(Path & "HashLogs") Then
 Set newfolder = FSO1.CreateFolder(Path & "HashLogs")
End If

set SeverListFile = FSO1.OpenTextFile("serverlist.txt")

Srvlist = SeverListFile.ReadAll
SeverListFile.Close
SrvListArray = Split(SrvList,VBCRLF) 

For Each SrvItem In SrvListArray
 If Trim(SrvItem)  "" Then
  ThreadAvailable = False
  Do Until ThreadAvailable = True
   Set Processes = GetObject("winmgmts:\.rootcimv2").ExecQuery("Select 
 * From Win32_Process Where name ='cscript.exe'")
   If Processes.Count     cmd1 = "cscript.exe Ransack-It.vbs " & SrvItem
    Set Shell1 = CreateObject("WSCript.shell")
    Shell1.Run cmd1,2
    ThreadAvailable = True
   Else
    Wscript.Sleep 5000
   End If
   set Processes = Nothing
  Loop
 End If
Next

'*** Wait until all cscript tasks are complete
ThreadsDone = False
Do Until ThreadsDone
 Set Processes = GetObject("winmgmts:\.rootcimv2").ExecQuery("Select * 
 from Win32_Process Where name ='cscript.exe'")
 If Processes.Count = 0 Then
  ThreadsDone = True
 Else
  Set Processes = Nothing
  Wscript.Sleep 5000
 End If
Loop

'*** Read Log files and run Hash-It process for each file found in 
 Ransack log files
DataPath = Path & "RansackLogs"
Set objFolder = FSO1.GetFolder(DataPath) 
number = 0
For Each objFile In objfolder.Files
 Linearray = ""
 FilePath = DataPath & objFile.Name
 If objfile.size  0 Then
  Set fsoRead = fso1.OpenTextFile(FilePath,ForReading,False) 
  Ransackinfo = fsoRead.ReadAll
  fsoRead.Close
  LineArray = Split(Ransackinfo,VBCRLF) 
  For Each line in LineArray
   If Trim(line)  "" Then
    FieldArray = Split(Line,VBTab) 
    RansackFile = FieldArray(0) 

    ThreadAvailable = False
    Do Until ThreadAvailable = True
     Set Processes = 
 GetObject("winmgmts:\.rootcimv2").ExecQuery("Select * From 
 Win32_Process Where name ='cscript.exe'")
     If Processes.Count       number = number + 1
      Num = cstr(number) 
      cmd1 = "cscript.exe Hash-It.vbs " & " " & Chr(34) & RansackFile & 
 Chr(34) & " " & Num
      Set Shell1 = CreateObject("WSCript.Shell")
      Shell1.Run cmd1,2
      ThreadAvailable = True
     Else
      Wscript.Sleep 1000
     End If
     Set Processes = Nothing
    Loop
   End If
  Next
 End If
Next

'*** Wait until all cscript tasks are complete
ThreadsDone = False
Do Until ThreadsDone
 Set Processes = GetObject("winmgmts:\.rootcimv2").ExecQuery("Select *
  from Win32_Process Where name ='cscript.exe'")
 If Processes.Count = 0 Then
  ThreadsDone = True
 Else
  Set Processes = Nothing
  Wscript.Sleep 5000
 End If
Loop

'*** Go Thru HashLogs and write data to text file. 
'*** Note, if HashList.txt is used, many of the hashlist log files will 
 contain no data. 

Set OutPutFile = FSO1.OpenTextFile(Path & "Results.txt",ForWriting,True) 
OutPutFile.WriteLine "File Size" & Space(3) & "Hash" & Space(30) & "File 
 Path"
HashPath = Path & "HashLogs"
Set objFolder = FSO1.GetFolder(HashPath) 
For Each objFile In objfolder.Files
 FilePath = HashPath & objFile.Name
 If objfile.size  0 Then
  Set fsoRead = fso1.OpenTextFile(FilePath,ForReading,False) 
  Hashinfo = fsoRead.Readline
  FileSize = Left(Hashinfo,12) 
  Hash = Mid(Hashinfo,13,32) 
  FileString = Mid(Hashinfo,47,Len(Hashinfo)-46) 
  If Trim(Hashinfo)  "" Then
   '*** Write data to temp db - then sort data for output to results.txt
  file
   DRS.AddNew
   DRS("Size") = FileSize
   DRS("Hash") = Hash
   DRS("File") = FileString
   DRS.Update
  End If
  fsoRead.Close
 End If
Next

'*** To Sort by File and then Hash
'DRS.Sort = "File ASC,Hash ASC"

'*** To Sort by Hash and then File
DRS.Sort = "Hash ASC,File ASC"

If DRS.RecordCount > 0 Then
 DRS.MoveFirst
End If
Do while Not DRS.EOF
 SizeStr = DRS.Fields.Item("Size")
 HashStr = DRS.Fields.Item("Hash")
 FileStr = DRS.Fields.Item("File")
 OutPutFile.WriteLine SizeStr & hashstr & "  " & filestr
 DRS.MoveNext 
  Loop

OutPutFile.Close
DRS.Close

'*** Copy settings files to .sav files
'*** These will be moved to a specific archive when process is run for a 
 new scan
Const OverwriteExisting = True
FSO1.CopyFile Path & "Results.txt",Path & "Results.sav",OverwriteExisting
FSO1.CopyFile Path & "md5batch.cmd",Path & 
 "md5batch.sav",OverwriteExisting
FSO1.CopyFile Path & "HashList.txt",Path & 
 "HashList.sav",OverwriteExisting
FSO1.CopyFile Path & "SearchList.txt",Path & 
 "SearchList.sav",OverwriteExisting
FSO1.CopyFile Path & "ServerList.txt",Path & 
 "ServerList.sav",OverwriteExisting
FSO1.CopyFile Path & "ErrorFile.txt",Path & 
 "ErrorFile.sav",OverwriteExisting

CreateObject("WScript.Shell").Run "Notepad " & Path & "Results.txt"

Web Listing 2
CreateServerList.vbs

'*** CreateServerList.vbs
'*** Create Server List from specified OU
'*** Includes Cluster servers themselves and Domain Controllers
'*** but excludes Cluster Resource servers
On Error Resume Next
Const ForWriting = 2
Const ADS_SCOPE_SUBTREE = 2
Const dictKey  = 1
Const dictItem = 2
path = WScript.ScriptFullName : path = Left(path,InstrRev(path,"")) 
strMessage = "ServerList.txt will appear in folder when process is done." 
strScriptName = "Creating Server List"
CreateObject("WScript.Shell").Popup strMessage,7,strScriptName,vbInformation
'!!! Modify the line below to point the your OU
QStr = "SELECT cn FROM 'LDAP://OU=xxx,OU=xxx,DC=xxx,DC=xxx' Where 
objectcategory='computer' AND objectclass='computer'"
Set RedAlert = CreateObject("Scripting.Dictionary")
Set objNet = CreateObject("WScript.NetWork")
Domain = objNet.UserDomain
txtname = "ServerList"
DomainServerListFile = Path & txtname & ".txt"
NoPingResponseServers = Path & "NoPingResponseServers.TXT"
Set objConnection = CreateObject("ADODB.Connection")
Set objCommand = CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCommand.ActiveConnection = objConnection
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
objCommand.CommandText = QStr
Set objRecordSet = objCommand.Execute
objRecordSet.MoveFirst
Do Until objRecordset.EOF
 SvrName = ""
 SvrName = objRecordSet.Fields("CN").Value
 Set objWMIService3 = nothing
 Set colItems3 = nothing
 Set objWMIService3 = GetObject("winmgmts:\.rootCIMV2")
 Set colItems3 = objWMIService3.ExecQuery _
  ("Select * From Win32_PingStatus Where Address = '" & SvrName & "'")
 For Each objItem3 In colItems3
  If objItem3.StatusCode = 0 Then
   Set objWMIService2 = Nothing
   Set colItems2 = Nothing
   strComputer2 = ""
   Set objWMIService2 = GetObject("winmgmts:" 
_    & "{impersonationLevel=impersonate}!\" & SvrName & "rootcimv2")
   Set colItems2 = objWMIService2.ExecQuery("Select Name from 
Win32_ComputerSystem",,48) 'Get Computer Name
   For each objItem2 in colItems2
    strComputer2 = objItem2.name 'Get Computer Name
   Next
   Set objWMIService2 = Nothing
   Set colItems2 = Nothing
   If Trim(Lcase(SvrName)) = Trim(Lcase(strComputer2)) Then
    RedAlert.Add 
objRecordSet.Fields("CN").Value,objRecordSet.Fields("CN").Value
   End If
  Else
   RedAlert.Add objRecordSet.Fields("CN").Value & " No 
Ping",objRecordSet.Fields("CN").Value & " No Ping"
  End If
 Next
 objRecordset.MoveNext
Loop
'*** Domain Controllers
Set objRootDSE = GetObject("LDAP://RootDSE")
ConfigNC = objRootDSE.Get("configurationNamingContext")
objCommand.CommandText = "SELECT ADsPath FROM 'LDAP://" & ConfigNC & "' 
WHERE objectClass='nTDSDSA'"  
Set objRecordSet = objCommand.Execute
objRecordSet.MoveFirst
Do Until objRecordSet.EOF
 Set objDC = GetObject(GetObject(objRecordSet.Fields("AdsPath")).Parent) 
 Set objSite = GetObject(GetObject(objDC.Parent).Parent) 
 RedAlert.Add objDC.cn,objDC.cn
 objRecordSet.MoveNext
Loop
'*** Other servers in different OUs
DNC = GetObject("LDAP://RootDSE").Get("defaultNamingContext")
QStr = "SELECT cn FROM 'LDAP://" & DNC & "' Where objectcategory='computer' 
AND operatingSystem='*server*'"
Set objConnection = CreateObject("ADODB.Connection")
Set objCommand = CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCommand.ActiveConnection = objConnection
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Sort On") = "CN"
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
objCommand.CommandText = QStr
Set objRecordSet = objCommand.Execute
objRecordSet.MoveFirst
Do Until objRecordset.EOF
 SvrName = ""
 SvrName = objRecordSet.Fields("CN").Value
 Set objWMIService3 = nothing
 Set colItems3 = nothing
 Set objWMIService3 = GetObject("winmgmts:\.rootCIMV2")
 Set colItems3 = objWMIService3.ExecQuery _
  ("Select * From Win32_PingStatus Where Address = '" & SvrName & "'")
 For Each objItem3 In colItems3
  If objItem3.StatusCode = 0 Then
   Set objWMIService2 = Nothing
   Set colItems2 = Nothing
   strComputer2 = ""
   Set objWMIService2 = GetObject("winmgmts:" _
    & "{impersonationLevel=impersonate}!\" & SvrName & "rootcimv2")
   Set colItems2 = objWMIService2.ExecQuery("Select Name from 
Win32_ComputerSystem",,48) 'Get Computer Name
   For each objItem2 in colItems2
    strComputer2 = objItem2.name 'Get Computer Name
   Next
   Set objWMIService2 = Nothing
   Set colItems2 = Nothing
   If Trim(Lcase(SvrName)) = Trim(Lcase(strComputer2)) Then
    RedAlert.Add 
objRecordSet.Fields("CN").Value,objRecordSet.Fields("CN").Value
   End If
  Else
   RedAlert.Add objRecordSet.Fields("CN").Value & " No 
Ping",objRecordSet.Fields("CN").Value & " No Ping"
  End If
 Next
 objRecordset.MoveNext
Loop
SortDictionary RedAlert,dictItem
arrKeys = RedAlert.Keys()
Set fso = CreateObject("Scripting.FileSystemObject")
Set txt = fso.OpenTextFile(DomainServerListFile,ForWriting,True) 
Set txt2 = fso.OpenTextFile(NoPingResponseServers,ForWriting,True) 
For i = 0 To RedAlert.Count - 1
 If Instr(arrKeys(i),"No Ping") = 0 Then
  txt.WriteLine arrKeys(i) 
 Else
  txt2.WriteLine arrKeys(i) 
 End If
Next
objConnection.Close
txt.Close
txt2.Close
MsgBox "Done Creating " & DomainServerListFile
Function SortDictionary(objDict,intSort) 
 Dim strDict()
 Dim objKey
 Dim strKey,strItem
 Dim X,Y,Z
 Z = objDict.Count
 If Z > 1 Then
  ReDim strDict(Z,2) 
  X = 0
  For Each objKey In objDict
   strDict(X,dictKey)  = CStr(objKey) 
   strDict(X,dictItem) = CStr(objDict(objKey)) 
   X = X + 1
  Next
  For X = 0 to (Z - 2) 
   For Y = X to (Z - 1) 
    If StrComp(strDict(X,intSort),strDict(Y,intSort),vbTextCompare) > 0 Then
     strKey  = strDict(X,dictKey) 
     strItem = strDict(X,dictItem) 
     strDict(X,dictKey)  = strDict(Y,dictKey) 
     strDict(X,dictItem) = strDict(Y,dictItem) 
     strDict(Y,dictKey)  = strKey
     strDict(Y,dictItem) = strItem
    End If
   Next
  Next
  objDict.RemoveAll
  For X = 0 to (Z - 1) 
   objDict.Add strDict(X,dictKey), strDict(X,dictItem) 
  Next
 End If
End Function