home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Professional / OS2PRO194.ISO / os2 / wps / com / pmcomm / tools / pcboard.cmd < prev    next >
Encoding:
Text File  |  1992-05-07  |  22.5 KB  |  723 lines
  1. /*======================================================================
  2.         PCBOARD.CMD  1.10 04/28/92 PCBoard universal logon script
  3.          for Multi-Net's PMcomm 1.10, under IBM OS/2 1.30 REXX.
  4.             Copyright (C) 1992 Brad Berson, Psycho Psoftware.
  5.                #2 Chaparral Road, Chestnut Ridge, NY 10977
  6.         Attach to appropriate PMcomm dialing entries, change the
  7.          variables as directed on the next few lines and edit
  8.      BBS' and passwords into the GetBbs section for full operation.
  9. ------------------------------------------------------------------------
  10.        PCBOARD.CMD is Shareware.  If after a reasonable period of
  11.      evaluation you continue to use this software, please consider
  12.       sending a registration fee of $10 to encourage development.
  13. ======================================================================*/
  14.  
  15.   CALL RxFuncadd "init_dll","RxPmcomm","init_dll"
  16.   PARSE ARG port portname scr_hndl dde_output dde_input semaphore
  17.   PARSE SOURCE host caller fn .
  18.   CALL init_dll
  19.   etime=Time('R')
  20.   name='BRAD BERSON'                   /* <- your own name here */
  21.   qdir='C:\COMM\QMAIL\'                /* <- dir for Qmail files */
  22.   loglvl=3                             /* <- set logfile verbosity 1-3 */
  23.   autoff='YES'                         /* <- auto-off aft mail, xfers */
  24.   delmail='YES'                        /* <- auto del QWK/REP files */
  25.   autorep='YES'                        /* <- force repeat mail scans */
  26.   waitnc='NO'                          /* <- wait NO CARRIER if halted */
  27.   filelist='C:\COMM\UPDOWN\UPDOWN.LST' /* <- name of file xfer list */
  28.   logfile='C:\COMM\UPDOWN\PCBOARD.LOG' /* <- name of activity log */
  29.   odlpath='C:\COMM\UPDOWN'             /* <- downld path to reset to */
  30.   qmail='NO X X'
  31.   qupdn='N'
  32.   pwdcnt=0
  33.   namcnt=0
  34.   pktcnt=0
  35.   repflg=0
  36.   cr='0d'x
  37.   crlf='0d0a'x
  38.   bs='08'x
  39.   esc='1b'x
  40.   scp=esc'[s'
  41.   rcp=esc'[u'
  42.   sred=esc'[31;1m'
  43.   swit=esc'[0;1m'
  44.   errl=esc'[25;1H'
  45.   CALL Read_timeout '20000',port
  46.   SIGNAL ON SYNTAX NAME RexxErr
  47.   SIGNAL ON NOVALUE NAME RexxErr
  48.   SIGNAL ON HALT NAME ExitScr
  49.   CALL ON ERROR NAME HostErr
  50.   CALL ON FAILURE NAME HostErr
  51.   DO 3
  52.     CALL Beep 1000,200
  53.     CALL Beep 1200,200
  54.   END
  55.   IF logfile>' ' THEN
  56.     lfstate=Stream(logfile,'c','open write')
  57.   CALL WriteLog COPIES('=',50),1
  58.   CALL WriteLog 'Modem connected...',1
  59.  
  60. Start:
  61.   DO FOREVER
  62.     match=Wait_fore('change?','graphics','NS)?','rst name',port,scr_hndl)
  63.     CALL ScrDeb('ST')
  64.     SELECT
  65.       WHEN match=0 THEN
  66.         SIGNAL Errh
  67.       WHEN match=1 THEN
  68.         CALL Put_s '1'cr,port
  69.       WHEN match=2 THEN
  70.         CALL Put_s 'Y Q N'cr,port
  71.       WHEN match=3 THEN
  72.         CALL Put_s 'N'cr,port
  73.       WHEN match=4 THEN
  74.         LEAVE
  75.       OTHERWISE NOP
  76.     END
  77.   END
  78.  
  79. Inam:
  80.   CALL Put_s name||cr,port
  81.   DO FOREVER
  82.     match=Wait_fore('ot found in us','rect?','rong pass','ssword','ence Co',,
  83.     ')=yes?',', Mor','N)','NS)?','nter) to','ard Command',port,scr_hndl)
  84.     CALL ScrDeb('IN')
  85.     SELECT
  86.       WHEN match=0 THEN
  87.         SIGNAL Errh
  88.       WHEN match=1 THEN DO
  89.         IF namcnt>2 THEN DO
  90.           CALL WriteLog 'Name not recognised',1
  91.           SIGNAL Errh ; END
  92.         CALL Put_s name||cr,port
  93.         namcnt=namcnt+1 ; END
  94.       WHEN match=2 THEN
  95.         CALL Put_s 'Y'cr,port
  96.       WHEN match=3 THEN DO
  97.         IF pwdcnt>2 THEN DO
  98.           CALL WriteLog 'Password not correct',1
  99.           SIGNAL Errh ; END
  100.         CALL Put_s pword||cr,port
  101.         pwdcnt=pwdcnt+1 ; END
  102.       WHEN match=4 THEN DO
  103.         CALL Flush
  104.         CALL GetBbs
  105.         CALL Put_s pword||cr,port
  106.         pwdcnt=pwdcnt+1 ; END
  107.       WHEN match=5 THEN
  108.         CALL Put_s 'A'cr,port
  109.       WHEN match>5 & match<10 THEN
  110.         CALL Put_s 'N'cr,port
  111.       WHEN match=10 THEN
  112.         CALL Put_s cr,port
  113.       WHEN match=11 THEN
  114.         LEAVE
  115.       OTHERWISE NOP
  116.     END
  117.   END
  118.   CALL Flush
  119.   CALL WriteLog 'Successful log-in: 'LEFT(line,30),2
  120.   PARSE VAR qmail doqmail packet xprot
  121.   IF doqmail='YES' THEN
  122.     CALL CheckMail
  123.   IF filelist\='' THEN
  124.     filelist=Stream(filelist,'c','query exists')
  125.   IF qupdn\='N' THEN DO
  126.     CALL Qmail
  127.     IF autoff='YES' & filelist='' THEN CALL LogOff
  128.   END
  129.   IF filelist\='' THEN DO
  130.     IF qupdn\='N' THEN CALL QuitMail
  131.     CALL PcbXfer
  132.     IF autoff='YES' THEN CALL LogOff
  133.   END
  134.   DO 3 ; CALL Beep 800,300 ; END
  135.   CALL WriteLog 'Control given to user',1
  136.   IF waitnc='YES' THEN DO
  137.     CALL Read_timeout '3600000',port
  138.     DO FOREVER
  139.       match=Wait_fore('NO CARRIER'cr,port,scr_hndl)
  140.       CALL ScrDeb('NC')
  141.       SELECT
  142.         WHEN match=0 THEN ; SIGNAL Errh
  143.         WHEN match=1 THEN ; LEAVE
  144.         OTHERWISE ; SIGNAL Errh
  145.       END
  146.     END
  147.     CALL WriteLog 'Connection terminated',1
  148.     CALL WriteLog 'ET',1
  149.   END
  150.   lfstate=Stream(logfile,'c','close')
  151.   EXIT
  152.  
  153. /*====================[HANDLE QMAIL]====================*/
  154. /*   Downloads & uploads Qmail packets and pointer and  */
  155. /*    key files depending on existence of each file     */
  156. /* Must have Qmail door configured for extended prompts */
  157. /*======================================================*/
  158.  
  159. Qmail:
  160.   CALL Delay(5)
  161.   CALL WriteLog 'Opening Qmail4 door',3
  162.   CALL Put_s 'QMAIL4'cr,port
  163.   DO FOREVER
  164.     match=Wait_fore('NS)?','any key','<COMMAND>',port,scr_hndl)
  165.     CALL ScrDeb('OQ')
  166.     SELECT
  167.       WHEN match=0 THEN
  168.         SIGNAL Errh
  169.       WHEN match=1 THEN
  170.         CALL Put_s ' ',port
  171.       WHEN match=2 THEN
  172.         CALL Put_s 'N'cr,port
  173.       OTHERWISE LEAVE
  174.     END
  175.   END
  176.   CALL WriteLog 'Qmail4 door opened',2
  177.  
  178.   pathn=qdir
  179.   IF ptrfile\='' THEN DO /*send pointer file*/
  180.     CALL Put_s 'R'cr,port
  181.     CALL Wait_fore '<PTRUP>',port,scr_hndl
  182.     IF result=0 THEN SIGNAL Errh
  183.     CALL WriteLog 'Sending pointer file',3
  184.     dpfname=ptrfile ; xcmd='U' ; CALL DoXfer
  185.     CALL Wait_fore '<PTRFILE>',port,scr_hndl
  186.     IF result=0 THEN SIGNAL Errh
  187.     CALL Put_s '1'cr,port /* set ptrs to before pkt */
  188.     CALL Wait_fore '<COMMAND>',port,scr_hndl
  189.     IF result=0 THEN SIGNAL Errh
  190.     CALL WriteLog 'Pointer file sent',3
  191.   END
  192.  
  193.   IF keyfile\='' THEN DO /*send key file*/
  194.     CALL Put_s 'K'cr,port
  195.     CALL Wait_fore '<KEYUP>',port,scr_hndl
  196.     IF result=0 THEN SIGNAL Errh
  197.     CALL WriteLog 'Sending keyword file',3
  198.     dpfname=keyfile ; xcmd='U' ; CALL DoXfer
  199.     CALL Wait_fore '<COMMAND>',port,scr_hndl
  200.     IF result=0 THEN SIGNAL Errh
  201.     CALL WriteLog 'Keyword file sent',3
  202.   END
  203.  
  204.   IF qupdn='D' | qupdn='B' THEN DO /*download Qmail file*/
  205.     CALL Read_timeout '480000',port
  206.     CALL Put_s 'D'cr,port
  207.     CALL WriteLog 'Beginning mail scan',2
  208.     DO FOREVER
  209.       match=Wait_fore('<NO TRANSFER>','<NO TIME>','<DLASK>','<DOWNLOAD>',,
  210.       '<COMMAND>','<DL ERROR>','<DL SUCCESS>','<MAX>','<REPEAT>','...',,
  211.       port,scr_hndl)
  212.       CALL ScrDeb('QD')
  213.       SELECT
  214.         WHEN match=0 THEN
  215.           SIGNAL Errh
  216.         WHEN match=1 THEN DO
  217.           CALL WriteLog 'No mail to download',3
  218.           LEAVE ; END
  219.         WHEN match=2 THEN DO
  220.           CALL WriteLog 'Not enough time for mail',2
  221.           LEAVE ; END
  222.         WHEN match=3 THEN
  223.           CALL Put_s 'Y'cr,port
  224.         WHEN match=4 THEN DO
  225.           CALL WriteLog 'Initiating QWK download',3
  226.           filen=packet'.QWK' ; xcmd='D'
  227.           IF pktcnt>0 THEN
  228.             filen=Overlay(Format(pktcnt-1,1),filen,Length(filen))
  229.           CALL DoXfer ; END
  230.         WHEN match=5 THEN DO
  231.           IF autorep='YES' & repflg=1 THEN DO
  232.             CALL Put_s 'D'cr,port
  233.             CALL WriteLog 'Beginning next scan',2
  234.             repflg=0 ; END
  235.           ELSE DO
  236.             CALL Flush
  237.             LEAVE ; END
  238.           END
  239.         WHEN match=6 THEN DO
  240.           CALL WriteLog 'QWK receive failed',2
  241.           qwksucc=0 ; END
  242.         WHEN match=7 THEN DO
  243.           CALL WriteLog 'QWK file received',3
  244.           pktcnt=pktcnt+1
  245.           qwksucc=1 ; END
  246.         WHEN match=8 THEN DO
  247.           CALL WriteLog 'Reached max packet size',2
  248.           repflg=1 ; END
  249.         WHEN match=9 THEN DO
  250.           CALL WriteLog 'Qmail auto-repeating scan',2
  251.           CALL Put_s esc||esc||esc,port ; END
  252.         OTHERWISE NOP
  253.       END
  254.     END
  255.   END
  256.  
  257.   IF qupdn='U' | qupdn='B' THEN DO /*upload reply file*/
  258.     CALL Read_timeout '60000',port
  259.     CALL Put_s 'U'cr,port
  260.     DO FOREVER
  261.       match=Wait_fore('<UPLOAD>','<UP ERROR>','S NOT INSERTED>',,
  262.       'S INSERTED>','<UP SUCCESS>','<COMMAND>',port,scr_hndl)
  263.       CALL ScrDeb('QU')
  264.       SELECT
  265.         WHEN match=0 THEN
  266.           SIGNAL Errh
  267.         WHEN match=1 THEN DO
  268.           CALL WriteLog 'Initiating REP upload',3
  269.           dpfname=repfile ; xcmd='U'
  270.           CALL DoXfer ; END
  271.         WHEN match=2 | match=3 THEN DO
  272.           CALL WriteLog 'REP send failed',2
  273.           repsucc=0 ; END
  274.         WHEN match=4 & delmail='YES' THEN DO
  275.           shellcmd='DEL 'repfile'> NUL'
  276.           ADDRESS CMD shellcmd
  277.           CALL WriteLog 'REP file deleted',3
  278.           IF qupdn='U' THEN DO
  279.             shellcmd='DEL 'qwkfile'> NUL'
  280.             ADDRESS CMD shellcmd
  281.             /* delete REP, and QWK if 'U' */
  282.             CALL WriteLog 'QWK file deleted',3 ; END
  283.           repsucc=1 ; END
  284.         WHEN match=6 THEN DO
  285.           CALL Flush
  286.           LEAVE ; END
  287.         OTHERWISE NOP
  288.       END
  289.     END
  290.   END
  291.   CALL Flush
  292.   RETURN
  293.  
  294. QuitMail:
  295.   CALL Sleep '2000'
  296.   CALL Flush
  297.   CALL WriteLog 'Exiting Qmail system',3
  298.   CALL Put_s 'Q'cr,port
  299.   CALL Read_timeout '20000',port
  300.   DO FOREVER
  301.     match=Wait_fore('echo','Command',port,scr_hndl)
  302.     CALL ScrDeb('QQ')
  303.     SELECT
  304.       WHEN match=0 THEN
  305.         SIGNAL Errh
  306.       WHEN match=1 THEN
  307.         CALL Put_s pword||cr,port
  308.       WHEN match=2 THEN
  309.         LEAVE
  310.       OTHERWISE NOP
  311.     END
  312.   END
  313.   CALL WriteLog 'Exited Qmail system',2
  314.   CALL Flush
  315.   RETURN
  316.  
  317. CheckMail: /*Checks existence of Qmail files*/
  318.   repfile=Stream(qdir||packet'.REP','c','query exists')
  319.   qwkfile=Stream(qdir||packet'.QWK','c','query exists')
  320.   ptrfile=Stream(qdir||packet'.PTR','c','query exists')
  321.   keyfile=Stream(qdir||packet'.KEY','c','query exists')
  322.   IF qwkfile\='' & repfile='' THEN qupdn='N'
  323.   IF qwkfile='' & repfile='' THEN qupdn='D'
  324.   IF qwkfile='' & repfile\='' THEN qupdn='B'
  325.   IF qwkfile\='' & repfile\='' THEN qupdn='U'
  326.   RETURN
  327.  
  328. /*====================[PERFORM LOGOFF]====================*/
  329. /* Gets past logoff verification and questionnaires, etc. */
  330. /*  until it sees "NO CARRIER" status report from modem   */
  331. /*========================================================*/
  332.  
  333. LogOff:
  334.   CALL Delay(5)
  335.   CALL Set_download_path odlpath,dde_output
  336.   CALL Read_timeout '20000',port
  337.   CALL Put_s 'G Q'cr,port
  338.   DO FOREVER
  339.     match=Wait_fore('--)','? (','(Enter)','ogoff?',,
  340.     ', Mor','NS)?','any key','NO CARRIER',port,scr_hndl)
  341.     CALL ScrDeb('LO')
  342.     SELECT
  343.       WHEN match=0 THEN
  344.         SIGNAL Errh
  345.       WHEN match>0 & match<4 THEN
  346.         CALL Put_s cr,port
  347.       WHEN match=4 THEN
  348.         CALL Put_s 'Y'cr,port
  349.       WHEN match=5 | match=6 THEN
  350.         CALL Put_s 'N'cr,port
  351.       WHEN match=7 THEN
  352.         CALL Put_s ' ',port
  353.       WHEN match=8 THEN
  354.         LEAVE
  355.       OTHERWISE NOP
  356.     END
  357.   END
  358.   DO 3 ; CALL Beep 800,300 ; END
  359.   CALL WriteLog 'Logged off normally',1
  360.   CALL WriteLog 'ET',1
  361.   lfstate=Stream(logfile,'c','close')
  362.   EXIT
  363.  
  364. /*====================[UPLOADS AND DOWNLOADS]====================*/
  365. /*  Parse and execute PCBoard file xfer commands from list file  */
  366. /*===============================================================*/
  367.  
  368. PcbXfer:
  369.   CALL Delay(5)
  370.   curconf=0
  371.   DO WHILE Lines(filelist)\=0
  372.     CALL Read_timeout '60000',port
  373.     cmdline=Linein(filelist)
  374.     IF cmdline='' THEN ITERATE
  375.     PARSE VAR cmdline xconf xcmd xprot xfile xdesc
  376.     xcmd=TRANSLATE(xcmd)
  377.     xprot=TRANSLATE(xprot)
  378.     IF xconf<>curconf THEN DO
  379.       CALL JoinConf
  380.       IF xconf<>curconf THEN DO
  381.         CALL WriteLog 'Failed to join conference 'xconf,2
  382.         CALL WriteLog 'Subsequently bypassing 'xfile,3
  383.         ITERATE
  384.       ELSE
  385.         CALL WriteLog 'Entered conference 'curconf' from 'oldconf,2
  386.       END
  387.     END
  388.     SELECT
  389.       WHEN xcmd='D' THEN
  390.         IF xprot\='' & xfile\='' THEN
  391.           CALL XferCmds
  392.         ELSE
  393.           CALL WriteLog 'Xfer syntax error in 'cmdline,1
  394.       WHEN xcmd='U' THEN
  395.         IF xprot\='' & xfile\='' & xdesc\='' THEN
  396.           CALL XferCmds
  397.         ELSE
  398.           CALL WriteLog 'Xfer syntax error in 'cmdline,1
  399.       OTHERWISE CALL WriteLog 'Xfer syntax error in 'cmdline,1
  400.     END
  401.   END
  402.   CALL Flush
  403.   RETURN
  404.  
  405. JoinConf:
  406.   CALL Put_s 'J 'xconf' Q'cr,port
  407.   oldconf=curconf
  408.   curconf=xconf
  409.   DO FOREVER
  410.     match=Wait_fore('ence #',', More','N)','NS)?','(Ent',,
  411.     'ence Co','ard Command','nvalid','not regis',port,scr_hndl)
  412.     CALL ScrDeb('JC')
  413.     SELECT
  414.       WHEN match=0 THEN
  415.         SIGNAL Errh
  416.       WHEN match=1 THEN DO
  417.         CALL Flush
  418.         CALL Put_s cr,port ; END
  419.       WHEN match>1 & match<6 THEN DO
  420.         CALL Flush
  421.         CALL Put_s 'N'cr,port ; END
  422.       WHEN match=6 | match=7 THEN DO
  423.         CALL Flush
  424.         LEAVE ; END
  425.       WHEN match=8 THEN DO
  426.         CALL WriteLog 'Invalid conference selection',3
  427.         curconf=oldconf ; END
  428.       WHEN match=9 THEN DO
  429.         CALL WriteLog 'Not registered in conference',3
  430.         curconf=oldconf ; END
  431.       OTHERWISE NOP
  432.     END
  433.   END
  434.   CALL Flush
  435.   RETURN
  436.  
  437. XferCmds:
  438.   drivn=Filespec('drive',xfile)
  439.   pathn=Filespec('path',xfile)
  440.   filen=Filespec('name',xfile)
  441.   pathn=drivn||pathn
  442.   dpfname=Stream(pathn||filen,'c','query exists')
  443.   IF Pos('?',dpfname)>0 | Pos('*',dpfname)>0 THEN DO
  444.     dpfname='' ; wcflag=1 ; END
  445.   ELSE
  446.     wcflag=0
  447.   IF xcmd='D' & dpfname\='' THEN DO
  448.     CALL WriteLog 'Download bypassed, file exists',2
  449.     CALL WriteLog pathn||filen,3
  450.     RETURN ; END
  451.   IF xcmd='U' & dpfname='' THEN DO
  452.     CALL WriteLog 'Upload bypassed, not found',2
  453.     CALL WriteLog pathn||filen,3
  454.     RETURN ; END
  455.   CALL Put_s xcmd filen xprot cr,port
  456.   DO FOREVER
  457.     match=Wait_fore('ot Accept','plicates','exists','not found','upload!',,
  458.     'p upload in','ription wi','Aborts','ommand','nter)',,
  459.     'erifying','ter)=n','(G)',port,scr_hndl)
  460.     CALL ScrDeb('FX')
  461.     SELECT
  462.       WHEN match=0 THEN
  463.         SIGNAL Errh
  464.       WHEN match=1 THEN
  465.         CALL WriteLog 'Transfer aborted, not accepted',3
  466.       WHEN match=2 | match=3 THEN
  467.         CALL WriteLog 'Transfer aborted, dupe UL',3
  468.       WHEN match=4 THEN
  469.         CALL WriteLog 'Transfer aborted, not found',3
  470.       WHEN match=5 THEN
  471.         CALL WriteLog 'Transfer aborted, priv viol',3
  472.       WHEN match=6 THEN
  473.         CALL Put_s 'Y'cr,port
  474.       WHEN match=7 THEN
  475.         CALL Put_s xdesc||cr||cr,port
  476.       WHEN match=8 THEN
  477.         CALL DoXfer
  478.       WHEN match=9 THEN
  479.         LEAVE
  480.       WHEN match=10 THEN
  481.         CALL Put_s cr,port
  482.       WHEN match=11 THEN
  483.         CALL Read_timeout '120000',port
  484.       WHEN match=12 THEN
  485.         CALL Put_s cr,port        
  486.       WHEN match=13 THEN DO
  487.         CALL Flush
  488.         CALL Put_s cr,port        
  489.     CALL DoXfer ; END
  490.       OTHERWISE NOP
  491.     END
  492.   END
  493.   RETURN
  494.  
  495. DoXfer:
  496.   CALL WriteLog 'File transfer executing, 'xcmd||xprot':',3
  497.   SELECT
  498.     WHEN xprot='Z' & xcmd='U' THEN DO
  499.       CALL WriteLog dpfname,2
  500.       fc=zmodem_send(dpfname,dde_output,dde_input) ; END
  501.     WHEN xprot='Z' & xcmd='D' THEN DO
  502.       CALL WriteLog pathn||filen,2
  503.       CALL Set_download_path pathn,dde_output
  504.       fc=zmodem_receive(dde_output,dde_input) ; END
  505.     WHEN xprot='G' & xcmd='U' THEN DO
  506.       CALL WriteLog dpfname,2
  507.       fc=ymodemg_send(dpfname,dde_output,dde_input) ; END
  508.     WHEN xprot='G' & xcmd='D' THEN DO
  509.       CALL WriteLog pathn||filen,2
  510.       CALL Set_download_path pathn,dde_output
  511.       fc=ymodemg_receive(dde_output,dde_input) ; END
  512.     WHEN xprot='K' & xcmd='U' THEN DO
  513.       CALL WriteLog dpfname,2
  514.       fc=kermit_send(dpfname,dde_output,dde_input) ; END
  515.     WHEN xprot='K' & xcmd='D' THEN DO
  516.       CALL WriteLog pathn||filen,2
  517.       CALL Set_download_path pathn,dde_output
  518.       fc=kermit_receive(dde_output,dde_input) ; END
  519.     WHEN xprot='Y' & xcmd='U' THEN DO
  520.       CALL WriteLog dpfname,2
  521.       fc=ymodem_send(dpfname,dde_output,dde_input) ; END
  522.     WHEN xprot='Y' & xcmd='D' THEN DO
  523.       CALL WriteLog pathn||filen,2
  524.       CALL Set_download_path pathn,dde_output
  525.       fc=ymodem_receive(dde_output,dde_input) ; END
  526.     WHEN xprot='O' & xcmd='U' THEN DO
  527.       CALL WriteLog dpfname,2
  528.       fc=xmodem_1k_send(dpfname,dde_output,dde_input) ; END
  529.     WHEN xprot='O' & xcmd='D' THEN DO
  530.       IF wcflag=1 THEN CALL GetFnam
  531.       CALL WriteLog pathn||filen,2
  532.       CALL Set_download_path pathn,dde_output
  533.       fc=xmodem_1k_receive(filen,dde_output,dde_input) ; END
  534.     WHEN xprot='C' & xcmd='U' THEN DO
  535.       CALL WriteLog dpfname,2
  536.       fc=xmodem_send(dpfname,dde_output,dde_input) ; END
  537.     WHEN xprot='C' & xcmd='D' THEN DO
  538.       IF wcflag=1 THEN CALL GetFnam
  539.       CALL WriteLog pathn||filen,2
  540.       CALL Set_download_path pathn,dde_output
  541.       fc=xmodem_receive(filen,dde_output,dde_input) ; END
  542.     WHEN xprot='X' & xcmd='U' THEN DO
  543.       CALL WriteLog dpfname,2
  544.       fc=xmodem_chk_send(dpfname,dde_output,dde_input) ; END
  545.     WHEN xprot='X' & xcmd='D' THEN DO
  546.       IF wcflag=1 THEN CALL GetFnam
  547.       CALL WriteLog pathn||filen,2
  548.       CALL Set_download_path pathn,dde_output
  549.       fc=xmodem_chk_receive(filen,dde_output,dde_input) ; END
  550.     OTHERWISE DO
  551.       CALL WriteLog 'Xfer protocol syntax error',1
  552.       fc=2 ; END
  553.   END
  554.   IF fc\=2 THEN DO
  555.     IF fc=0 THEN fc='FAILURE'
  556.     IF fc=1 THEN fc='SUCCESS'
  557.     CALL WriteLog 'File transfer exit code 'fc,1
  558.   END
  559.   RETURN
  560.  
  561. GetFnam:
  562.   currow=Get_cursor_position('row',dde_output,dde_input)
  563.   found=0
  564.   DO lcnt=currow-1 TO currow-8 BY -1 UNTIL found>0
  565.     line=Get_char_at(lcnt,0,40,dde_output,dde_input)
  566.     found=Pos('elected:',line)
  567.   END
  568.   line=Get_char_at(lcnt,0,40,dde_output,dde_input)
  569.   IF Pos('elected:',line)>0 THEN
  570.     PARSE line . . filen .
  571.   ELSE
  572.     filen='*UNKNOWN'
  573.   RETURN
  574.  
  575. /*====================[HANDLE ERRORS]====================*/
  576. /* Print error message and yell, drop carrier if timeout */
  577. /*=======================================================*/
  578.  
  579. RexxErr:
  580.   CALL Put_s crlf||sred,scr_hndl
  581.   IF RC='RC' THEN
  582.     CALL Put_s 'REXX ERROR in line 'sigl||crlf,scr_hndl
  583.   ELSE
  584.     CALL Put_s 'REXX ERROR 'rc' in line 'sigl': 'Errortext(rc)crlf,scr_hndl
  585.   CALL Put_s Sourceline(sigl)crlf,scr_hndl
  586.   CALL Put_s 'Condition: 'Condition('C')crlf,scr_hndl
  587.   CALL Put_s 'PROGRAM ABENDED.'swit||crlf,scr_hndl
  588.   CALL Set_download_path odlpath,dde_output
  589.   CALL WriteLog 'REXX procedure error encountered at 'sigl,1
  590.   CALL Beep 40,2000
  591.   CALL Sleep '30000'
  592.   CALL Drop_dtr port
  593.   CALL Sleep '2000'
  594.   CALL Raise_dtr port
  595.   CALL WriteLog 'Terminated by RexxErr',1
  596.   CALL WriteLog 'ET',1
  597.   lfstate=Stream(logfile,'c','close')
  598.   EXIT
  599.  
  600. HostErr:
  601.   CALL Put_s crlf||sred'HOST CMD ERROR 'rc' in line 'sigl':',scr_hndl
  602.   CALL Put_s Errortext(rc)crlf||Sourceline(sigl)swit||crlf,scr_hndl
  603.   CALL WriteLog 'Host CMD error occurred at 'sigl,1
  604.   CALL Beep 40,2000
  605.   RETURN
  606.  
  607. Errh:
  608.   CALL Put_s crlf||sred'SCRIPT ERROR in line 'sigl||swit||crlf,scr_hndl
  609.   CALL Set_download_path odlpath,dde_output
  610.   CALL WriteLog 'Script error occurred at 'sigl,1
  611.   lfstate=Stream(logfile,'c','close')
  612.   DO 30 ; CALL Beep 1800,100 ; END
  613.   CALL Sleep '30000'
  614.   CALL Drop_dtr port
  615.   CALL Sleep '2000'
  616.   CALL Raise_dtr port
  617.   CALL WriteLog 'Terminated by Errh',1
  618.   CALL WriteLog 'ET',1
  619.   lfstate=Stream(logfile,'c','close')
  620.   EXIT
  621.  
  622. ExitScr:
  623.   DO 3 ; CALL Beep 800,300 ; END
  624.   CALL Put_s crlf'PCBOARD.CMD Terminated at line 'sigl||crlf,scr_hndl
  625.   CALL Set_download_path odlpath,dde_output
  626.   CALL WriteLog 'CMD file terminated by user at 'sigl,1
  627.   IF waitnc='YES' THEN DO
  628.     CALL Read_timeout '3600000',port
  629.     DO FOREVER
  630.       match=Wait_fore('NO CARRIER'cr,port,scr_hndl)
  631.       CALL ScrDeb('NC')
  632.       SELECT
  633.         WHEN match=0 THEN ; SIGNAL Errh
  634.         WHEN match=1 THEN ; LEAVE
  635.         OTHERWISE ; SIGNAL Errh
  636.       END
  637.     END
  638.     CALL WriteLog 'Connection terminated',1
  639.     CALL WriteLog 'ET',1
  640.   END
  641.   lfstate=Stream(logfile,'c','close')
  642.   EXIT
  643.  
  644. /*====================[GET BBS PWORD]====================*/
  645. /* Searches scrollback buffer for BBS ID line before the */
  646. /* PCBoard version ID line, sets password and qmail vars */
  647. /* May fail due to line noise, handshake problems, etc.  */
  648. /*=======================================================*/
  649.  
  650. GetBbs:
  651.   currow=Get_cursor_position('row',dde_output,dde_input)
  652.   found=0
  653.   DO lcnt=currow-1 TO currow-100 BY -1 UNTIL found>0 | currow=0
  654.     line=Get_char_at(lcnt,0,40,dde_output,dde_input)
  655.     found=Pos('PCBoard (R)',line)
  656.   END
  657.   line=Get_char_at(lcnt-1,0,40,dde_output,dde_input)
  658.   line=Translate(line)
  659.   SELECT
  660.     WHEN Pos('INVENTION',line)\=0 THEN DO
  661.       pword='INVPW1T'                  /* your password for BBS */
  662.       qmail='YES INV-FAC Z' ; END      /* YES, packet name, protocol */
  663.     WHEN Pos('ACE ',line)\=0 THEN DO
  664.       pword='ACEPW1S'
  665.       qmail='YES ACEBBS Z' ; END
  666.     WHEN Pos('WISHBONE',line)\=0 THEN
  667.       pword='ZXYTWRRWZ'                /* this fmt for BBS w/o Qmail */
  668.     WHEN Pos('BROTHERS',line)\=0 THEN
  669.       pword='ABCDEFG'
  670.     OTHERWISE DO
  671.       CALL WriteLog 'Error detecting BBS and password',1
  672.       DO tone=1500 TO 2500 BY 100
  673.         CALL Beep tone,50 ; END
  674.       CALL Put_s ' <ENTER MANUALLY!> ',scr_hndl
  675.       CALL SLEEP '20000'
  676.       pword='' ; END
  677.   END
  678.   RETURN
  679.  
  680. /*====================[OTHER ROUTINES]====================*/
  681. /* Write logfile statements.  CALL WriteLog 'text',lvl    */
  682. /* N second delay with ticking sound.  CALL Delay(n)      */
  683. /* Flush flushes pending input from current COM port.     */
  684. /* WrEltime writes total elapsed time to activity log.    */
  685. /*========================================================*/
  686.  
  687. Flush:
  688.   DO WHILE Char_avail(port)>0
  689.     CALL Put_s Get_ch(port),scr_hndl
  690.   END
  691.   RETURN
  692.  
  693. WriteLog:
  694.   stamp=arg(1)
  695.   level=arg(2)
  696.   IF logfile>' ' & level<=loglvl THEN DO
  697.     IF stamp='ET' THEN DO
  698.       etime=Trunc(Time('E'))
  699.       emin=etime%60
  700.       esec=etime//60
  701.       IF esec<10 THEN esec='0'esec
  702.       stamp='Total elapsed - 'emin':'esec
  703.     END
  704.     lfrecord=date('U')' 'time()' 'stamp||crlf
  705.     lfstate=Charout(logfile,lfrecord)
  706.   END
  707.   RETURN
  708.  
  709. ScrDeb:
  710.   section=arg(1)
  711.   IF loglvl=4 THEN
  712.     CALL Put_s crlf||sred'<'section':',
  713.     match'>'swit||crlf,scr_hndl
  714.   RETURN
  715.  
  716. Delay:
  717.   DO arg(1)
  718.     CALL Sleep '1000'
  719.     CALL Beep 2000,50
  720.   END
  721.   RETURN
  722.  
  723.