VBScript MultiThreading
While searching for a way to fake multithreading in Visual Basic Script, I examined several examples and developed my own code based on Scott Haleen's version.

In my example below I originally had 5 Thread Scripts which could be anything, I altered the sleep timing so each script completed in 2, 4, 6, 8 & 10 seconds and returned various quit codes.

If I developed this as a normal script it would take 30 seconds in total to complete, but the MultiThreading version completes in only 10 seconds if all threads allowed to run concurrently (i.e. when the longest running thread has finished).

I've added for completeness the ability to terminate a thread by timeout if required. However, Terminating a thread (or process in this case) is not recommended as putting an axe through a running script can have unexpected results. The benefit it does do is allow more control over the overall script especially when timing is critical (i.e. for frequently executed scheduled tasks). I examined several options, but each had their limitations...

  1. 'CScript /T:nn script.vbs' - No return or exit code for a terminated script.
  2. 'WScript.Timeout = nn' - No return or exit code for a terminated script.
  3. Timeout Function within thread script (i.e. Thread1.vbs) - Won't terminate if running a long single command until it has completed.
  4. WshScriptExec.Terminate - Intermitently produces a Windows Invalid Handle exception.
In the end I went with WshScriptExec.Terminate object within the main multithreading script and handled the intermittent exception, as I could capture a terminate response if I needed to do something with a terminated thread.

The Timeout functionality also provided an added benefit as it allowed me to record/log how long a thread was processing, this is useful for long running threads as putting these first means your script can complete quicker when having more than the max concurrent threads.

VBScript MultiThreading Code 

Option Explicit

' ########################################################################################
' # VBScript   : MainScript.vbs                                                          #
' # Coded By   : Matt Wakeling                                                           #
' # Coded Date : 02nd August 2014                                                        #
' ########################################################################################
' # Description        : VBScript to simulate multi-threading                            #
' #                                                                                      #
' # Change History     : 001.000 Initial Release                                         #
' #                      001.001 Added Exception Handling                                #
' #                      001.002 Added Debug Mode + Logging                              #
' #                      001.003 Added Maximum Concurrent Thread Functionality           #
' #                      001.004 Added Time out Thread Functionality                     #
' # Thread Time out    : 0         = No Time out                                         #
' #                    : 1 - 32767 = Seconds until time out                              #      
' # Thread Exec Status : 0         = Running                                             #
' #                      1         = Completed                                           #
' #                      2         = Terminated (Time out)                               #
' # Thread Exit Code   : 0         = Default                                             #
' #                      1 - 255   = User Defined                                        #
' #                                                                                      #
' # Known Problems     : 0x80070578 Invalid Window Handle on Terminate Thread this is a  #
' #                      known WshScriptExec.Terminate object issue. The script handles  #
' #                      the exception.                                                  # 
' ########################################################################################

On Error Resume Next

'Declare Constants
Const bolDebugMode = True

Const ForWriting = 2
Const ForAppending = 8
Const adVarChar = 200 
Const adInteger = 3 
Const adDate = 7
Const adFilterNone = "" 

Const MaxThreads = 2
Const ThreadTimeout = 30  ' 0 = No time out


'Declare Variables
Dim objFSO, objLogFile, strLogFile
Dim objWshShell, objADORRS
Dim arrMultiThreads(), arrExec(), intThreadCount
Dim intLoopCounter

Set objADORRS = CreateObject("ADOR.Recordset") 
objADORRS.Fields.Append "Thread", adVarChar, 255
objADORRS.Fields.Append "ExecStatus", adInteger, 5  
objADORRS.Fields.Append "ExecID", adInteger, 5
objADORRS.Fields.Append "ProcessID", adInteger, 5
objADORRS.Fields.Append "ProcessStart", adDate, 5
objADORRS.Fields.Append "ProcessTime", adInteger, 5
objADORRS.Open 

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

strLogFile = Wscript.ScriptName & ".log"

Set objFSO = createobject("Scripting.FileSystemObject") 
Set objLogFile = objFSO.OpenTextFile(strLogFile, ForAppending, true)

objLogFile.WriteLine Now & " | Script           : Started" 

If bolDebugMode then objLogFile.WriteLine Now & " | Script Status    : Debug Mode Enabled"
If bolDebugMode then objLogFile.WriteLine Now & " | Script Name      : " & Wscript.ScriptName
If bolDebugMode then objLogFile.WriteLine Now & " | Script Path      : " & Wscript.ScriptFullName
If bolDebugMode then objLogFile.WriteLine Now & " | Build number     : " & ScriptEngineMajorVersion & "." & ScriptEngineMinorVersion & "." & ScriptEngineBuildVersion
If bolDebugMode then objLogFile.WriteLine Now & " | Description      : Multi Threaded VBScript Example"

If Err <> 0 Then LogError("Script Error")

If bolDebugMode then objLogFile.WriteLine Now & " | MultiThreading   : Initialise Threads"
If bolDebugMode then objLogFile.WriteLine Now & " | MultiThreading   : Maximum Concurrent Threads = " & MaxThreads
If bolDebugMode then objLogFile.WriteLine Now & " | MultiThreading   : Thread Time Out = " & ThreadTimeout

Redim preserve arrMultiThreads(4)

arrMultiThreads(0) = "cscript.exe //NoLogo //B Thread1.vbs"
arrMultiThreads(1) = "cscript.exe //NoLogo //B Thread2.vbs"
arrMultiThreads(2) = "cscript.exe //NoLogo //B Thread3.vbs"
arrMultiThreads(3) = "cscript.exe //NoLogo //B Thread4.vbs"
arrMultiThreads(4) = "cscript.exe //NoLogo //B Thread5.vbs"

If Err <> 0 Then LogError("Initialise Threads Error")

intThreadCount = 0 
intLoopCounter = 0
For intLoopCounter = 0 To UBound(arrMultiThreads)
 Redim preserve arrExec(intLoopCounter) 

 If bolDebugMode then objLogFile.WriteLine Now & " | MultiThreading   : Execute (" & arrMultiThreads(intLoopCounter) & ")"
 Set arrExec(intLoopCounter) = objWshShell.Exec(arrMultiThreads(intLoopCounter))
   
 objADORRS.AddNew 
 objADORRS("Thread") = arrMultiThreads(intLoopCounter) 
 objADORRS("ExecStatus") = 0  
 objADORRS("ExecID") = intLoopCounter
 objADORRS("ProcessID") = arrExec(intLoopCounter).ProcessID
 objADORRS("ProcessStart") = Now()
 objADORRS("ProcessTime") = 0 
 objADORRS.Update  
   
 intThreadCount = intThreadCount + 1

 If intThreadCount > (MaxThreads - 1) then  
            WaitForThreads(MaxThreads - 1) 
   objADORRS.MoveLast
 End If 
 
 If Err <> 0 Then LogError("Execute Thread Error")
Next

WaitForThreads 0

If bolDebugMode then objLogFile.WriteLine Now & " | Script Status    : Performing Clean-up"

objLogFile.WriteLine Now & " | Script           : Completed" 

If Err <> 0 Then LogError("Script Error")

objADORRS.Close
objLogFile.Close

'Perform Clean up 

intThreadCount = 0
intLoopCounter = 0

strLogFile = ""

Erase arrMultiThreads
Erase arrExec

Set objADORRS = Nothing
Set objLogFile = Nothing
Set objFSO = Nothing


Sub WaitForThreads(intThreads)
' ########################################################################################
' # Description     : Wait for threads to complete and get script return code            #
' ########################################################################################

 On Error Resume Next
  
 Dim intThreadHandle
  
 Do While intThreadCount > intThreads
  objADORRS.Filter = "ExecStatus = 0" 

  objADORRS.MoveFirst
  Do While Not objADORRS.EOF
   objADORRS("ProcessTime") = DateDiff("s", objADORRS("ProcessStart"), Now())   
   intThreadHandle = objADORRS("ExecID")

   If (arrExec(intThreadHandle).Status <> 0 Or (objADORRS("ProcessTime") >= ThreadTimeout And ThreadTimeout <> 0)) then  
    If (objADORRS("ProcessTime") >= ThreadTimeout And ThreadTimeout <> 0) Then 
     If Err <> 0 Then LogError("WaitForThreads Error")
     arrExec(intThreadHandle).Terminate
     If Err <> 0 Then LogError("WaitForThreads Error : Terminate Thread (Invalid Window Handle)")
  
     objADORRS("ExecStatus") =  2
     If bolDebugMode then objLogFile.WriteLine Now & " | MultiThreading   : Terminated (" & objADORRS("Thread") & ") ExecStatus : " & objADORRS("ExecStatus") & " | ExitCode : " & arrExec(intThreadHandle).ExitCode & " | ProcessID : " &  arrExec(intThreadHandle).ProcessID & " | Status : " &  arrExec(intThreadHandle).Status & " | ProcessTime : " & objADORRS("ProcessTime")    

    Else
     objADORRS("ExecStatus") =  arrExec(intThreadHandle).Status
     If bolDebugMode then objLogFile.WriteLine Now & " | MultiThreading   : Completed (" & objADORRS("Thread") & ") ExecStatus : " & objADORRS("ExecStatus") & " | ExitCode : " & arrExec(intThreadHandle).ExitCode & " | ProcessID : " &  arrExec(intThreadHandle).ProcessID & " | Status : " &  arrExec(intThreadHandle).Status & " | ProcessTime : " & objADORRS("ProcessTime")    
    End If
   End If

   If Err <> 0 Then LogError("WaitForThreads Error")
  
   objADORRS.MoveNext
  Loop
  intThreadCount = objADORRS.RecordCount
 Loop
 
 objADORRS.Filter = adFilterNone 
 
 intThreadHandle = 0 
End Sub



Sub LogError(strErrorMessage)
' ########################################################################################
' # Description     : Exception Logging                                                  #
' ########################################################################################

 Dim objErrorFile, strErrorFile

 strErrorFile = Wscript.ScriptName & ".ERROR.log"

 Set objErrorFile = objFSO.OpenTextFile(strErrorFile, ForAppending, true)
 
 objErrorFile.WriteLine Now & " | Err Message : " & strErrorMessage & " | Err Number : " & Err.Number & " | Err Hex : " & Hex(Err.Number) & " | Err Description : " & Err.Description & " | Err Source : " & Err.Source 
    Err.Clear

 objErrorFile.Close
 
 strErrorFile = ""
 
 Set objErrorFile = Nothing 
End Sub

Example Thread Code 

Const ForWriting = 2

Dim objFSO, objLogFile, strLogFile

strLogFile = Wscript.ScriptName & ".log"

Set objFSO = createobject("Scripting.FileSystemObject") 
Set objLogFile = objFSO.OpenTextFile(strLogFile, ForWriting, true)

objLogFile.WriteLine Now & " | Script Name : " & Wscript.ScriptName
WScript.Sleep 3000
objLogFile.WriteLine Now & " | Script Path : " & Wscript.ScriptFullName
WScript.Sleep 3000
objLogFile.WriteLine Now & " | Build number : " & ScriptEngineMajorVersion & "." & ScriptEngineMinorVersion & "." & ScriptEngineBuildVersion

objLogFile.Close

strLogFile = ""

Set objLogFile = Nothing
Set objFSO = Nothing

WScript.Quit(5)

Example Log Output 

03/08/2014 18:51:02 | Script           : Started
03/08/2014 18:51:02 | Script Status    : Debug Mode Enabled
03/08/2014 18:51:02 | Script Name      : MainScript.vbs
03/08/2014 18:51:02 | Script Path      : D:\TEST\MultiThreadScript\MainScript.vbs
03/08/2014 18:51:02 | Build number     : 5.8.18337
03/08/2014 18:51:02 | Description      : Multi Threaded VBScript Example
03/08/2014 18:51:02 | MultiThreading   : Initialise Threads
03/08/2014 18:51:02 | MultiThreading   : Maximum Concurrent Threads = 2
03/08/2014 18:51:02 | MultiThreading   : Thread Time Out = 30
03/08/2014 18:51:02 | MultiThreading   : Execute (cscript.exe //NoLogo //B Thread1.vbs)
03/08/2014 18:51:02 | MultiThreading   : Execute (cscript.exe //NoLogo //B Thread2.vbs)
03/08/2014 18:51:06 | MultiThreading   : Completed (cscript.exe //NoLogo //B Thread2.vbs) ExecStatus : 1 | ExitCode : 0 | ProcessID : 4444 | Status : 1 | ProcessTime : 4
03/08/2014 18:51:06 | MultiThreading   : Execute (cscript.exe //NoLogo //B Thread3.vbs)
03/08/2014 18:51:12 | MultiThreading   : Completed (cscript.exe //NoLogo //B Thread3.vbs) ExecStatus : 1 | ExitCode : 5 | ProcessID : 1540 | Status : 1 | ProcessTime : 6
03/08/2014 18:51:12 | MultiThreading   : Execute (cscript.exe //NoLogo //B Thread4.vbs)
03/08/2014 18:51:21 | MultiThreading   : Completed (cscript.exe //NoLogo //B Thread4.vbs) ExecStatus : 1 | ExitCode : 0 | ProcessID : 1528 | Status : 1 | ProcessTime : 9
03/08/2014 18:51:21 | MultiThreading   : Execute (cscript.exe //NoLogo //B Thread5.vbs)
03/08/2014 18:51:31 | MultiThreading   : Completed (cscript.exe //NoLogo //B Thread5.vbs) ExecStatus : 1 | ExitCode : 0 | ProcessID : 2632 | Status : 1 | ProcessTime : 10
03/08/2014 18:51:34 | MultiThreading   : Terminated (cscript.exe //NoLogo //B Thread1.vbs) ExecStatus : 2 | ExitCode : 0 | ProcessID : 2116 | Status : 1 | ProcessTime : 30
03/08/2014 18:51:34 | Script Status    : Performing Clean-up
03/08/2014 18:51:34 | Script           : Completed


To run the script perform the following tasks...
  1. Create a new directory i.e. C:\VBScript
  2. Copy MultiThreading Code into C:\VBScript\MultiThreading.vbs
  3. Copy Thread Code into C:\VBScript\Thread1.vbs
  4. Copy Thread Code into C:\VBScript\Thread2.vbs
  5. Copy Thread Code into C:\VBScript\Thread3.vbs
  6. Copy Thread Code into C:\VBScript\Thread4.vbs
  7. Copy Thread Code into C:\VBScript\Thread5.vbs
  8. Alter Sleep Timings and WScript.Quit() values for each Thread Script.
  9. In Command Prompt type 'cscript C:\VBScript\MultiThreading.vbs' and press Enter


I hope this is of some use to you all, please feel free to leave a comment...