📜 ⬆️ ⬇️

"Multithreading" WSH VBScript

Crutch


Good all the time of day. I propose a crutch that implements a multithreading mechanism (or rather, "multiprocessing") for WSH VBScript. Not recommended for individuals allergic to indocode.
The first thought about the potential convenience of multithreading came once during the solution on a voluntary basis regarding a relatively simple task of processing and visualizing information. And, since installing an IDE like Visual Studio and our Helpdesk are incompatible concepts, only VBA and WSH remained “legal”. At that time the last one was chosen. And the current administrative restrictions and the desire to get friendly methods dictated the requirements for this implementation of multiprocessing:

Features:

Minuses:

Actually:


Light version of mproclite.vbs :


option explicit launch "base" ' main programm section sub base() startproc "msg" startproc "msg" startproc "msg" msgbox "base, id = " & id, 64 free id end sub sub msg() msgbox "msg, id = " & id, 64 free id end sub ' do not modify service section sub launch(byval destination) dim job executeglobal "dim scene, container, signature, subname, jobs, id, state, release" release = false if not wscript.arguments.named.exists("task") then dim elt executeglobal "dim found, lost" id = 0 found = 0 lost = 0 signature = "" randomize do signature = signature & hex(rnd * 16) loop while len(signature) < 16 set scene = me set jobs = createobject("Scripting.Dictionary") set jobs(0) = scene set container = getobject("new:{C08AFD90-F2A1-11D1-8455-00A0C91F3880}") container.putproperty signature, scene startproc destination on error resume next do until (lost >= found) or release for elt = found to 1 step -1 if typename(jobs(elt)) = "Object" then lost = lost + 1 jobs(elt) = empty end if err.clear wscript.sleep 1 next loop release = true executeglobal "scene_beforeterminate" for elt = found to 1 step -1 if typename(jobs(elt)) = "VBScriptTypeInfo" then jobs(elt).wscript.timeout = 1 jobs(elt).wscript.quit err.clear nojobs = false end if wscript.sleep 1 next container.quit else job = split(wscript.arguments.named("task"), ";") signature = cstr(job(0)) id = clng(job(1)) subname = cstr(job(2)) do for each container in createobject("Shell.Application").windows if isobject(container.getproperty(signature)) then exit do end if next wscript.sleep 1 loop set scene = container.getproperty(signature) set jobs = scene.jobs state = 4 set jobs(id) = me executeglobal subname state = 24 do until release wscript.sleep 10 loop state = 28 end if end sub function startproc(subname) startproc = createproc(subname) joint startproc, 4, 0 REM do while getstate(startproc) < 4 REM wscript.sleep 10 REM loop end function function createproc(subname) if me is scene then if not release then found = found + 1 createproc = found set jobs(createproc) = nothing createobject("WScript.Shell").exec("""" & wscript.fullname & """ """ & wscript.scriptfullname & """ ""/task:" & join(array(signature, createproc, subname), ";") & """") end if else createproc = scene.createproc(subname) end if end function function getjob(target) on error resume next if jobs.exists(target) then set getjob = jobs(target) if err.number = 0 then exit function err.clear end if set getjob = nothing end function sub share(varname, value) scene.newvar varname if isobject(value) then execute "set scene." & varname & " = value" else execute "scene." & varname & " = value" end if end sub sub newvar(varname) executecommand "dim " & varname end sub sub executecommand(command) executeglobal command end sub function getstate(target) dim elt if jobs.exists(target) then on error resume next set elt = jobs(target) getstate = elt.state if err.number <> 0 then if not(elt is nothing) then getstate = 64 else getstate = 1 end if end if set elt = nothing else getstate = 64 end if end function function isresponsive(target) isresponsive = cbool(getstate(target) and 28) end function sub free(target) if jobs.exists(target) then on error resume next jobs(target).release = true else dim elt, subname for elt = scene.found to 1 step -1 on error resume next subname = jobs(elt).subname if subname = target then free jobs(elt).id end if err.clear next end if end sub function joint(target, state, timeout) dim reftime reftime = timer on error resume next if jobs.exists(target) then if isnumeric(target) then do while getstate(target) < state if timeisout(timeout, reftime) then joint = false exit function end if wscript.sleep 10 loop else dim elt, subname for elt = scene.found to 1 step -1 subname = jobs(elt).subname err.clear if subname = target then do while getstate(target) < state if timeisout(timeout, reftime) then joint = false exit function end if wscript.sleep 10 loop end if err.clear next end if end if joint = true end function function timeisout(timeout, reftime) if timeout > 0 then dim delta delta = timer - reftime if delta < 0 then delta = delta + 86400 if delta > timeout then timeisout = true end if else timeisout = false end if end function sub interrupt(target, timeout) if jobs.exists(target) then on error resume next jobs(target).wscript.timeout = timeout jobs(target).wscript.quit else dim elt, subname for elt = scene.found to 1 step -1 on error resume next subname = jobs(elt).subname if subname = target then interrupt jobs(elt).id end if err.clear next end if end sub sub push(name, value) container.putproperty name, value end sub function pop(name) on error resume next if isobject(container.getproperty(name)) then set pop = container.getproperty(name) else pop = container.getproperty(name) end if end function 


Description:


Functions of the multiprocessing mechanism of the light version:
')
launch subname
It starts the service algorithm, the execution of the script always begins with its call.
subname - string, indicates the target sub, which will be executed in the new process.
Arguments of this method are used only in the initially running script to start executing the main code.
In each new script:

startproc (subname)
subname - see launch ().
Creates a new script process, expects its readiness to state 4 (see getstate ()) when you can access the Me object of the script. Returns a number - the id of the running script.

createproc (subname)
subname - see launch ().
Creates a new script process, without waiting, returns a number - the id of the running script. Used to create asynchronously several processes in a loop, without waiting for each to be ready. Noticeably faster than using startproc () for this application.

getjob (target)
target - number, script id or string, name of the subname group of scripts created.
Provides access to the Me object of the script. Returns a reference to the Me object of the script, if id is not found or the script is completed - Nothing.

getstate (target)
target - number, script id.
Defines the state of the script. Returns the number of the execution phase:
1 process created (new process exec),
4 script is running (initialized)
24 target sub completed
28 script released
64 not found (host not found), script completed (terminated).

isresponsive (target)
target - see getstate ().
Determines the availability of the Me object of the script (status 4 through 28). Returns a boolean value.

executecommand command
command is a string containing instructions.
Call an interpreter to execute statements in the global script space.

share varname, value
varname is a string containing the variable name, value is any value.
Declares in the global space of the first script a variable named varname, which becomes available to all scripts in the form of the scene property, assigns the contents of the variable to value.

newvar varname
varname is a string containing the variable name.
Declares a new variable in the global script space.

free target
target - number, script id or string, name of the subname group of scripts created. Allows completion of the script after the execution of the target sub'a. Works with a single script or group.

joint (target, state, timeout)
target — see free (), state — see getstate (), timeout — number, in seconds, in milliseconds.
Waiting for the state of the script state, for a group of scripts waiting lasts until everyone reaches the state. Waiting is limited by timeout, timeout = 0 means unlimited waiting. Returns a boolean value, True - the wait is complete, False is a timeout. Designed to synchronize the work of scripts. For example, if you need to wait for the launch of the script - 4, the full completion of the script - 64;

interrupt target, timeout
target - see free (), timeout - value for wscript.timeout, in seconds.
Translates the script to a regular completion, with the execution of the class_terminate methods. If dialog boxes were opened in the script, it will only be terminated after a timeout pause. The reappearance of the dialog box in the class_terminate methods will stop completion.

push name value
name - string, property name, value - any value.
Places the content of value in the GlobalContainer property named name.

pop (name)
name - string, property name.
Returns the content of the property named name from the GlobalContainer.

Full version of mproc.vbs :


 option explicit dim mproc set mproc = new multiprocess mproc.launch "base", "run", "" ' main programm section class base public sub run() host.startproc "msg", "run", "first" host.startproc "msg", "run", "second" host.startproc "msg", "run", "third" msgbox "base, id = " & host.id, 64 host.free host.id end sub end class class msg public sub run() msgbox host.aliasname & ", id = " & host.id, 64 host.free host.id end sub end class ' do not modify service class section class multiprocess public primary, ancestor, parent, process, err public names, execs, hosts public id, aid, isprimary public classname, methodname, aliasname public found, lost, active public state, permit, release private container, signature, wshshell public sub launch(startclassname, startmethodname, startaliasname) permit = false release = false executeglobal "dim scene, host, ancestor, process" if not isempty(host) then exit sub set host = me executeglobal "set host.err = err" executeglobal "function getroot: set getroot = me: end function" set parent = getroot isprimary = not wscript.arguments.named.exists("task") if isprimary then dim sample state = 24 randomize signature = "" do signature = signature & hex(rnd * 16) loop while len(signature) < 16 aid = empty id = 0 found = 0 lost = 0 set wshshell = createobject("WScript.Shell") set primary = host set ancestor = nothing set process = nothing set scene = parent set parent.ancestor = nothing set parent.process = nothing set hosts = createobject("Scripting.Dictionary") set execs = createobject("Scripting.Dictionary") set names = createobject("Scripting.Dictionary") classname = empty methodname = empty aliasname = empty set hosts(0) = host set container = getobject("new:{C08AFD90-F2A1-11D1-8455-00A0C91F3880}") container.putproperty signature, parent startproc startclassname, startmethodname, startaliasname on error resume next do for each sample in execs.keys if release or active = 0 then exit do if not (execs(sample) is nothing) then if execs(sample).status > 0 then abolish sample end if end if wscript.sleep 1 next loop release = true state = 28 scenequit else dim job job = split(wscript.arguments.named("task"), ";") signature = cstr(job(0)) do for each container in createobject("Shell.Application").windows if isobject(container.getproperty(signature)) then exit do end if next wscript.sleep 1 loop aid = clng(job(1)) id = clng(job(2)) found = null lost = null set scene = container.getproperty(signature) set primary = scene.host set hosts = primary.hosts set ancestor = hosts(aid) if isresponsive(aid) then set parent.ancestor = ancestor.parent.process else set parent.ancestor = nothing end if classname = cstr(job(3)) methodname = cstr(job(4)) aliasname = cstr(job(5)) state = 4 primary.implicate id, aliasname, host executeglobal "set process = new " & classname executeglobal "set host.process = process" executeglobal "set scene." & aliasname & " = process" if isresponsive(aid) then executeglobal "set host.ancestor.parent." & aliasname & " = process" end if state = 8 primary.staff host ancestorevent "oninitialized" state = 12 if methodname <> "" then do until permit wscript.sleep 10 loop state = 16 executeglobal "process." & methodname end if state = 20 ancestorevent "oncompleted" state = 24 do until release wscript.sleep 10 loop state = 28 end if end sub public default function startproc(classname, methodname, aliasname) set startproc = start(createproc(classname, methodname, aliasname)) end function public function createproc(classname, methodname, aliasname) if aliasname = "" then aliasname = classname newvar aliasname scene.host.newvar aliasname createproc = primary.spawn(id, classname, methodname, aliasname) end function public function spawn(issuer, classname, methodname, aliasname) if not release then found = found + 1 spawn = found active = found - lost names(spawn) = aliasname set hosts(spawn) = nothing if not hosts.exists(aliasname) then hosts.add aliasname, createobject("Scripting.Dictionary") end if set hosts(aliasname)(spawn) = nothing execs.add spawn, wshshell.exec("""" & wscript.fullname & """ """ & wscript.scriptfullname & """ ""/task:" & join(array(signature, issuer, spawn, classname, methodname, aliasname), ";") & """") end if end function public function start(target) select case outline(target) case "Nothing", "multiprocess" do while getstate(target) < 12 wscript.sleep 10 loop if isresponsive(target) then set start = hosts(target).process hosts(target).permit = true else set start = nothing end if case "Dictionary" dim elt set start = hosts(target) for each elt in start.keys do while getstate(elt) < 12 wscript.sleep 10 loop next for each elt in start.keys if isresponsive(elt) then hosts(elt).permit = true end if next case else set start = nothing end select end function public sub implicate(id, aliasname, host) set hosts(aliasname)(id) = host set hosts(id) = host end sub public sub staff(host) set hosts(host.process) = host end sub public sub abolish(id) if hosts.exists(names(id)) then hosts(names(id))(id) = empty end if names(id) = empty if isresponsive(id) then hosts(hosts(id).process) = empty end if hosts(id) = empty set execs(id) = nothing lost = lost + 1 active = found - lost end sub private sub ancestorevent(eventname) if aid > 0 then on error resume next executeglobal "ancestor." & aliasname & "_" & eventname & " host.hosts(" & id & ")" if err.number = 424 or err.number = 438 then err.clear end if end sub public sub assignhandler(handlername, byval varsqty) dim vars vars = "" if varsqty > 0 then do vars = vars & "param" & varsqty varsqty = varsqty - 1 if varsqty = 0 then exit do vars = vars & ", " loop end if executeglobal "sub " & handlername & "(" & vars & "): process." & handlername & " " & vars & ": end sub" end sub public sub newvar(varname) executecommand "dim " & varname end sub public sub executecommand(command) executeglobal command end sub public function getstate(target) select case outline(target) case "multiprocess" on error resume next getstate = hosts(target).state if err.number <> 0 then err.clear getstate = 64 end if case "Nothing" getstate = 1 case "Dictionary" getstate = null case empty getstate = 0 case else getstate = 64 end select end function private function outline(target) on error resume next if hosts.exists(target) then outline = typename(hosts(target)) if err.number <> 0 then err.clear outline = "Object" end if else outline = empty end if end function public function isresponsive(target) isresponsive = cbool(getstate(target) and 28) end function public function getid(target) on error resume next if isobject(target) then if isresponsive(target) then getid = hosts(target).id if err.number = 0 then exit function err.clear end if elseif primary.execs.exists(target) then getid = target exit function end if getid = null end function public function gethost(target) on error resume next if hosts.exists(target) then set gethost = hosts(target) if err.number = 0 then exit function err.clear end if set gethost = nothing end function public sub free(target) select case outline(target) case "multiprocess" on error resume next gethost(target).release = true err.clear case "Dictionary" dim elt for each elt in gethost(target) free(elt) next end select end sub public function joint(target, state, timeout) dim reftime reftime = timer select case outline(target) case "multiprocess", "Nothing" do while getstate(target) < state if timeisout(timeout, reftime) then joint = false exit function end if wscript.sleep 10 loop case "Dictionary" dim elt for each elt in gethost(target) do while getstate(elt) < state if timeisout(timeout, reftime) then joint = false exit function end if wscript.sleep 10 loop next end select joint = true end function private function timeisout(timeout, reftime) if timeout > 0 then dim delta delta = timer - reftime if delta < 0 then delta = delta + 86400 if delta > timeout then timeisout = true end if else timeisout = false end if end function public sub interrupt(target, timeout) select case outline(target) case "multiprocess" on error resume next with gethost(target).parent .wscript.timeout = timeout .wscript.quit end with err.clear case "Dictionary" dim elt for each elt in gethost(target) interrupt elt, timeout next end select end sub public sub kickout(target) if primary.execs.exists(target) then if getstate(target) < 64 then on error resume next primary.execs(target).terminate err.clear end if else select case outline(target) case "multiprocess" kickout getid(target) case "Dictionary" dim elt for each elt in gethost(target) kickout(elt) next end select end if end sub public sub terminate(target) interrupt target, 1 if not joint(target, 64, 2) then kickout target end sub public sub push(name, value) container.putproperty name, value end sub public function pop(name) on error resume next if isobject(container.getproperty(name)) then set pop = container.getproperty(name) else pop = container.getproperty(name) end if end function private sub scenequit if isprimary then dim col, i, status col = execs.keys for i = ubound(col) to 0 step -1 interrupt col(i), 1 next wscript.sleep 2000 on error resume next for i = ubound(col) to 0 step -1 status = execs(col(i)).status if err.number = 0 and status = 0 then execs(col(i)).terminate err.clear next container.quit end if end sub private sub class_terminate() if state < 28 and isprimary then scenequit end sub end class 


Description:


Class methods multiprocess :

launch classname, methodname, aliasname
It starts the service algorithm, the execution of the script always begins with its call.
classname, methodname, aliasname - strings. Specify the target class classname and the method of this class methodname, which will be executed in the new process, an instance of the classname class will be placed in a variable named aliasname (or classname if aliasname is the empty string).
Arguments of this method are used only in the initially running script to start executing the main code.
In each new script:

startproc (classname, methodname, aliasname)
classname, methodname, aliasname - see launch ().
Creates a new script process, expects its readiness to state 12 (see getstate ()), runs the target method. Returns a reference to an instance of the target class initialized in a new process.

createproc (classname, methodname, aliasname)
classname, methodname, aliasname - see launch ().
Creates a new script process, without waiting, returns its id. Used to create asynchronously several processes in a loop, without waiting for each to be ready. Noticeably faster than using startproc () for this application.

start (target)
target - number, script id, or string, name aliasname of the group of scripts created.
Waiting for a script created using createproc (), to state 12, to allow execution of the target method. You can use for a group of scripts with the same aliasname. For one script, returns a reference to its initialized instance of the target class, for a group of scripts, returns a reference to the sub-dictionary containing all host data with aliasname.

gethost (target)
target is the number, script id or string, the name of the aliasname group of scripts created, or the process object of the script.
Provides access to the host instance of the multiprocess class of the required script. For a single script, returns a reference to its host, for a group of scripts, returns a reference to a sub-dictionary containing all host data aliasname, if id is not found or the script is completed - Nothing.

getid (target)
target is the number, script id, or process object of the script.
Returns the script id defined by the process object. Only for valid scripts.

getstate (target)
target - see getid ().
Defines the state of the script. Returns the number of the execution phase:
0 not found (host not found),
1 process created (new process exec),
4 host initialized (host initialized),
8 target class initialized (process initialized),
12 target class initialized, event processed (process initialized handled),
16 target method launched (process method launched),
20 target method completed (process completed),
24 target method completed, event processed (process completed handled),
28 script released
64 script terminated.

isresponsive (target)
target - see getid ().
Determines the accessibility of the host object of the script (status 4 through 28). Returns a boolean value.

assignhandler handlername, varsqty
handlername - string, event name, varsqty - number, number of arguments passed.
In the global space, it creates a sub event handler with the name of the handlername event and associates it with the method of the same name in the created process object. When an event occurs, the handler will redirect the call to process. handlername ().

executecommand command
command is a string containing instructions.
Call an interpreter to execute statements in the global script space.

newvar varname
varname is a string containing the variable name.
Declares a new variable in the global script space.

free target
target - see gethost ().
Allows completion of the script after the execution of the target method Works with a single script or group.

joint (target, state, timeout)
target — see gethost (); state — see getstate (), timeout — number, in seconds, in milliseconds.
Waiting for the state of the script state, for a group of scripts waiting lasts until everyone reaches the state. Waiting is limited by timeout, timeout = 0 means unlimited waiting. Returns a boolean value, True - the wait is complete, False is a timeout. Designed to synchronize the work of scripts. For example, if you need to wait for the creation of a process object - 8, the script is fully completed - 64;

interrupt target, timeout
target - see gethost (), timeout - value for wscript.timeout, in seconds.
Translates the script to a regular completion, with the execution of the class_terminate methods. If dialog boxes were opened in the script, it will only be terminated after a timeout pause. The reappearance of the dialog box in the class_terminate methods will stop completion.

kickout target
target - see gethost ().
Terminates the script process at the OS level using wshexec.terminate. Possible long-term execution, up to 2 seconds for each script. Works with a single script or group.

terminate target
target - see gethost ().
Ends the script, uses interrupt first, then kickout if necessary.

push name value
name - string, property name, value - any value.
Places the content of value in the GlobalContainer property named name.

pop (name)
name - string, property name.
Returns the content of the property named name from the GlobalContainer.

Methods that can be placed in the target class of this script as handlers for the initialization of the target class and the execution of the target method of the running script:

<aliasname> _ oninitialized (source)
source - the host object of the script that called the method passed to the method, its aliasname is contained in the method name. The method is called after the initialization of the target class of the running script (state = 8).

<aliasname> _ oncompleted (source)
source - the host object of the script that called the method passed to the method, its aliasname is contained in the method name. The method is called after the execution of the target method of the running script (state = 20).

Example:


For mproclite and mproc , the work is illustrated by the example of an abstract task: for each character from the letters string, separate processes are created, each in a loop placing its character into the buffer, as it is filled in by another process, 3 “words” are output to the console. For WScript, the console is simulated by the IE window. Along the way, running and stopped OS processes are displayed (in the example, WMI is used, but it is not necessary for the mechanism to function).
During the debug, I have accumulated some observations and comments, with which I will share if there is a demand - the fact is that it will take time to bring them into a readable form. Constructive criticism is welcome.

Source: https://habr.com/ru/post/189786/


All Articles