home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / PCL4P31.ZIP / TERM.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-03-11  |  8.4 KB  |  268 lines
  1. (*********************************************)
  2. (*                                           *)
  3. (*      TERM.PAS          Jan 1992           *)
  4. (*                                           *)
  5. (*  TERM is a simple terminal emulator which *)
  6. (*  features XMODEM and YMODEM file transfer *)
  7. (*                                           *)
  8. (*  This program is donated to the Public    *)
  9. (*  Domain by MarshallSoft Computing, Inc.   *)
  10. (*  It is provided as an example of the use  *)
  11. (*  of the Personal Communications Library.  *)
  12. (*                                           *)
  13. (*********************************************)
  14.  
  15. {   $DEFINE HAYES}
  16.  
  17. program term;
  18. uses term_io, modem_io, xymodem, xypacket, crc, crt, PCL4P;
  19.  
  20. Var
  21.   ResetFlag : Boolean;
  22.   Port : Integer;
  23.   SioBuffer : array[0..2047] of Byte;
  24.  
  25. function MatchBaud(BaudRate : LongInt) : Integer;
  26. Label 999;
  27. const
  28.    BaudRateArray : array[1..10] of LongInt =
  29.        (300,600,1200,2400,4800,9600,19200,38400,57600,115200);
  30. var
  31.    i : Integer;
  32. begin
  33.    for i := 1 to 10 do if BaudRateArray[i] = BaudRate then
  34.       begin
  35.         MatchBaud := i - 1;
  36.         goto 999
  37.       end;
  38.    (* no match *)
  39.    MatchBaud := -1;
  40. 999: end;
  41.  
  42. procedure MyHalt( Code : Integer );
  43. var
  44.    RetCode : Integer;
  45. begin
  46.    if Code < 0 then SayError( Code,'Halting' );
  47.    if ResetFlag then RetCode := SioDone(Port);
  48.    writeln('*** HALTING ***');
  49.    Halt;
  50. end;
  51.  
  52. (* main program *)
  53.  
  54. label 500;
  55.  
  56. const
  57.   WrongBaud1 = 'Cannot recognize baud rate';
  58.   WrongBaud2 = 'Must be 300,600,1200,2400,4800,9600,19200,38400,57600, or 155200';
  59.  
  60. var
  61.   Filename : String20;
  62.   c : Char;
  63.   BaudRate : LongInt;
  64.   BaudCode : Integer;
  65.   Protocol : Char;
  66.   Buffer  : BufferType;
  67.   RetCode : Integer;
  68.   Byte : Char;
  69.   i    : Integer;
  70.   MenuMsg : String40;
  71.   StatusMsg : String40;
  72.   ResultMsg : String20;
  73.   GetNameMsg: String40;
  74.   OneKflag : Boolean;
  75.   CRCflag  : Boolean;
  76.   BatchFlag: Boolean;
  77.   Flag : Boolean;
  78. begin   (* main program *)
  79.   InitCRC;
  80.   TextMode(BW80);
  81.   ClrScr;
  82.   Window(1,1,80,24);
  83.   ResetFlag := FALSE;
  84.   Protocol := 'X';
  85.   OneKflag := FALSE;
  86.   CRCflag := TRUE;
  87.   BatchFlag := FALSE;
  88.   MenuMsg := 'Q)uit P)rotocol S)end R)eceive: ';
  89.   GetNameMsg := 'Enter filename: ';
  90.   StatusMsg := 'COM? X  "ESC for menu"';
  91.   (* fetch PORT # from command line *)
  92.   if ParamCount <> 2 then
  93.     begin
  94.       writeln('USAGE: "TERM <port> <buadrate>" ');
  95.       halt;
  96.     end;
  97.   Val( ParamStr(1),Port, RetCode );
  98.   if RetCode <> 0 then
  99.     begin
  100.       writeln('Port must be 1 to 4');
  101.       Halt;
  102.     end;
  103.   (* COM1 = 0, COM2 = 1, COM3 = 2, COM4 = 3 *)
  104.   Port := Port - 1;
  105.   Val( ParamStr(2),BaudRate, RetCode );
  106.   if RetCode <> 0 then
  107.     begin
  108.       writeln(WrongBaud1);
  109.       writeln(WrongBaud2);
  110.       Halt;
  111.     end;
  112.   BaudCode := MatchBaud(BaudRate);
  113.   if BaudCode < 0 then
  114.     begin
  115.       writeln(WrongBaud1);
  116.       writeln(WrongBaud2);
  117.       halt;
  118.     end;
  119.   (* patch up status message *)
  120.   StatusMsg[4] := chr($31+Port);
  121.   Insert(ParamStr(2),StatusMsg,8);
  122.   WriteMsg(StatusMsg,40);
  123.   if (Port<COM1) or (Port>COM4) then
  124.     begin
  125.       writeln('Port must be 1 to 4');
  126.       Halt
  127.     end;
  128.   (* setup 1K receive buffer *)
  129.   RetCode := SioRxBuf(Port, Ofs(SioBuffer), Seg(SioBuffer), Size2048);
  130.   if RetCode < 0 then MyHalt( RetCode );
  131.   (* reset port *)
  132.   RetCode := SioReset(Port,BaudCode);
  133.   (* if error then try one more time *)
  134.   if RetCode <> 0 then RetCode := SioReset(Port,BaudCode);
  135.   (* Was port reset ? *)
  136.   if RetCode <> 0 then
  137.     begin
  138.       writeln('Cannot reset COM',Port+1);
  139.       MyHalt( RetCode );
  140.     end;
  141.   (* Port successfully reset *)
  142.   ResetFlag := TRUE;
  143.   ClrScr;
  144.   (* specify parity, # stop bits, and word length for port *)
  145.   RetCode := SioParms(Port, NoParity, OneStopBit, WordLength8);
  146.   if RetCode < 0 then MyHalt( RetCode );
  147.   RetCode := SioRxFlush(Port);
  148.   if RetCode < 0 then MyHalt( RetCode );
  149.   (* set FIFO level if have INS16550 *)
  150.   RetCode := SioFIFO(Port, LEVEL_8);
  151.   if RetCode > 0 then writeln('INS16550 detected');
  152.   (* send initialization string to modem *)
  153.  
  154. {$IFDEF HAYES}
  155.   RetCode := SioDTR(Port,SETON);
  156.   RetCode := SioRTS(Port,SETON);
  157.   SendTo(Port,'!AT E1 S7=60 S11=60 V1 X1 Q0 S0=1!');
  158.   if not WaitFor(Port,'OK') then
  159.     begin
  160.       writeln('Expected OK not received');
  161.       MyHalt(0);
  162.     end;
  163.   writeln;
  164.   writeln('MODEM ready');
  165. {$ENDIF}
  166.  
  167.   (* begin terminal loop *)
  168.   WriteMsg(StatusMsg,40);
  169.   LowVideo;
  170.   while TRUE do
  171.     begin (* while TRUE *)
  172.       (* did user press Ctrl-BREAK ? *)
  173.       if SioBrkKey then
  174.         begin
  175.           writeln('User typed Ctl-BREAK');
  176.           RetCode := SioDone(Port);
  177.           Halt;
  178.         end;
  179.       (* anything incoming over serial port ? *)
  180.       RetCode := SioGetc(Port,0);
  181.       if RetCode < -1 then MyHalt( RetCode );
  182.       if RetCode > -1 then write(chr(RetCode));
  183.       (* has user pressed keyboard ? *)
  184.       if KeyPressed then
  185.         begin (* keypressed *)
  186.           (* read keyboard *)
  187.           Byte := ReadKey;
  188.           (* quit if user types ESC *)
  189.           if Byte = chr($1b) then
  190.             begin (* ESC *)
  191.               WriteMsg(MenuMsg,1);
  192.               ReadMsg(ResultMsg,32,1);
  193.               c := UpCase(ResultMsg[1]);
  194.               case c of
  195.                 'Q':  (* QUIT *)
  196.                    begin
  197.                      WriteLn;
  198.                      WriteLn('TERMINATING: User pressed <ESC>');
  199.                      RetCode := SioDone(Port);
  200.                      Halt;
  201.                    end;
  202.                 'P':  (* PROTOCOL *)
  203.                    begin
  204.                      WriteMsg('     Choose X)modem or Y)modem:  ',1);
  205.                      ReadMsg(ResultMsg,32,1);
  206.                      c := UpCase(ResultMsg[1]);
  207.                      case c of
  208.                        'X': (* XMODEM *)
  209.                           begin
  210.                             Protocol := 'X';
  211.                             OneKflag := FALSE;
  212.                             CRCflag := TRUE;
  213.                             BatchFlag := FALSE;
  214.                             WriteMsg('Protocol = XMODEM',1);
  215.                           end;
  216.                        'Y': (* YMODEM *)
  217.                           begin
  218.                             Protocol := 'Y';
  219.                             OneKflag := TRUE;
  220.                             CRCflag := TRUE;
  221.                             BatchFlag := TRUE;
  222.                             WriteMsg('Protocol = YMODEM',1);
  223.                           end;
  224.                      end; (* case *)
  225.                      StatusMsg[6] := Protocol;
  226.                      WriteMsg(StatusMsg,40)
  227.                    end;
  228.                 'S': (* Send *)
  229.                    begin
  230.                      WriteMsg(GetNameMsg,1);
  231.                      ReadMsg(Filename,16,20);
  232.                      if Length(FileName) = 0 then goto 500;
  233.                      Flag := TxyModem(Port,Filename,Buffer,OneKflag,BatchFlag);
  234.                      if BatchFlag then
  235.                        begin
  236.                          (* send empty filename *)
  237.                          Filename := '';
  238.                          RetCode := SioDelay(5);
  239.                          Flag := TxyModem(Port,Filename,Buffer,OneKflag,BatchFlag);
  240.                        end
  241.                      end; (* Send *)
  242.                   'R': (* Receive *)
  243.                      begin
  244.                        if BatchFlag then
  245.                          repeat
  246.                            WriteMsg('Ready for next file',1);
  247.                            Filename := '';
  248.                            Flag := RxyModem(Port,Filename,Buffer,CRCflag,BatchFlag);
  249.                          until KeyPressed or (Length(Filename) = 0)
  250.                        else
  251.                          begin (* not BatchFlag *)
  252.                            WriteMsg(GetNameMsg,1);
  253.                            ReadMsg(Filename,16,20);
  254.                            If Length(Filename) = 0 then exit;
  255.                            Flag := RxyModem(Port,Filename,Buffer,CRCflag,BatchFlag);
  256.                          end
  257.                      end (* Receive *)
  258.                    else WriteMsg('Bad response',1);
  259.                    end; (* case *)
  260.                    500:
  261.                 end; (* ESC *)
  262.               (* send out over serial line *)
  263.               RetCode := SioPutc(Port, Byte );
  264.               if RetCode < 0 then MyHalt( RetCode );
  265.             end (* keypressed *)
  266.       end (* while TRUE *)
  267. end.
  268.