run: PROCEDURE EXPOSE option. cmd. cpt. divu$. dive$. divr$.
USE ARG cmd,mylist.
starttime=TIME('R')
CALL init
IF option.server='NO' THEN CALL noserver
CALL initclip
CALL readparms
option.keepalso=0
option.kept=''
option.keep=''
DROP cmd.
servertime=TIME('E')
CALL sendreceive
resulttime=TIME('E')
IF ARG(2,'E')=0 THEN CALL mpoutdd(mylist.)
displaytime=TIME('E')
CALL writelog
IF option.echo=1 THEN SAY ptime() LEFT(cmd 'ended 'COPIES('.',50),50)
RETURN 0
initclip:
LIBRARY rxclip
mpout='MPOUT'RANDOM(1,1000)
dictin=clipnewformat('MPIN'DIRECTORY())
mympout=clipnewformat(mpout)
dictoken='MPSF'hash(DIRECTORY(),99999)
retcount=0
IF EXISTS('cpt.ServerStarted')=1 THEN IF cpt.serverstarted=1 THEN RETURN
ELSE NOP
ELSE IF lock('TESTEXCLUSIVE',servermode)=0 THEN DO
CALL startserver
cpt.serverchecked=1
END
ELSE DO
cpt.serverchecked=1
END
RETURN
startserver:
PARSE ARG reason
SAY ptime()' Automatic start of Server'
waitr=30
sleepi=0.511
rexdir=VALUE('HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\App Paths\RxLaunch.exe\Path', ,"WIN32")
ITERATEEXE(rexdir'RXLAUNCH','VarServer.REX',,,,'M')
DO i=1 TO waitr
SLEEP(sleepi)
IF lock('TESTEXCLUSIVE',servermode'Start')=0 THEN LEAVE
END
IF i<waitr THEN SAY ptime()' Server started'
ELSE DO
SAY ptime()' Server not started'
EXIT 8
END
RETURN
init:
IF EXISTS('option.server')=0 THEN option.server='YES'
IF EXISTS('option.echo')=0 THEN option.echo=1
IF option.echo=1 THEN SAY ptime() LEFT(cmd 'started 'COPIES('.',50),50)
option.mprout=1
servermode='Variable Server'
RETURN
readparms:
incmd=TRANSLATE(cmd,,"()")
cmdx=WORD(incmd,1)
cmdv=''
wrds=WORDS(incmd)
DROP myvar.
mylist.1=''
myvar.2=getoption()
myvar.2=myvar.2' ; 'getcmd()
myvar.3=cmdx
j=3
DO i=2 TO wrds
j=i+2
myvar.j=WORD(incmd,i)
cmdv=cmdv||word(incmd,i)' '
END
myvar.0=j
myvar.1=mpout' 'j
option.keep=''
RETURN
getoption:
sendstem=''
DO vars OVER option.
sendstem=sendstem' option.'vars"='"VALUE('option.'vars)"' ;"
END
RETURN sendstem
getcmd:
sendstem=''
DO vars OVER cmd.
sendstem=sendstem' cmd.'vars"='"VALUE('cmd.'vars)"' ;"
END
RETURN sendstem
testgetvar:
USE ARG tvar,default
default=ARG(2)
IF EXISTS(tvar)=1 THEN RETURN VALUE(tvar)
tvar=TRANSLATE(tvar)
IF EXISTS(tvar)=0 THEN RETURN default
ELSE RETURN VALUE(tvar)
sendreceive:
clipset("MyVar.", dictin)
evt=eventcreate(servermode,2710)
IF evt \=2710 THEN DO
SAY 'Server did not respond, correctly: 'evt
EXIT 8
END
clipget("MyLIST.", mympout)
IF EXISTS('myLIST.0')=0 THEN DO
SAY cmd' did not produce any output'
EXIT 8
END
lastline=mylist.0
mylist.0=WORD(mylist.lastline,2)
mpsftime=WORD(mylist.lastline,3)
RETURN
mpoutdd:
USE ARG mylist.
IF DATATYPE(mylist.0)\='NUM' THEN mylist.0=0
DO i=1 TO mylist.0-1
SAY mylist.i
END
IF mylist.0<2 THEN SAY cmd' did not produce any output'
RETURN
writelog:
transtime=displaytime
sendtime=servertime-starttime
servtime=resulttime-servertime
outtime=displaytime-resulttime
IF EXISTS('option.logtime')=0 THEN option.logtime=0
IF option.logtime=1 THEN DO
SAY '..... Transaction time log .....'
SAY 'Transaction ' xtime(transtime)
SAY 'Send command to Server ' xtime(sendtime)
SAY 'Server perform and send ' xtime(servtime)
SAY 'Real Server usage ' xtime(mpsftime)
SAY 'display output ' xtime(outtime)
END
RETURN
noserver:
IF EXISTS('dive$.next_extension')=0 THEN CALL divin('DIV')
option.mprout=1
incmd=TRANSLATE(cmd,,"()")
cmdx=WORD(incmd,1)
cmdv=WORD(incmd,2)
PARSE VALUE cmdv WITH p0 p1 p2 p3 p4 p5
keepin=testgetvar('option.kept','DUMMYIN')'.'
keepout=testgetvar('option.keep','DUMMYOUT')'.'
INTERPRET 'procedure expose keepout'
SAY cmdx'-'cmdv
SAY 'call 'cmdx'('keepout','keepin',p0,p1,p2,p3,p4,p5)'
INTERPRET 'call 'cmdx'('keepout','keepin',p0,p1,p2,p3,p4,p5)'
SAY 'Members Kept in 'keepout VALUE(keepout'0')
CALL mpoutdd(mpout.)
DROP cmd.
EXIT 0
xtime: PROCEDURE
PARSE ARG intime
IF intime=0 THEN RETURN '0.000'
IF SUBSTR(intime,1,1)='.' THEN intime='0'||intime
inlen=LENGTH(intime)
IF inlen>2 THEN IF SUBSTR(intime,inlen-2,3)='000' THEN intime=SUBSTR(intime,1,inlen-3)
RETURN intime
ptime: PROCEDURE
ptime=TIME('l')
len=LENGTH(ptime)-3
RETURN SUBSTR(ptime,1,len)
hash:procedure
PARSE ARG text,maxvalue
len=LENGTH(text)
sqs=0
DO i=1 TO len BY 4
sqs=sqs+c2d(SUBSTR(text,i,4))
END
IF sqs>maxvalue THEN sqs=sqs//maxvalue
RETURN sqs
lock: PROCEDURE
PARSE ARG mode,resource
lockfile=DIRECTORY()'\'resource'.lck'
IF ABBREV('EXCLUSIVE',mode)=1 THEN DO
IF STREAM(lockfile, "C", "OPEN WRITE REPLACE")='READY:' THEN RETURN 0
ELSE RETURN 8
END
IF ABBREV('TESTEXCLUSIVE',mode)=1 THEN DO
IF STREAM(lockfile, "C", "OPEN WRITE REPLACE")='READY:' THEN DO
STREAM(lockfile, "C", "CLOSE")
RETURN 0
END
ELSE RETURN 8
END
IF ABBREV('RELEASE',mode)=1 THEN DO
SAY STREAM(lockfile, "C", "CLOSE")
DELETEFILE(lockfile)
RETURN 0
END
eventcreate: PROCEDURE
PARSE ARG windowtitle,event,p0,p1
LIBRARY rexxgui
FUNCDEF('FindWindowA', 'void, str, str', 'user32', , 'o 0')
target = findwindowa('rexxgui', windowtitle)
IF target=='' THEN RETURN -2
guisendmsg(target, event, p0,p1)
IF EXISTS('guisignal')=0 THEN RETURN -1
RETURN guisignal
|
|