home *** CD-ROM | disk | FTP | other *** search
- /*======================================================================
- PCBOARD.CMD 1.00 09/22/91 PCBoard universal logon script
- for Multi-Net's PMcomm 1.09, under IBM OS/2 1.30 REXX.
- Copyright (C) 1991 Brad Berson, Insane Software.
- Attach to appropriate PMcomm dialing entries, change the
- variables as directed on the next few lines and edit
- BBS' and passwords into the GetBbs section for full operation.
- ======================================================================*/
-
- CALL RxFuncadd "init_dll","RxPmcomm","init_dll"
- PARSE ARG port portname screen_handle dde_output dde_input semaphore
- PARSE SOURCE . . fn .
- CALL init_dll
- name='BRAD BERSON' /* <- your own name here */
- qdir='C:\COMM\QMAIL\' /* <- dir for Qmail files */
- autoff='YES' /* <- auto-off aft mail, xfers */
- delmail='YES' /* <- auto del QWK/REP files */
- filelist='C:\COMM\UPDOWN\UPDOWN.LST' /* <- name of file xfer list */
- qmail='NO X X'
- qupdn='N'
- pwdcnt=0
- namcnt=0
- cr='0d'x
- crlf='0d0a'x
- bs='08'x
- esc='1b'x
- scp=esc||'[s'
- rcp=esc||'[u'
- sred=esc||'[31;1m'
- swit=esc||'[0;1m'
- errl=esc||'[25;1H'
- odir=Directory()
- CALL Read_timeout '20000',port
- SIGNAL ON SYNTAX NAME RexxErr
- SIGNAL ON NOVALUE NAME RexxErr
- SIGNAL ON HALT NAME ExitScr
- CALL ON ERROR NAME HostErr
- CALL ON FAILURE NAME HostErr
- DO 3
- CALL Beep 1000,200
- CALL Beep 1200,200
- END
-
- Start:
- DO FOREVER
- match=Wait_fore('change?','graphics','NS)?','rst name',,
- port,screen_handle)
- SELECT
- WHEN match=0 THEN
- SIGNAL Errh
- WHEN match=1 THEN
- CALL Put_s '1'||cr,port
- WHEN match=2 THEN
- CALL Put_s 'Y Q N'||cr,port
- WHEN match=3 THEN
- CALL Put_s 'N'||cr,port
- WHEN match=4 THEN
- LEAVE
- OTHERWISE NOP
- END
- END
-
- Inam:
- CALL Put_s name||cr,port
- DO FOREVER
- match=Wait_fore('t found in us','rect?','rong pass','ssword','nce Co',,
- 'tinue','(Ent',', Mor','N)','NS)?','ard Command',port,screen_handle)
- CALL Put_s sred||match||swit,screen_handle /* debug! */
- SELECT
- WHEN match=0 THEN
- SIGNAL Errh
- WHEN match=1 THEN DO
- IF namcnt>2 THEN CALL Errh
- CALL Put_s name||cr,port
- namcnt=namcnt+1 ; END
- WHEN match=2 THEN
- CALL Put_s 'Y'||cr,port
- WHEN match=3 THEN DO
- IF pwdcnt>2 THEN CALL Errh
- CALL Put_s pword||cr,port
- pwdcnt=pwdcnt+1 ; END
- WHEN match=4 THEN DO
- CALL Flush
- CALL GetBbs
- CALL Put_s pword||cr,port
- pwdcnt=pwdcnt+1 ; END
- WHEN match=5 THEN
- CALL Put_s 'A'||cr,port
- WHEN match>5 & match<11 THEN
- CALL Put_s 'N'||cr,port
- WHEN match=11 THEN
- LEAVE
- OTHERWISE NOP
- END
- END
- CALL Flush
- PARSE VAR qmail doqmail packet xprot
- IF doqmail='YES' THEN
- CALL CheckMail
- IF filelist\='' THEN
- filelist=Stream(filelist,'c','query exists')
- IF qupdn\='N' THEN DO
- CALL Qmail
- IF autoff='YES' & filelist='' THEN CALL LogOff
- END
- IF filelist\='' THEN DO
- IF qupdn\='N' THEN CALL QuitMail
- CALL PcboardXfer
- IF autoff='YES' THEN CALL LogOff
- END
- DO 3 ; CALL Beep 800,300 ; END
- EXIT
-
- /*====================[HANDLE QMAIL]====================*/
- /* Downloads & uploads Qmail packets and pointer and */
- /* key files depending on existence of each file */
- /* Must have Qmail door configured for extended prompts */
- /*======================================================*/
-
- Qmail:
- CALL Delay
- CALL Put_s 'QMAIL4'||cr,port
- DO FOREVER
- match=Wait_fore('NS)?','any key','<COMMAND>',port,screen_handle)
- CALL Put_s sred||match||swit,screen_handle /* debug! */
- SELECT
- WHEN match=0 THEN
- SIGNAL Errh
- WHEN match=1 THEN
- CALL Put_s ' ',port
- WHEN match=2 THEN
- CALL Put_s 'N'||cr,port
- OTHERWISE LEAVE
- END
- END
-
- pathn=qdir
- IF ptrfile\='' THEN DO /*send pointer file*/
- CALL Put_s 'R'||cr,port
- CALL Wait_fore '<PTRUP>',port,screen_handle
- IF result=0 THEN SIGNAL Errh
- dpfname=ptrfile ; xcmd='U' ; CALL DoXfer
- CALL Wait_fore '<PTRFILE>',port,screen_handle
- IF result=0 THEN SIGNAL Errh
- CALL Put_s '1'||cr,port
- CALL Wait_fore '<COMMAND>',port,screen_handle
- IF result=0 THEN SIGNAL Errh
- END
-
- IF keyfile\='' THEN DO /*send key file*/
- CALL Put_s 'K'||cr,port
- CALL Wait_fore '<KEYUP>',port,screen_handle
- IF result=0 THEN SIGNAL Errh
- dpfname=keyfile ; xcmd='U' ; CALL DoXfer
- CALL Wait_fore '<COMMAND>',port_screen_handle
- IF result=0 THEN SIGNAL Errh
- END
-
- IF qupdn='D' | qupdn='B' THEN DO /*download Qmail file*/
- CALL Read_timeout '480000',port
- CALL Put_s 'D'||cr,port
- DO FOREVER
- match=Wait_fore('<NO TRANSFER>','<NO TIME>','<DLASK>','<DOWNLOAD>',,
- '<COMMAND>','<DL ERROR>','<DL SUCCESS>',port,screen_handle)
- SELECT
- WHEN match=0 THEN
- SIGNAL Errh
- WHEN match=1 | match=2 THEN
- LEAVE
- WHEN match=3 THEN
- CALL Put_s 'Y'||cr,port
- WHEN match=4 THEN DO
- filen=qwkfile ; xcmd='D'
- CALL DoXfer ; END
- WHEN match=5 THEN
- LEAVE
- WHEN match=6 THEN DO
- CALL Put_s crlf||"QWK DL FAILED"||crlf,screen_handle
- qwksucc=0 ; END
- WHEN match=7 THEN
- qwksucc=1
- OTHERWISE NOP
- END
- END
- END
-
- IF qupdn='U' | qupdn='B' THEN DO /*upload reply file*/
- CALL Read_timeout '60000',port
- CALL Put_s 'U'||cr,port
- DO FOREVER
- match=Wait_fore('<UPLOAD>','<UP ERROR>','S NOT INSERTED>',,
- 'S INSERTED>','<UP SUCCESS>','<COMMAND>',port,screen_handle)
- SELECT
- WHEN match=0 THEN
- SIGNAL Errh
- WHEN match=1 THEN DO
- dpfname=repfile ; xcmd='U'
- CALL DoXfer ; END
- WHEN match=2 | match=3 THEN DO
- CALL Put_s crlf||"REP UL FAILED"||crlf,screen_handle
- repsucc=0 ; END
- WHEN match=4 & delmail='YES' THEN DO
- shellcmd='DEL '||repfile||'> NUL'
- ADDRESS CMD shellcmd
- IF qupdn='U' THEN DO
- shellcmd='DEL '||qwkfile||'> NUL'
- ADDRESS CMD shellcmd ; END
- /* delete REP, and QWK if 'U' */
- repsucc=1 ; END
- WHEN match=6 THEN
- LEAVE
- OTHERWISE NOP
- END
- END
- END
- CALL Flush
- RETURN
-
- QuitMail:
- CALL Read_timeout '20000',port
- CALL Put_s 'Q'||cr,port
- DO FOREVER
- match=Wait_fore('echo','ommand',port,screen_handle)
- SELECT
- WHEN match=0 THEN
- SIGNAL Errh
- WHEN match=1 THEN
- CALL Put_s pword||cr,port
- WHEN match=2 THEN
- LEAVE
- OTHERWISE NOP
- END
- END
- CALL Flush
- RETURN
-
- CheckMail: /*Checks existence of Qmail files*/
- repfile=Stream(qdir||packet||'.REP','c','query exists')
- qwkfile=Stream(qdir||packet||'.QWK','c','query exists')
- ptrfile=Stream(qdir||packet||'.PTR','c','query exists')
- keyfile=Stream(qdir||packet||'.KEY','c','query exists')
- IF qwkfile\='' & repfile='' THEN qupdn='N'
- IF qwkfile='' & repfile='' THEN qupdn='D'
- IF qwkfile='' & repfile\='' THEN qupdn='B'
- IF qwkfile\='' & repfile\='' THEN qupdn='U'
- RETURN
-
- /*====================[PERFORM LOGOFF]====================*/
- /* Gets past logoff verification and questionnaires, etc. */
- /* until it sees "NO CARRIER" status report from modem */
- /*========================================================*/
-
- LogOff:
- CALL Delay
- CALL Read_timeout '20000',port
- CALL Put_s 'G Q'||cr,port
- DO FOREVER
- match=Wait_fore('--)','? (','(Enter)','ogoff?',,
- 'any key','NO CARRIER',port,screen_handle)
- SELECT
- WHEN match=0 THEN
- SIGNAL Errh
- WHEN match>0 & match<4 THEN
- CALL Put_s cr,port
- WHEN match=4 THEN
- CALL Put_s 'Y'||cr,port
- WHEN match=5 THEN
- CALL Put_s ' ',port
- WHEN match=6 THEN
- LEAVE
- OTHERWISE NOP
- END
- END
- DO 3 ; CALL Beep 800,300 ; END
- EXIT
-
- /*====================[UPLOADS AND DOWNLOADS]====================*/
- /* Parse and execute PCBoard file xfer commands from list file */
- /*===============================================================*/
-
- PcboardXfer:
- CALL Sleep '5000'
- DO WHILE Lines(filelist)\=0
- CALL Read_timeout '30000',port
- cmdline=Linein(filelist)
- IF cmdline='' THEN ITERATE
- PARSE VAR cmdline xcmd xprot xfile xdesc
- IF xcmd='D' THEN DO
- IF xprot\='' & xfile\='' THEN
- CALL XferCmds
- END
- IF xcmd='U' THEN DO
- IF xprot\='' & xfile\='' & xdesc\='' THEN
- CALL XferCmds
- END
- END
- CALL Flush
- RETURN
-
- XferCmds:
- drivn=Filespec('drive',xfile)
- pathn=Filespec('path',xfile)
- filen=Filespec('name',xfile)
- pathn=drivn||pathn
- dpfname=Stream(pathn||filen,'c','query exists')
- IF xcmd='D' & dpfname\='' THEN DO
- CALL Put_s crlf||pathn||filen||' ALREADY EXISTS'||crlf,screen_handle
- RETURN ; END
- IF xcmd='U' & dpfname='' THEN DO
- CALL Put_s crlf||pathn||filen||' NOT FOUND'||crlf,screen_handle
- RETURN ; END
- CALL Put_s xcmd filen xprot cr,port
- DO FOREVER
- match=Wait_fore('ot Accept','plicates','exists','not found','upload!',,
- 'p upload in','ription wi','Aborts','ommand','nter)',,
- 'erifying',port,screen_handle)
- SELECT
- WHEN match=0 THEN
- SIGNAL Errh
- WHEN match=6 THEN
- CALL Put_s 'Y'||cr,port
- WHEN match=7 THEN
- CALL Put_s xdesc||cr||cr,port
- WHEN match=8 THEN
- CALL DoXfer
- WHEN match=9 THEN
- LEAVE
- WHEN match=10 THEN
- CALL Put_s cr,port
- WHEN match=11 THEN
- CALL Read_timeout '120000',port
- OTHERWISE NOP
- END
- END
- RETURN
-
- DoXfer:
- SELECT
- WHEN xprot='Z' & xcmd='U' THEN DO
- CALL zmodem_send dpfname,dde_output,dde_input ; END
- WHEN xprot='Z' & xcmd='D' THEN DO
- CALL Set_download_path pathn,dde_output
- CALL zmodem_receive dde_output,dde_input ; END
- OTHERWISE CALL Put_s crlf||sred||'XFER CALL ERROR',
- crlf||swit,screen_handle ; END
- RETURN
-
- /*====================[HANDLE ERRORS]====================*/
- /* Print error message and yell, drop carrier if timeout */
- /*=======================================================*/
-
- RexxErr:
- IF 'rc'=rc THEN rc='undefined'
- CALL Put_s crlf||sred||'REXX ERROR' rc 'in line' sigl ':',screen_handle
- CALL Put_s Errortext(rc)||crlf||Sourceline(sigl)||swit||crlf,screen_handle
- CALL Beep 40,2000
- CALL Directory odir
- CALL Sleep '30000'
- CALL Drop_dtr port
- CALL Sleep '2000'
- CALL Raise_dtr port
- EXIT
-
- Errh:
- CALL Put_s crlf||sred||'SCRIPT ERROR in line 'sigl||swit||crlf,screen_handle
- DO 30 ; CALL Beep 1800,100 ; END
- CALL Directory odir
- CALL Sleep '30000'
- CALL Drop_dtr port
- CALL Sleep '2000'
- CALL Raise_dtr port
- EXIT
-
- HostErr:
- IF 'rc'=rc THEN rc='undefined'
- CALL Put_s crlf||sred||'HOST CMD ERROR' rc 'in line' sigl ':',screen_handle
- CALL Put_s Errortext(rc)||crlf||Sourceline(sigl)||swit||crlf,screen_handle
- CALL Beep 40,2000
- CALL Directory odir
- RETURN
-
- ExitScr:
- DO 3 ; CALL Beep 800,300 ; END
- CALL Put_s crlf||'PCBOARD.CMD Terminated at line 'sigl||crlf,screen_handle
- CALL Directory odir
- EXIT
-
- Flush:
- DO WHILE Char_avail(port)>0
- CALL Put_s Get_ch(port),screen_handle
- END
- RETURN
-
- Delay:
- DO 5
- CALL Sleep '1000'
- CALL Beep 2000,50
- END
- RETURN
-
- /*====================[GET BBS PWORD]====================*/
- /* Searches scrollback buffer for BBS ID line before the */
- /* PCBoard version ID line, sets password and qmail vars */
- /* May fail due to line noise, handshake problems, etc. */
- /*=======================================================*/
-
- GetBbs:
- currow=Get_cursor_position('row',dde_output,dde_input)
- found=0
- DO lcnt=currow-1 TO currow-100 BY -1 UNTIL found>0 | currow=0
- line=Get_char_at(lcnt,0,40,dde_output,dde_input)
- found=Pos('PCBoard (R)',line)
- END
- line=Get_char_at(lcnt-1,0,40,dde_output,dde_input)
- line=Translate(line)
- SELECT
- WHEN Pos('INVENTION',line)\=0 THEN DO
- pword='PASSWORD' /* your password for BBS */
- qmail='YES INV-FAC Z' ; END /* YES, packet name, protocol */
- WHEN Pos('ACE PREMIUM',line)\=0 THEN DO
- pword='PASSWORD'
- qmail='YES ACEBBS Z' ; END
- WHEN Pos('DARK SIDE',line)\=0 THEN DO
- pword='PASSWORD'
- qmail='YES DARKSIDE Z' ; END
- WHEN Pos('YOUR ASCII',line)\=0 THEN
- pword='PASSWORD'
- WHEN Pos('BROTHERS',line)\=0 THEN
- pword='PASSWORD'
- OTHERWISE DO
- DO tone=1500 TO 2500 BY 100
- CALL Beep tone,50 ; END
- CALL Put_s ' <ENTER MANUALLY!> ',screen_handle
- CALL SLEEP '20000'
- pword='' ; END
- END
- RETURN
-
-