'Original Author: Jeff Price
'Description:

'       Based on ThreadForker.vbs by Jeff Price, jeff.price@rocketmail.com, Dec-2001
'       Updated May 2006 by Thomas Rutherford -- use taskkill /f /t
'       in place of kill, base number of forks on number of
'       processors and introduce a program argument list.

'       Price's description:
'       Multi-threading agent to run parallel instances of your
'       app/script/process/etc, in order to reduce the total run time of the
'       desired process (eg, auditing 500+ systems). It also has a sentinel
'       which will kill any errant threads after a specified timeout. 

Option Explicit

dim MaxMinutes
dim MaxForks 

' ================================================================================

dim wshShell, oFileSys
dim aThreadInfo(), iThreadNum

'initialise the core objects req'd
Set wshShell = WScript.CreateObject("WScript.Shell")
Set oFileSys=CreateObject("Scripting.FileSystemObject")
Dim oJobDict
Set OJobDict = CreateObject("Scripting.Dictionary")

'check we've atleast v5.6 of WSH
if CDbl(wScript.Version) < CDbl("5.6") then
   wScript.Echo " ***************** "
   wScript.Echo " This script requires atleast v5.6 of Windows Script Host."
   wScript.Echo " Your current version is " & wScript.Version
   wScript.Echo " http://msdn.microsoft.com/downloads/default.asp"
   wScript.Echo " -- Web Development"
   wScript.Echo " - Windows Script"
   wScript.Echo " --- Windows Script Host 5.6"
   wScript.Echo "***************** "
   wScript.Quit
end if

if InStr(LCase(wScript.FullName), "wscript.exe") then
   wScript.Echo "You have run this script from the GUI (wscript)" & vbCRLF & "Please rerun from a command prompt as" & vbCRLF & " 'cscript ThreadForker.vbs'"
   wScript.Quit
End if

dim CmdFile
if Wscript.Arguments.Unnamed.Count=1 then
   CmdFile = Wscript.Arguments.Unnamed(0)
else
   wScript.Echo "Command syntax:"
   wScript.Echo ""
   wScript.Echo " cscript runjobs.vbs CmdFile [/minutes:xx] [/forks:xx]"
   wScript.Echo ""
   wScript.Quit
end if
if not oFileSys.FileExists (CmdFile) then
   wScript.Echo "Did not find command file: "& CmdFile
   wScript.Quit
End if

dim oArgs
set oArgs = Wscript.Arguments.Named
if oArgs.Exists("minutes") then
   MaxMinutes = csng(oArgs("minutes"))
else
   MaxMinutes = 10
end if
if oArgs.Exists("forks") then
   MaxForks = cint(oArgs("forks"))
else
   MaxForks = cint(wshShell.Environment.Item("NUMBER_OF_PROCESSORS"))-1
   if MaxForks<1 Then MaxForks=1
end if
wScript.Echo "MaxMinutes = "&cstr(MaxMinutes) & vbCRLF & "MaxForks="& cstr(MaxForks)

'       Redimension the thread tracker and reset the "time" to -1 seconds
redim aThreadInfo( MaxForks-1, 2)
dim i
for i = 0 to UBound( aThreadInfo, 1)
  aThreadInfo(i,1) = -1
next

dim oCmdFile
set oCmdFile = oFileSys.OpenTextFile(CmdFile)
dim CmdLine
dim LineNo : LineNo = 0
dim Normal:Normal=0
dim TimedOut:TimedOut=0
While NOT oCmdFile.AtEndOfStream
   CmdLine = oCmdFile.ReadLine
   LineNo = LineNo + 1
   if Trim(CmdLine) <> "" then
      While GetNextThread = -1

'       Loop until we've a free process
         ProcessCheck
      Wend

'       Get a thread number:
      iThreadNum = GetNextThread

'       Run the command:

      set aThreadInfo(iThreadNum, 0) = wshShell.Exec(CmdLine)
      wScript.Echo cstr(LineNo)&"("&aThreadInfo(iThreadNum, 0).ProcessID&"): "&CmdLine

'       Let the process settle
      wScript.Sleep 1000

'       Start the thread timer
      aThreadInfo( iThreadNum, 1) = 1/60
      aThreadInfo( iThreadNum, 2) = LineNo
   End If
Wend
oCmdFile.Close
set oCmdFile = Nothing
While ProcessCheck
Wend
wScript.Echo ""
wScript.Echo "Exit Status:"
for i = 1 to LineNo
   wScript.Echo i,oJobDict.Item(cstr(i))
next
wScript.Quit

' ==============
' return TRUE = yes we have active processes
' return FALSE = no active processes
' ==============
Function ProcessCheck()

     dim i

     ProcessCheck = False

     wScript.Sleep 1500
     for i = 0 to UBound( aThreadInfo, 1)
          'wScript.Echo "checking " & i & " with timeout " & aThreadInfo(i, 1)
          if aThreadInfo(i,1) > -1 then
'               wScript.Echo aThreadInfo(i,2) & ": " & cstr(round(MaxMinutes-aThreadInfo(i,1),1)) & " min."
               if aThreadInfo(i, 0).Status = 0 then
                    if aThreadInfo(i,1) > MaxMinutes then
                         'aThreadInfo(i,0).Terminate
                         wshShell.Run "taskkill /PID " & aThreadInfo(i,0).ProcessID & " /f /t", 2, True
                         wScript.Sleep 1000
                         oJobDict.Add cstr(aThreadInfo(i,2)), -1
                         set aThreadInfo(i,0) = Nothing
                         aThreadInfo(i,1) = -1
                         aThreadInfo(i,2) = 0
                         TimedOut = TimedOut + 1
                         wScript.Echo "Normal:",Normal," TimedOut:",TimedOut
                    else
                         ProcessCheck = True
                         aThreadInfo(i, 1) = aThreadInfo(i, 1) + 1.5/60
                    End if
               Else
                  if aThreadInfo(i, 0).Status = 1 Then Normal = Normal + 1
                  oJobDict.Add cstr(aThreadInfo(i,2)), aThreadInfo(i,0).Status
                  set aThreadInfo(i, 0) = Nothing
                  aThreadInfo(i, 1) = -1
                  aThreadInfo(i, 2) = 0
                  wScript.Echo "Normal:",Normal," TimedOut:",TimedOut
                  'wScript.Echo i, aThreadInfo(i, 1)

               End If
          End if
     next
     'wScript.Echo "active processes? :" & ProcessCheck
End Function
' ==============
' ==============

Function GetNextThread ( )
     dim i
     GetNextThread = -1
     for i = 0 to UBound( aThreadInfo, 1)
          'wScript.Echo "GetNextThread" & i & ":" & aThreadInfo(i, 1)
          if aThreadInfo( i, 1) = -1 then
               'aThreadInfo( i, 1) = 0
               GetNextThread = i
               i = UBound( aThreadInfo, 1) +1
          End if
     next
End Function