×
INTELLIGENT WORK FORUMS
FOR COMPUTER PROFESSIONALS

Log In

Come Join Us!

Are you a
Computer / IT professional?
Join Tek-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!
  • Students Click Here

*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Students Click Here

Jobs

vbscript to multithread execution of imacros

vbscript to multithread execution of imacros

vbscript to multithread execution of imacros

(OP)
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...

CODE --> VBS

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 

RE: vbscript to multithread execution of imacros

sample of (pseudo) multithread :


CODE --> vbscript

' GetDNSSpeed - multithreading demo - omen999 october 2017 - http://omen999.developpez.com/
' 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 

Red Flag This Post

Please let us know here why this post is inappropriate. Reasons such as off-topic, duplicates, flames, illegal, vulgar, or students posting their homework.

Red Flag Submitted

Thank you for helping keep Tek-Tips Forums free from inappropriate posts.
The Tek-Tips staff will check this out and take appropriate action.

Reply To This Thread

Posting in the Tek-Tips forums is a member-only feature.

Click Here to join Tek-Tips and talk with other members!

Close Box

Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close