Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- option explicit
- dim mproc
- set mproc = new multiprocess
- mproc.launch "base", "run", ""
- ' main programm section
- class base
- public sndfolder
- private message
- public sub run()
- dim elt, wmpqty
- sndfolder = createobject("Shell.Application").namespace(&h0).self.path & "\tts\session" & left(createobject("Scriptlet.TypeLib").guid, 38) & "\"
- smartcreatefolder sndfolder
- wmpqty = inputbox("Number of talking uids")
- message = wmpqty & " talking UIDs" & vbcrlf & vbcrlf
- for elt = 0 to wmpqty - 1
- host.createproc "playspeech", "run", ""
- next
- host.joint "playspeech", 25, 0
- for each elt in host.gethost("playspeech")
- host.hosts(elt).process.wmp.controls.play
- next
- wscript.echo message
- for each elt in host.gethost("playspeech")
- do while host.hosts(elt).process.wmp.playstate = 3
- wscript.sleep 10
- loop
- next
- host.free host.id
- end sub
- public sub playspeech_oninitialized(src)
- src.permit = true
- end sub
- public sub pushmessage(uid)
- message = message & uid & vbcrlf
- end sub
- private sub smartcreatefolder(strfolder)
- with createobject("Scripting.FileSystemObject")
- if not .folderexists(strfolder) then
- smartcreatefolder(.getparentfoldername(strfolder))
- .createfolder(strfolder)
- end if
- end with
- end sub
- end class
- class playspeech
- public wmp
- public sub run()
- dim uid, path
- uid = left(createobject("Scriptlet.TypeLib").guid, 38)
- scene.base.pushmessage uid
- path = scene.base.sndfolder & uid & ".mp3"
- filedownload "http://translate.google.com/translate_tts?ie=UTF-8&tl=en&q=" & encodeuricomponent(uid), path
- set wmp = createobject("WMPlayer.OCX")
- wmp.url = path
- wmp.controls.stop
- host.state = 25
- host.joint "base", 24, 0
- host.free host.id
- end sub
- private sub filedownload(url, path)
- dim body
- on error resume next
- do
- with createobject("Microsoft.XMLHTTP")
- .open "GET", url, false
- .send
- body = .responsebody
- end with
- if err = 0 then exit do
- err.clear
- loop
- with createobject("Adodb.Stream")
- .type = 1
- .open
- .write body
- .savetofile path, 2
- .close
- end with
- end sub
- private function encodeuricomponent(text)
- with createobject("htmlfile")
- with .parentwindow
- .execscript ";", "jscript"
- encodeuricomponent = .encodeuricomponent(text)
- end with
- end with
- end function
- 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
Add Comment
Please, Sign In to add comment