vbscript to multithread execution of imacros 1

[Guttmann]

Hi, I have got the below script which will read an input data file and perform an Imacros script for each line -- downloads some files. What I would like to do is use 7 instances of imacros simultaneously. So, my thought is to have a vbscript which will first read this input list, divide it by 7, and output 7 lists, then run 7 different vb scripts which each have a different input file location..

So, my folder structure would be

C:\Job\Main.vbs
C:\Job\MainList.txt
C:\Job\T1\T1.vbs
C:\Job\T1\T1.txt
C:\Job\T2\T2.vbs
C:\Job\T2\T2.vbs

etc...

What I am trying to figure out is

1, is this the best way to do this?
2. How can I have the main.vbs script monitoring the others so that I can restart if needed and know when each are done, etc.

This is the script that I made which will process 1 list...

Option Explicit

    Const iM_ElementNotFound        = -1300
    Const iM_EndOfFile              = -1240
    Const iM_EvalError              = -1340
    Const iM_BrowzConnErr           = -1340
    Const iM_BadParam               = -1200
    Const OpenAsASCII               = 0
    Const iM_Success                = 1
    Const ForReading                = 1
    Const ForAppending              = 8
    Const ForWriting                = 1
    Const CreateIfNotExist          = True
    Dim ReSet       : ReSet         = "False"
    Dim LoopCount   : LoopCount     = 0
    Dim CaptchaFail : CaptchaFail   = 0
    Dim Iteration   : Iteration     = 0
    Dim Complete    : Complete      = 0
    Dim Tab         : Tab           = 0
    Dim S           : S             = 0
    Dim i           : i             = 0
    Dim G           : G             = 1
    Dim StepAmt     : StepAmt       = 3
    Dim Threads     : Threads       = 4

    Dim iDayNumber  : iDayNumber    = DateDiff("d", CDate("1/1/" & Year(Now)), Now) + 1
    Dim varLMonth   : varLMonth     = Month(Now) - 1
    Dim varDateFull : varDateFull   = Month(Now) & "-" & Day(Now) & "-" & Year(Now)
    Dim varDay      : varDay        = Day(Now)
    Dim varMonth    : varMonth      = Month(Now)
    Dim N           : N             = vbNewLine
    Dim iim1        : Set iim1      = CreateObject("iMacros")
    Dim w1          : w1            = iim1.iimOpen("-ie", true)
    Dim IPath       : IPath         = "C:\Job\T1\MainList.txt"
    Dim tDir        : tDir          = "C:\Job\T1\"
    Dim WshShell    : Set WshShell  = CreateObject("WScript.Shell")
    Dim objFso      : Set objFso    = CreateObject("Scripting.FileSystemObject")
    Dim D           : Set D         = CreateObject("Scripting.Dictionary")

    Dim iFile       : Set iFile     = objFso.OpenTextFile(IPath)
    Dim OpenTabs1   : OpenTabs1     = OpenTabs()
    Dim running     : running       = 0
    Dim lc          : lc            = 0
    Dim Count, Date, Extract, FileDate, FileSize, FileIteration, x, iMacros, M, objFile, strLine _
        ,Processed, Skip, FileInfo, Message, Today, TimeStamp, checkurl, thisurl, File, Files, ObjFolder, ReturnMessage _
        ,ZipName, TxtName, InputData, S, T1L, T, Line, BDay, OutFile, OutPNG, Result, FName, MName, LName, ID, Active, Key, v, ImageSubmit, FileName, Image1, iiii, Image2, Image3, LoginSCRA, Key1, Key2, Key3, SPrintName, Clear, SPrint, Thread, R, LR, Data, Total, Groups, LastGroup, ii, ww, www, c, aa, a, cr,w1x1,w1x2,w1x3, Image, w,Captcha,Captchakeys, iii, ss, sp

    If Len(Day(Now))    =   1   Then varDay         = "0" & varDay
    If Len(Month(Now))  =   1   Then varMonth       = "0" & varMonth

    Today = varDay & varMonth & Year(Now)

        Do Until iFile.AtEndOfStream
            D.Add lc, LC & "," & iFile.ReadLine
            Wscript.Echo("Line Info = " & lc & "," & iFile.Readline)
            lc = lc + 1
        Loop
    Wscript.Echo(D(0))
    iFile.Close
        Data = D.Keys
        Total = D.Count -1
        iFile.Close
        Set objFSO = Nothing
        T = 1
        thisurl = "NODATA"
        running = 1
        w1 = iim1.iimPlayCode(OpenTabs())
        running = 1
        checkurl = "null"
        Count = 0
        For i = 0 to Total
            T1L = D.item(i)
            Wscript.Echo("T1L = " & T1L)
            m = 0
            cr = ""
            ii = 4
            W = 1
            v = Split(T1L,",")
            Line = v(0)
            S = v(1)
            LName = v(2)
            MName = v(3)
            FName = v(4)
            BDay = ""
            ID  = v(6)
            sp = v(7)
            wscript.Echo("================================" & vbCr & "Line Info for input line " & v(0) & vbCr & "S=" & v(1) & vbCr & "LName=" & v(2) & vbCr & "MName=" & v(3) & vbCr & "FNAME=" & v(4) & vbCr & "BDay=" & v(5) & vbCr & "SPN=" & v(6)& vbCr & "================================")
            w1 = iim1.iimSet("sp", SP)
            w1 = iim1.iimSet("tDir", tDir)
            w1 = iim1.iimSet("S", S)                        
            w1 = iim1.iimSet("LName", LName)
            w1 = iim1.iimSet("FName", FName)
            w1 = iim1.iimSet("BDay", BDay)
            w1 = iim1.iimSet("MName", MName)
            w1 = iim1.iimSet("ID", ID)
            w1 = iim1.iimSet("Line", Line)
            w1 = iim1.iimPlayCode(Upload())
            Dim objFso3
            Set objFso3 = CreateObject("Scripting.FileSystemObject")
            OutFile = tDir & ID & ".pdf"
            OutPNG= tDir & ID & ".png"
            Do While Running = 1
               If (objFso3.FileExists(OutFile)) Then
                    Wscript.Echo(OutFile & " Exists")
                    If sp = "Y" Then
                        If (objFso3.FileExists(OutPNG)) Then
                            Wscript.Echo(OutPNG & " Exists")
                            Running = 0
                        Else
                            Wscript.Echo(OutFile & " Does Not Exist")
                            WScript.Sleep 1000
                        End If
                    ElseIf sp = "N" Then
                        Running = 0
                    End if
                Else
                    WScript.Sleep 1000
                End If
            Loop
    Next
    CheckAndWriteToReady
    Output.Close
    WScript.Quit(0)

Function OpenTabs
    Dim M
        M =""
        M = "CODE:"
        M = "CLEAR" + N
        M = "VERSION BUILD=844 RECORDER=CR" + N
        M = M + "SET !EXTRACT NULL" + N
        M = M + "CLEAR" + N
        M = M + "TAB T=1" + N
        M = M + "TAB CLOSEALLOTHERS" + N
        M = M + "SET !WAITPAGECOMPLETE YES" + N
        M = M + "URL GOTO=website" + N
        M = M + "TAB OPEN" + N
        OpenTabs = M
        Wscript.Echo("Opening Tabs for Thread1" & W)
        OpenTabs1 = 0
End Function

Function Upload
    Dim M
    M = My iMacros Script which will perform the upload for the current line of the vbscript
    Upload = M
End Function

Function CheckAndWriteToReady
Dim csvFilePath, Output, strDate,strTime
    strDate = DatePart("yyyy",Date) & Right("0" & DatePart("m",Date), 2) & Right("0" & DatePart("d",Date), 2)
    strTime = Right("0" & Hour(Now), 2) & Right("0" & Minute(Now), 2) & Right("0" & Second(Now), 2)
    csvFilePath = "C:\Job\ReadyList1\T1" & strDate & strTime & ".csv"
    
    wscript.echo(csvFilePath)
    Set objFso3 = CreateObject("Scripting.FileSystemObject")
    Set Output = objFso3.CreateTextFile(csvFilePath, ForWriting, true)
    Output.WriteLine("Success")
    For i = 0 to Total
        T1L = D.item(i)
        v = Split(T1L,",")
        ID  = v(6)
            OutFile = tDir & ID & ".pdf"
            OutPNG= tDir & ID & ".jpg"
            'Do while running = 1
                If (objFso2.FileExists(OutFile)) And sp = "Y" And (objFso2.FileExists(OutPNG)) Then
                        Output.WriteLine(T1L & "Success" & "," & tDir & ID & ".pdf" & "," & tDir & ID & ".png" & ",")
                Else
                    If(objFso2.FileExists(OutFile)) And sp = "N" Then
                        Output.WriteLine(T1L & "Success" & "," & tDir & ID & ".pdf" & "," & "" & ",")
                    End if
                End If       
    Next
    EndTime = Timer()
    Wscript.Echo("Run Time: " & FormatNumber(EndTime - StartTime, 2))
End Function

 

[omen999]

sample of (pseudo) multithread :

' GetDNSSpeed - multithreading demo - omen999 october 2017 - [URL unfurl="true"]http://omen999.developpez.com/[/URL]
' DNS tested : FreeDNS, Verisign, FDN, Comodo Secure DNS, OpenDNS, DNS Advantage, Norton ConnectSafe, OpenNIC
 
Class cTasks
 Private oShell
 Private aoExec()
 Private IDTask
 Private sText
 
  Private Sub Class_Initialize()
   Set oShell = CreateObject("WScript.Shell")
   IDTask = 0
  End Sub
 
  Public Function Create(cmd)
   ReDim Preserve aoExec(IDTask)
   Set aoExec(IDTask) = oShell.Exec(cmd)
   Create = IDTask
   IDTask = IDTask + 1
  End Function
 
  Public Sub Terminate(id)
   aoExec(id).Terminate
 End Sub
 
 Public Property Get IsRunning(id)
  IsRunning = CBool(aoExec(id).Status - 1)
 End Property
 
 Public Property Get RetData(id)
  Do While Not aoExec(id).StdOut.AtEndOfStream
   sText = aoExec(id).StdOut.ReadLine()
   If Instr(sText, "Moyenne") > 0 Then
    RetData = Mid(sText,InStr(sText, "Moyenne")) & vbCrLf ' > xp
    Exit Do
   End If
  Loop
  If RetData = "" Then RetData = "pas de réponse" & vbCrLf
 End Property
End Class
 
'************************* hack to hide windows exec (side effect: hide echo too)
If InStr(1, WScript.FullName, "wscript.exe", vbTextCompare) > 0 Then
 With CreateObject("WScript.Shell")
   WScript.Quit .Run("cscript.exe """ & WScript.ScriptFullName & """", 0, True)
 End With
End If
'************************* end hack
 
Dim aDNS_IP,aDNS_Name
Dim oGetDSpeed
Dim sRep
aDNS_Name = Array("FreeDNS 1","FreeDNS 2","Verisign 1", "Verisign 2","FDN 1", "FDN 2",_
		"Comodo Secure DNS 1", "Comodo Secure DNS 2","OpenDNS 1","OpenDNS 2",_
		"DNS Advantage 1","DNS Advantage 2","Norton ConnectSafe 1","Norton ConnectSafe 2",_
		"OpenNIC 1","OpenNIC 2")
aDNS_IP = Array("37.235.1.174","37.235.1.177",_
                      "64.6.64.6","64.6.65.6",_
		"80.67.169.12","80.67.169.40",_
		"8.26.56.26","8.20.247.20",_
	           "208.67.222.222","208.67.220.220",_
		"156.154.70.1","156.154.71.1",_
		"199.85.126.10","199.85.127.10",_
		"50.116.40.226","50.116.23.211")
Set dTasksID = CreateObject("Scripting.Dictionary")
Set oGetDSpeed = New cTasks
For iPCount = 0 To 15
  IDProc = oGetDSpeed.Create("cmd /c ping -w 1000 " & aDNS_IP(iPCount))
  dTasksID.Add IDProc,True
Next
 
iTActive = 16
Do While iTActive > 0
  For Each iTask In dTasksID
    If (Not oGetDSpeed.IsRunning(iTask)) And dTasksID.Item(iTask) Then
     sRep = sRep & aDNS_Name(iTask) & " - " & aDNS_IP(iTask) & " - " & oGetDSpeed.RetData(iTask)
     dTasksID.Item(iTask) = False
     iTActive = iTActive - 1
   End If	
  Next
  WScript.Sleep 300
Loop
 
If Len(sRep) > 1024 Then
  Msgbox Left(sRep,1010) & " <ok> suite"
  Msgbox Mid(sRep,1010)
Else
  Msgbox sRep
End If