home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / PASCAL / PCL4P30.ZIP / TERM.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-01-27  |  8.3 KB  |  265 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.   (* send initialization string to modem *)
  150.  
  151. {$IFDEF HAYES}
  152.   RetCode := SioDTR(Port,SETON);
  153.   RetCode := SioRTS(Port,SETON);
  154.   SendTo(Port,'!AT E1 S7=60 S11=60 V1 X1 Q0 S0=1!');
  155.   if not WaitFor(Port,'OK') then
  156.     begin
  157.       writeln('Expected OK not received');
  158.       MyHalt(0);
  159.     end;
  160.   writeln;
  161.   writeln('MODEM ready');
  162. {$ENDIF}
  163.  
  164.   (* begin terminal loop *)
  165.   WriteMsg(StatusMsg,40);
  166.   LowVideo;
  167.   while TRUE do
  168.     begin (* while TRUE *)
  169.       (* did user press Ctrl-BREAK ? *)
  170.       if SioBrkKey then
  171.         begin
  172.           writeln('User typed Ctl-BREAK');
  173.           RetCode := SioDone(Port);
  174.           Halt;
  175.         end;
  176.       (* anything incoming over serial port ? *)
  177.       RetCode := SioGetc(Port,0);
  178.       if RetCode < -1 then MyHalt( RetCode );
  179.       if RetCode > -1 then write(chr(RetCode));
  180.       (* has user pressed keyboard ? *)
  181.       if KeyPressed then
  182.         begin (* keypressed *)
  183.           (* read keyboard *)
  184.           Byte := ReadKey;
  185.           (* quit if user types ESC *)
  186.           if Byte = chr($1b) then
  187.             begin (* ESC *)
  188.               WriteMsg(MenuMsg,1);
  189.               ReadMsg(ResultMsg,32,1);
  190.               c := UpCase(ResultMsg[1]);
  191.               case c of
  192.                 'Q':  (* QUIT *)
  193.                    begin
  194.                      WriteLn;
  195.                      WriteLn('TERMINATING: User pressed <ESC>');
  196.                      RetCode := SioDone(Port);
  197.                      Halt;
  198.                    end;
  199.                 'P':  (* PROTOCOL *)
  200.                    begin
  201.                      WriteMsg('     Choose X)modem or Y)modem:  ',1);
  202.                      ReadMsg(ResultMsg,32,1);
  203.                      c := UpCase(ResultMsg[1]);
  204.                      case c of
  205.                        'X': (* XMODEM *)
  206.                           begin
  207.                             Protocol := 'X';
  208.                             OneKflag := FALSE;
  209.                             CRCflag := TRUE;
  210.                             BatchFlag := FALSE;
  211.                             WriteMsg('Protocol = XMODEM',1);
  212.                           end;
  213.                        'Y': (* YMODEM *)
  214.                           begin
  215.                             Protocol := 'Y';
  216.                             OneKflag := TRUE;
  217.                             CRCflag := TRUE;
  218.                             BatchFlag := TRUE;
  219.                             WriteMsg('Protocol = YMODEM',1);
  220.                           end;
  221.                      end; (* case *)
  222.                      StatusMsg[6] := Protocol;
  223.                      WriteMsg(StatusMsg,40)
  224.                    end;
  225.                 'S': (* Send *)
  226.                    begin
  227.                      WriteMsg(GetNameMsg,1);
  228.                      ReadMsg(Filename,16,20);
  229.                      if Length(FileName) = 0 then goto 500;
  230.                      Flag := TxyModem(Port,Filename,Buffer,OneKflag,BatchFlag);
  231.                      if BatchFlag then
  232.                        begin
  233.                          (* send empty filename *)
  234.                          Filename := '';
  235.                          RetCode := SioDelay(5);
  236.                          Flag := TxyModem(Port,Filename,Buffer,OneKflag,BatchFlag);
  237.                        end
  238.                      end; (* Send *)
  239.                   'R': (* Receive *)
  240.                      begin
  241.                        if BatchFlag then
  242.                          repeat
  243.                            WriteMsg('Ready for next file',1);
  244.                            Filename := '';
  245.                            Flag := RxyModem(Port,Filename,Buffer,CRCflag,BatchFlag);
  246.                          until KeyPressed or (Length(Filename) = 0)
  247.                        else
  248.                          begin (* not BatchFlag *)
  249.                            WriteMsg(GetNameMsg,1);
  250.                            ReadMsg(Filename,16,20);
  251.                            If Length(Filename) = 0 then exit;
  252.                            Flag := RxyModem(Port,Filename,Buffer,CRCflag,BatchFlag);
  253.                          end
  254.                      end (* Receive *)
  255.                    else WriteMsg('Bad response',1);
  256.                    end; (* case *)
  257.                    500:
  258.                 end; (* ESC *)
  259.               (* send out over serial line *)
  260.               RetCode := SioPutc(Port, Byte );
  261.               if RetCode < 0 then MyHalt( RetCode );
  262.             end (* keypressed *)
  263.       end (* while TRUE *)
  264. end.
  265.