Downloads
103078.zip

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:

  • Define regular expressions of the intrusive filenames
  • Create a list of computers to be scanned
  • Create a hash list file that lists the 32-character strings of the intrusive files

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:

  • The caret, which means “Begins with”
  • The open and closing parenthesis, which mean look for this phrase within the parentheses
  • The backslash is an escape character; because the period, which separates the filename and extension, holds significant functionality in regular expressions, the backslash simply means use the period literally, not as a regular expression identifier.
  • The dollar sign at the end means “Ends with”

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:

  • ServerList.txt
  • SearchList.txt
  • HashList.txt
  • MD5batch.cmd
  • ErrorFile.txt
  • Results.txt

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:

  1. Include cluster servers but not cluster resources
  2. Include domain controllers (DCs)
  3. Gather from hard-coded organizational units (OUs), so you'll need to edit the script and adjust this to the appropriate OU
  4. Gather any Active Directory (AD) computer where operatingSystem contains Server

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 & "Archive\Archive" & 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:\\.\root\cimv2").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:\\.\root\cimv2").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:\\.\root\cimv2").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:\\.\root\cimv2").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:\\.\root\CIMV2")

 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 & "\root\cimv2")


   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:\\.\root\CIMV2")

 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 & "\root\cimv2")

   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