home *** CD-ROM | disk | FTP | other *** search
/ Black Box 4 / BlackBox.cdr / os2 / pmcommac.arj / PCBOARD.CMD < prev    next >
Encoding:
Text File  |  1992-04-22  |  12.8 KB  |  439 lines

  1. /*======================================================================
  2.         PCBOARD.CMD  1.00 09/22/91 PCBoard universal logon script
  3.          for Multi-Net's PMcomm 1.09, under IBM OS/2 1.30 REXX.
  4.             Copyright (C) 1991 Brad Berson, Insane Software.
  5.         Attach to appropriate PMcomm dialing entries, change the
  6.          variables as directed on the next few lines and edit
  7.      BBS' and passwords into the GetBbs section for full operation.
  8. ======================================================================*/
  9.  
  10.   CALL RxFuncadd "init_dll","RxPmcomm","init_dll"
  11.   PARSE ARG port portname screen_handle dde_output dde_input semaphore
  12.   PARSE SOURCE . . fn .
  13.   CALL init_dll
  14.   name='BRAD BERSON'                   /* <- your own name here */
  15.   qdir='C:\COMM\QMAIL\'                /* <- dir for Qmail files */
  16.   autoff='YES'                         /* <- auto-off aft mail, xfers */
  17.   delmail='YES'                        /* <- auto del QWK/REP files */
  18.   filelist='C:\COMM\UPDOWN\UPDOWN.LST' /* <- name of file xfer list */
  19.   qmail='NO X X'
  20.   qupdn='N'
  21.   pwdcnt=0
  22.   namcnt=0
  23.   cr='0d'x
  24.   crlf='0d0a'x
  25.   bs='08'x
  26.   esc='1b'x
  27.   scp=esc||'[s'
  28.   rcp=esc||'[u'
  29.   sred=esc||'[31;1m'
  30.   swit=esc||'[0;1m'
  31.   errl=esc||'[25;1H'
  32.   odir=Directory()
  33.   CALL Read_timeout '20000',port
  34.   SIGNAL ON SYNTAX NAME RexxErr
  35.   SIGNAL ON NOVALUE NAME RexxErr
  36.   SIGNAL ON HALT NAME ExitScr
  37.   CALL ON ERROR NAME HostErr
  38.   CALL ON FAILURE NAME HostErr
  39.   DO 3
  40.     CALL Beep 1000,200
  41.     CALL Beep 1200,200
  42.   END
  43.  
  44. Start:
  45.   DO FOREVER
  46.     match=Wait_fore('change?','graphics','NS)?','rst name',,
  47.     port,screen_handle)
  48.     SELECT
  49.       WHEN match=0 THEN
  50.         SIGNAL Errh
  51.       WHEN match=1 THEN
  52.         CALL Put_s '1'||cr,port
  53.       WHEN match=2 THEN
  54.         CALL Put_s 'Y Q N'||cr,port
  55.       WHEN match=3 THEN
  56.         CALL Put_s 'N'||cr,port
  57.       WHEN match=4 THEN
  58.         LEAVE
  59.       OTHERWISE NOP
  60.     END
  61.   END
  62.  
  63. Inam:
  64.   CALL Put_s name||cr,port
  65.   DO FOREVER
  66.     match=Wait_fore('t found in us','rect?','rong pass','ssword','nce Co',,
  67.     'tinue','(Ent',', Mor','N)','NS)?','ard Command',port,screen_handle)
  68.     CALL Put_s sred||match||swit,screen_handle /* debug! */
  69.     SELECT
  70.       WHEN match=0 THEN
  71.         SIGNAL Errh
  72.       WHEN match=1 THEN DO
  73.     IF namcnt>2 THEN CALL Errh
  74.         CALL Put_s name||cr,port
  75.         namcnt=namcnt+1 ; END
  76.       WHEN match=2 THEN
  77.         CALL Put_s 'Y'||cr,port
  78.       WHEN match=3 THEN DO
  79.     IF pwdcnt>2 THEN CALL Errh
  80.         CALL Put_s pword||cr,port
  81.         pwdcnt=pwdcnt+1 ; END
  82.       WHEN match=4 THEN DO
  83.         CALL Flush
  84.         CALL GetBbs
  85.         CALL Put_s pword||cr,port
  86.         pwdcnt=pwdcnt+1 ; END
  87.       WHEN match=5 THEN
  88.         CALL Put_s 'A'||cr,port
  89.       WHEN match>5 & match<11 THEN
  90.         CALL Put_s 'N'||cr,port
  91.       WHEN match=11 THEN
  92.         LEAVE
  93.       OTHERWISE NOP
  94.     END
  95.   END
  96.   CALL Flush
  97.   PARSE VAR qmail doqmail packet xprot
  98.   IF doqmail='YES' THEN
  99.     CALL CheckMail
  100.   IF filelist\='' THEN
  101.     filelist=Stream(filelist,'c','query exists')
  102.   IF qupdn\='N' THEN DO
  103.     CALL Qmail
  104.     IF autoff='YES' & filelist='' THEN CALL LogOff
  105.   END
  106.   IF filelist\='' THEN DO
  107.     IF qupdn\='N' THEN CALL QuitMail
  108.     CALL PcboardXfer
  109.     IF autoff='YES' THEN CALL LogOff
  110.   END
  111.   DO 3 ; CALL Beep 800,300 ; END
  112.   EXIT
  113.  
  114. /*====================[HANDLE QMAIL]====================*/
  115. /*   Downloads & uploads Qmail packets and pointer and  */
  116. /*    key files depending on existence of each file     */
  117. /* Must have Qmail door configured for extended prompts */
  118. /*======================================================*/
  119.  
  120. Qmail:
  121.   CALL Delay
  122.   CALL Put_s 'QMAIL4'||cr,port
  123.   DO FOREVER
  124.     match=Wait_fore('NS)?','any key','<COMMAND>',port,screen_handle)
  125.     CALL Put_s sred||match||swit,screen_handle /* debug! */
  126.     SELECT
  127.       WHEN match=0 THEN
  128.         SIGNAL Errh
  129.       WHEN match=1 THEN
  130.         CALL Put_s ' ',port
  131.       WHEN match=2 THEN
  132.         CALL Put_s 'N'||cr,port
  133.       OTHERWISE LEAVE
  134.     END
  135.   END
  136.  
  137.   pathn=qdir
  138.   IF ptrfile\='' THEN DO /*send pointer file*/
  139.     CALL Put_s 'R'||cr,port
  140.     CALL Wait_fore '<PTRUP>',port,screen_handle
  141.     IF result=0 THEN SIGNAL Errh
  142.     dpfname=ptrfile ; xcmd='U' ; CALL DoXfer
  143.     CALL Wait_fore '<PTRFILE>',port,screen_handle
  144.     IF result=0 THEN SIGNAL Errh
  145.     CALL Put_s '1'||cr,port
  146.     CALL Wait_fore '<COMMAND>',port,screen_handle
  147.     IF result=0 THEN SIGNAL Errh
  148.   END
  149.  
  150.   IF keyfile\='' THEN DO /*send key file*/
  151.     CALL Put_s 'K'||cr,port
  152.     CALL Wait_fore '<KEYUP>',port,screen_handle
  153.     IF result=0 THEN SIGNAL Errh
  154.     dpfname=keyfile ; xcmd='U' ; CALL DoXfer
  155.     CALL Wait_fore '<COMMAND>',port_screen_handle
  156.     IF result=0 THEN SIGNAL Errh
  157.   END
  158.  
  159.   IF qupdn='D' | qupdn='B' THEN DO /*download Qmail file*/
  160.     CALL Read_timeout '480000',port
  161.     CALL Put_s 'D'||cr,port
  162.     DO FOREVER
  163.       match=Wait_fore('<NO TRANSFER>','<NO TIME>','<DLASK>','<DOWNLOAD>',,
  164.       '<COMMAND>','<DL ERROR>','<DL SUCCESS>',port,screen_handle)
  165.       SELECT
  166.         WHEN match=0 THEN
  167.           SIGNAL Errh
  168.         WHEN match=1 | match=2 THEN
  169.           LEAVE
  170.         WHEN match=3 THEN
  171.           CALL Put_s 'Y'||cr,port
  172.         WHEN match=4 THEN DO
  173.           filen=qwkfile ; xcmd='D'
  174.           CALL DoXfer ; END
  175.         WHEN match=5 THEN
  176.           LEAVE
  177.         WHEN match=6 THEN DO
  178.           CALL Put_s crlf||"QWK DL FAILED"||crlf,screen_handle
  179.           qwksucc=0 ; END
  180.         WHEN match=7 THEN
  181.           qwksucc=1
  182.         OTHERWISE NOP
  183.       END
  184.     END
  185.   END
  186.  
  187.   IF qupdn='U' | qupdn='B' THEN DO /*upload reply file*/
  188.     CALL Read_timeout '60000',port
  189.     CALL Put_s 'U'||cr,port
  190.     DO FOREVER
  191.       match=Wait_fore('<UPLOAD>','<UP ERROR>','S NOT INSERTED>',,
  192.       'S INSERTED>','<UP SUCCESS>','<COMMAND>',port,screen_handle)
  193.       SELECT
  194.         WHEN match=0 THEN
  195.           SIGNAL Errh
  196.         WHEN match=1 THEN DO
  197.           dpfname=repfile ; xcmd='U'
  198.           CALL DoXfer ; END
  199.         WHEN match=2 | match=3 THEN DO
  200.           CALL Put_s crlf||"REP UL FAILED"||crlf,screen_handle
  201.           repsucc=0 ; END
  202.         WHEN match=4 & delmail='YES' THEN DO
  203.           shellcmd='DEL '||repfile||'> NUL'
  204.           ADDRESS CMD shellcmd
  205.           IF qupdn='U' THEN DO
  206.             shellcmd='DEL '||qwkfile||'> NUL'
  207.             ADDRESS CMD shellcmd ; END
  208.             /* delete REP, and QWK if 'U' */
  209.           repsucc=1 ; END
  210.         WHEN match=6 THEN
  211.           LEAVE
  212.         OTHERWISE NOP
  213.       END
  214.     END
  215.   END
  216.   CALL Flush
  217.   RETURN
  218.  
  219. QuitMail:
  220.   CALL Read_timeout '20000',port
  221.   CALL Put_s 'Q'||cr,port
  222.   DO FOREVER
  223.     match=Wait_fore('echo','ommand',port,screen_handle)
  224.     SELECT
  225.       WHEN match=0 THEN
  226.         SIGNAL Errh
  227.       WHEN match=1 THEN
  228.         CALL Put_s pword||cr,port
  229.       WHEN match=2 THEN
  230.         LEAVE
  231.       OTHERWISE NOP
  232.     END
  233.   END
  234.   CALL Flush
  235.   RETURN
  236.  
  237. CheckMail: /*Checks existence of Qmail files*/
  238.   repfile=Stream(qdir||packet||'.REP','c','query exists')
  239.   qwkfile=Stream(qdir||packet||'.QWK','c','query exists')
  240.   ptrfile=Stream(qdir||packet||'.PTR','c','query exists')
  241.   keyfile=Stream(qdir||packet||'.KEY','c','query exists')
  242.   IF qwkfile\='' & repfile='' THEN qupdn='N'
  243.   IF qwkfile='' & repfile='' THEN qupdn='D'
  244.   IF qwkfile='' & repfile\='' THEN qupdn='B'
  245.   IF qwkfile\='' & repfile\='' THEN qupdn='U'
  246.   RETURN
  247.  
  248. /*====================[PERFORM LOGOFF]====================*/
  249. /* Gets past logoff verification and questionnaires, etc. */
  250. /*  until it sees "NO CARRIER" status report from modem   */
  251. /*========================================================*/
  252.  
  253. LogOff:
  254.   CALL Delay
  255.   CALL Read_timeout '20000',port
  256.   CALL Put_s 'G Q'||cr,port
  257.   DO FOREVER
  258.     match=Wait_fore('--)','? (','(Enter)','ogoff?',,
  259.     'any key','NO CARRIER',port,screen_handle)
  260.     SELECT
  261.       WHEN match=0 THEN
  262.         SIGNAL Errh
  263.       WHEN match>0 & match<4 THEN
  264.         CALL Put_s cr,port
  265.       WHEN match=4 THEN
  266.         CALL Put_s 'Y'||cr,port
  267.       WHEN match=5 THEN
  268.         CALL Put_s ' ',port
  269.       WHEN match=6 THEN
  270.         LEAVE
  271.       OTHERWISE NOP
  272.     END
  273.   END
  274.   DO 3 ; CALL Beep 800,300 ; END
  275.   EXIT
  276.  
  277. /*====================[UPLOADS AND DOWNLOADS]====================*/
  278. /*  Parse and execute PCBoard file xfer commands from list file  */
  279. /*===============================================================*/
  280.  
  281. PcboardXfer:
  282.   CALL Sleep '5000'
  283.   DO WHILE Lines(filelist)\=0
  284.     CALL Read_timeout '30000',port
  285.     cmdline=Linein(filelist)
  286.     IF cmdline='' THEN ITERATE
  287.     PARSE VAR cmdline xcmd xprot xfile xdesc
  288.     IF xcmd='D' THEN DO
  289.       IF xprot\='' & xfile\='' THEN
  290.         CALL XferCmds
  291.     END
  292.     IF xcmd='U' THEN DO
  293.       IF xprot\='' & xfile\='' & xdesc\='' THEN
  294.         CALL XferCmds
  295.     END
  296.   END
  297.   CALL Flush
  298.   RETURN
  299.  
  300. XferCmds:
  301.   drivn=Filespec('drive',xfile)
  302.   pathn=Filespec('path',xfile)
  303.   filen=Filespec('name',xfile)
  304.   pathn=drivn||pathn
  305.   dpfname=Stream(pathn||filen,'c','query exists')
  306.   IF xcmd='D' & dpfname\='' THEN DO
  307.     CALL Put_s crlf||pathn||filen||' ALREADY EXISTS'||crlf,screen_handle
  308.     RETURN ; END
  309.   IF xcmd='U' & dpfname='' THEN DO
  310.     CALL Put_s crlf||pathn||filen||' NOT FOUND'||crlf,screen_handle
  311.     RETURN ; END
  312.   CALL Put_s xcmd filen xprot cr,port
  313.   DO FOREVER
  314.     match=Wait_fore('ot Accept','plicates','exists','not found','upload!',,
  315.     'p upload in','ription wi','Aborts','ommand','nter)',,
  316.     'erifying',port,screen_handle)
  317.     SELECT
  318.       WHEN match=0 THEN
  319.         SIGNAL Errh
  320.       WHEN match=6 THEN
  321.         CALL Put_s 'Y'||cr,port
  322.       WHEN match=7 THEN
  323.         CALL Put_s xdesc||cr||cr,port
  324.       WHEN match=8 THEN
  325.         CALL DoXfer
  326.       WHEN match=9 THEN
  327.         LEAVE
  328.       WHEN match=10 THEN
  329.         CALL Put_s cr,port
  330.       WHEN match=11 THEN
  331.         CALL Read_timeout '120000',port
  332.       OTHERWISE NOP
  333.     END
  334.   END
  335.   RETURN
  336.  
  337. DoXfer:
  338.   SELECT
  339.     WHEN xprot='Z' & xcmd='U' THEN DO
  340.       CALL zmodem_send dpfname,dde_output,dde_input ; END
  341.     WHEN xprot='Z' & xcmd='D' THEN DO
  342.       CALL Set_download_path pathn,dde_output
  343.       CALL zmodem_receive dde_output,dde_input ; END
  344.     OTHERWISE CALL Put_s crlf||sred||'XFER CALL ERROR',
  345.       crlf||swit,screen_handle ; END
  346.   RETURN
  347.  
  348. /*====================[HANDLE ERRORS]====================*/
  349. /* Print error message and yell, drop carrier if timeout */
  350. /*=======================================================*/
  351.  
  352. RexxErr:
  353.   IF 'rc'=rc THEN rc='undefined'
  354.   CALL Put_s crlf||sred||'REXX ERROR' rc 'in line' sigl ':',screen_handle
  355.   CALL Put_s Errortext(rc)||crlf||Sourceline(sigl)||swit||crlf,screen_handle
  356.   CALL Beep 40,2000
  357.   CALL Directory odir
  358.   CALL Sleep '30000'
  359.   CALL Drop_dtr port
  360.   CALL Sleep '2000'
  361.   CALL Raise_dtr port
  362.   EXIT
  363.  
  364. Errh:
  365.   CALL Put_s crlf||sred||'SCRIPT ERROR in line 'sigl||swit||crlf,screen_handle
  366.   DO 30 ; CALL Beep 1800,100 ; END
  367.   CALL Directory odir
  368.   CALL Sleep '30000'
  369.   CALL Drop_dtr port
  370.   CALL Sleep '2000'
  371.   CALL Raise_dtr port
  372.   EXIT
  373.  
  374. HostErr:
  375.   IF 'rc'=rc THEN rc='undefined'
  376.   CALL Put_s crlf||sred||'HOST CMD ERROR' rc 'in line' sigl ':',screen_handle
  377.   CALL Put_s Errortext(rc)||crlf||Sourceline(sigl)||swit||crlf,screen_handle
  378.   CALL Beep 40,2000
  379.   CALL Directory odir
  380.   RETURN
  381.  
  382. ExitScr:
  383.   DO 3 ; CALL Beep 800,300 ; END
  384.   CALL Put_s crlf||'PCBOARD.CMD Terminated at line 'sigl||crlf,screen_handle
  385.   CALL Directory odir
  386.   EXIT
  387.  
  388. Flush:
  389.   DO WHILE Char_avail(port)>0
  390.     CALL Put_s Get_ch(port),screen_handle
  391.   END
  392.   RETURN
  393.  
  394. Delay:
  395.   DO 5
  396.     CALL Sleep '1000'
  397.     CALL Beep 2000,50
  398.   END
  399.   RETURN
  400.  
  401. /*====================[GET BBS PWORD]====================*/
  402. /* Searches scrollback buffer for BBS ID line before the */
  403. /* PCBoard version ID line, sets password and qmail vars */
  404. /* May fail due to line noise, handshake problems, etc.  */
  405. /*=======================================================*/
  406.  
  407. GetBbs:
  408.   currow=Get_cursor_position('row',dde_output,dde_input)
  409.   found=0
  410.   DO lcnt=currow-1 TO currow-100 BY -1 UNTIL found>0 | currow=0
  411.     line=Get_char_at(lcnt,0,40,dde_output,dde_input)
  412.     found=Pos('PCBoard (R)',line)
  413.   END
  414.   line=Get_char_at(lcnt-1,0,40,dde_output,dde_input)
  415.   line=Translate(line)
  416.   SELECT
  417.     WHEN Pos('INVENTION',line)\=0 THEN DO
  418.       pword='PASSWORD'                 /* your password for BBS */
  419.       qmail='YES INV-FAC Z' ; END      /* YES, packet name, protocol */
  420.     WHEN Pos('ACE PREMIUM',line)\=0 THEN DO
  421.       pword='PASSWORD'
  422.       qmail='YES ACEBBS Z' ; END
  423.     WHEN Pos('DARK SIDE',line)\=0 THEN DO
  424.       pword='PASSWORD'
  425.       qmail='YES DARKSIDE Z' ; END
  426.     WHEN Pos('YOUR ASCII',line)\=0 THEN
  427.       pword='PASSWORD'
  428.     WHEN Pos('BROTHERS',line)\=0 THEN
  429.       pword='PASSWORD'
  430.     OTHERWISE DO
  431.       DO tone=1500 TO 2500 BY 100
  432.         CALL Beep tone,50 ; END
  433.       CALL Put_s ' <ENTER MANUALLY!> ',screen_handle
  434.       CALL SLEEP '20000'
  435.       pword='' ; END
  436.   END
  437.   RETURN
  438.  
  439.