home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / perqa / kermit.pas < prev    next >
Pascal/Delphi Source File  |  2020-01-01  |  8KB  |  256 lines
  1. PROGRAM Kermit(Input,Output);
  2. (*)
  3.  * 29-Nov-83 Allow eight bit file transfer with SET EIGHT-BIT ON/OFF
  4.  *           add global flag and extra SET command   [pgt001]
  5.  *           For byte value 0..255 the end of (data) string value is now -1,
  6.  *           and end of file value -2.
  7.  *  1-Dec-83 Place all globals into module KermitGlobals.
  8. (*)
  9.  
  10.  
  11.  
  12. IMPORTS Stdio           FROM Stdio ;
  13. IMPORTS KermitGlobals   FROM KermitGlobals ; (**********)
  14. IMPORTS KermitUtils     FROM KermitUtils ;
  15. IMPORTS KermitParms     FROM KermitParms ;
  16. IMPORTS KermitHelp      FROM KermitHelp ;
  17. IMPORTS KermitError     FROM KermitError ;
  18. IMPORTS KermitSend      FROM KermitSend ;
  19. IMPORTS KermitRecv      FROM KermitRecv ;
  20.  
  21. IMPORTS Connect232      FROM Connect232 ;
  22. IMPORTS PMatch          FROM PMatch ;
  23. IMPORTS PopCmdParse     FROM PopCmdParse ;
  24. IMPORTS Perq_String     FROM Perq_String ;
  25. IMPORTS Screen          FROM Screen ;
  26. IMPORTS IO_Unit         FROM IO_Unit ;
  27. IMPORTS IOErrors        FROM IOErrors;
  28. IMPORTS IO_Others       FROM IO_Others;
  29. IMPORTS System          FROM System;
  30. IMPORTS Sleep           FROM Sleep;
  31.  
  32.  
  33.  
  34.  
  35.  
  36.  
  37.    (* Handle ^C's from the console -pt*)
  38. HANDLER CtlC ;
  39.    BEGIN   (*-CtlC-*)
  40.       IOKeyClear ;             (* Remove ^C from input stream *)
  41.       CtrlCPending := False ;  (* Clear to prevent next ^C from aborting job *)
  42.       FromConsole := AbortNow  (* Set our flag *)
  43.    END ;   (*-CtlC-*)
  44.  
  45.  
  46. HANDLER HelpKey(VAR str: Sys9s) ;
  47.    (* Make the HELP key generate the correct command (i.e. not a switch) -pt*)
  48.    BEGIN  (*-HelpKey-*)
  49.       str := 'HELP ' ;
  50.       str[5] := Chr( CR )
  51.    END ;  (*-HelpKey-*)
  52.  
  53. PROCEDURE OverHd( p,f: Stats;
  54.                  VAR o:Integer);
  55.  
  56.    (* Calculate OverHead as % *)
  57.    (* OverHead := (p-f)*100/f *)
  58.  
  59.    BEGIN
  60.       IF (f = 0.0) THEN o := 0
  61.       ELSE o := Round( (p-f)*100/f )
  62.    END;
  63.  
  64. PROCEDURE CalRat(f: Stats;
  65.                  t:Integer;
  66.                  VAR r:Integer);
  67.  
  68.    (* Calculate Effective Baud Rate *)
  69.    (* Rate = f*10/t *)
  70.  
  71.    BEGIN
  72.       IF (t = 0) THEN r := 0
  73.       ELSE r := Round( f*10/t )
  74.    END;
  75.  
  76.  
  77. PROCEDURE Statistics ;
  78.    VAR
  79.       overhead, effrate : Integer;
  80.    BEGIN  (*-Statistics-*)
  81.       (* print info on number of packets etc *)
  82.       (* All output here was originally to STDERR  -pt*)
  83.       Writeln ;
  84.       Writeln('Packets sent:     ',NumSendPacks:1);
  85.       Writeln('Packets received: ',NumRecvPacks:1);
  86.  
  87.       (* Calculate overhead *)
  88.       OverHd(ChInPack,ChInFile,overhead);
  89.       IF (Overhead <> 0) THEN
  90.          BEGIN
  91.             Writeln('Overhead (%):     ' ,overhead:1);
  92.          END;
  93.       IF (RunTime <> 0) THEN
  94.          BEGIN (* calculate effective rate *)
  95.             CalRat(ChInFile,RunTime,effrate);
  96.             Writeln('Effective Rate:   ',effrate:1);
  97.          END;
  98.  
  99.       (* Transmit stats *)
  100.       Inverse( TRUE ) ;
  101.       Writeln(' Send :-') ;
  102.       Inverse( FALSE ) ;
  103.       Writeln('Number of ACK:    ',NumACKrecv:1);
  104.       Writeln('Number of NAK:    ',NumNAKrecv:1);
  105.       Writeln('Number of BAD:    ',NumBADrecv:1);
  106.  
  107.       (* Transmit stats *)
  108.       Inverse( TRUE ) ;
  109.       Writeln(' Receive :-') ;
  110.       Inverse( FALSE ) ;
  111.       Writeln('Number of ACK:    ',NumACK:1);
  112.       Writeln('Number of NAK:    ',NumNAK:1);
  113.       Writeln
  114.    END ; (*-Statistics-*)
  115.  
  116. PROCEDURE FinishUp; (* do any End of Program clean up *)
  117.    BEGIN
  118.       Sclose(DiskFile);
  119.       SYSfinish;  (* do System dependent *)
  120.    END;
  121.  
  122.  
  123.  
  124. PROCEDURE DoConnect ;
  125.    (* Connect to the other host -pt*)
  126.    VAR
  127.       whyExit: ConExitFlag ; (* Why "connect" exited *)
  128.       ch: Char ;  (* the character after the "escape" char *)
  129.    BEGIN (*-DoConnect-*)
  130.       Writeln('[Connecting to host. Type Control-', EscPrint,
  131.               ' C   or any button on the puck]') ;
  132.       REPEAT
  133.          whyExit := Connect( EscapeChar, HalfDuplex, TRUE) ;
  134.          (* Get the command *)
  135.          IF (whyExit = ConButtonExit) THEN (* the button was pressed *)
  136.             BEGIN
  137.                Nap( 10 ) ;
  138.                ch := 'C'  (* Close the connection *)
  139.             END
  140.          ELSE
  141.             WHILE (IOCRead(TransKey, ch) <> IOEIOC) DO ;
  142.  
  143.          IF (ch = EscapeChar) THEN XmtChar( EscapeChar )
  144.          ELSE
  145.             IF (ch = '?') THEN
  146.                BEGIN
  147.                   Writeln ;
  148.                   Writeln('When CONNECT''ed to another host, type Control-', EscPrint) ;
  149.                   Writeln('followed by :-') ;
  150.                   Writeln('  C    to close the connection') ;
  151.                   Writeln('  ^', EscPrint, '   to send that character') ;
  152.                   Writeln('  ?    for this information') ;
  153.                   Writeln('[Back to host]')
  154.                END (* help *)
  155.  
  156.       UNTIL (Uppercase(ch) = 'C') ;
  157.       Writeln ;
  158.       Writeln('[Connection closed. Returning to PERQ]')
  159.    END ; (*-DoConnect-*)
  160.  
  161. BEGIN
  162.    StdIOInit;
  163.    SYSinit;             (*  system dependent  *)
  164.    done:=False;
  165.  
  166.    Writeln ;
  167.    REPEAT
  168.  
  169.       KermitInit;       (* initialize *)
  170.  
  171.       WHILE NOT (RunType IN [transmit, receive, setparm]) AND (NOT done)
  172.       DO
  173.          BEGIN
  174.             CmdIndex := GetCmdLine(NullIdleProc,  'Kermit-PQ',
  175.                                    CmdLine, CmdSpelling,
  176.                                    Inf, RECAST(MainMenu, pNameDesc),
  177.                                    firstPress, OK_to_pop) ;
  178.             ConvUpper( CmdSpelling ) ; (* Make it upper case *)
  179.             (* see what the command was *)
  180.             CASE  CmdIndex  OF
  181.                1:  DoConnect ;          (* CONNECT *)
  182.                2:  done := True ;       (* EXIT *)
  183.                3:  DoHelp ;             (* HELP *)
  184.                4:  done := True ;       (* QUIT *)
  185.                5:  RunType := Receive ; (* RECEIVE *)
  186.                6:  RunType := Transmit; (* SEND *)
  187.                7:  RunType := SetParm ; (* SET  *)
  188.                8:  DoShow ;             (* SHOW *)
  189.                9:  Statistics ;         (* STATISTICS *)
  190.  
  191.                10:  Writeln('%Not a KERMIT command: ', CmdSpelling) ;
  192.                11: Writeln('%Ambiguous command: ', CmdSpelling) ;
  193.                12: (* empty line *) ;
  194.                13: Writeln('%KERMIT does not take switches, type HELP.');
  195.                14: Writeln('?Illegal character after command') ; (* ?? *)
  196.                OTHERWISE: Writeln('?Unknown command: ', CmdSpelling)
  197.                END  (* case *)
  198.          END;
  199.  
  200.       CASE RunType OF
  201.          Receive:
  202.             BEGIN (* filename is optional here *)
  203.                (* Remove blanks from the cmd line *)
  204.                IF (CmdLine <> '') THEN RemDelimiters( CmdLine, ' ', dumStr) ;
  205.                IF GetArgument(aline) THEN
  206.                   BEGIN
  207.                      IF Exists(aline) AND FileWarning THEN
  208.                         BEGIN
  209.                            ErrorMsg('Overwriting: ');
  210.                            ErrorStr(aline);
  211.                         END;
  212.  
  213.                      IF EightBitFile THEN  (* [pgt001] *)
  214.                         DiskFile := Sopen(aline,StdIO8Write)
  215.                      ELSE
  216.                         DiskFile := Sopen(aline,StdIOWrite);
  217.  
  218.                      IF (DiskFile <= StdIOError) THEN
  219.                         ErrorPack('Cannot Open File');
  220.                   END;
  221.                RecvSwitch;
  222.             END;
  223.  
  224.          Transmit:
  225.             BEGIN  (* New version -pt*)
  226.                (* must give file name, so ask if one was not given -pt*)
  227.                IF (CmdLine = '') THEN
  228.                   BEGIN
  229.                      Write('File to transmit ', PromptChar) ;
  230.                      Readln( CmdLine )  (* get the response *)
  231.                   END ;
  232.  
  233.                (* What shall we do with the line ? *)
  234.                (* First remove blanks *)
  235.                RemDelimiters( CmdLine, ' ', dumStr) ;
  236.                IF (CmdLine = '') THEN (* another empty line, do nothing *)
  237.                ELSE
  238.                   IF IsPattern(CmdLine) THEN
  239.                      Writeln('%SEND does not take wild file names')
  240.                   ELSE
  241.                      SendSwitch (* SendFile checks parameters - file exists *)
  242.  
  243.             END;
  244.          Invalid:        (* nothing *);
  245.          SetParm:  SetParameters ;
  246.       END;
  247.       (* case *)
  248.  
  249.    UNTIL done;
  250.  
  251.    FinishUp; (* End of Program *)
  252.  
  253.    ScreenReset  (* Clear up screen data *)
  254. END.
  255.  
  256.