home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 18 / CD_ASCQ_18_111294_W.iso / dos / prg / pas / pcl4p42 / term.pas < prev    next >
Pascal/Delphi Source File  |  1994-08-23  |  12KB  |  382 lines
  1. (**********************************************)
  2. (*                                            *)
  3. (*      TERM.PAS         Aug  1994            *)
  4. (*                                            *)
  5. (*  TERM is a simple terminal emulator which  *)
  6. (*  features XMODEM, YMODEM, YMODEM-G, and    *)
  7. (*  ASCII file transfer.                      *)
  8. (*                                            *)
  9. (*  Do NOT select YMODEM-G when using a null  *)
  10. (*  modem cable unless you are certain that   *)
  11. (*  RTS & CTS are reversed -- which is        *)
  12. (*  usually not true.                         *)
  13. (*                                            *)
  14. (*  Remember that you cannot send or receive  *)
  15. (*  binary files with ascii protocol - this   *)
  16. (*  includes many word processor file formats *)
  17. (*  such as used by Wordstar.                 *)
  18. (*                                            *)
  19. (*  This program is donated to the Public     *)
  20. (*  Domain by MarshallSoft Computing, Inc.    *)
  21. (*  It is provided as an example of the use   *)
  22. (*  of the Personal Communications Library.   *)
  23. (*                                            *)
  24. (**********************************************)
  25.  
  26. {$I DEFINES.PAS}
  27.  
  28. program term;
  29.  
  30. {$IFDEF SCRIPTS}
  31. uses si, hex_io, term_io, modem_io, xymodem, xypacket, amodem, crc, crt, PCL4P;
  32. {$ELSE}
  33. uses hex_io, term_io, modem_io, xymodem, xypacket, amodem, crc, crt, PCL4P;
  34. {$ENDIF}
  35.  
  36.  
  37. Var (* globals *)
  38.   ResetFlag : Boolean;
  39.   Port : Integer;
  40.   TxBufPtr : Pointer;
  41.   RxBufPtr : Pointer;
  42.   TxBufSeg : Integer;
  43.   RxBufSeg : Integer;
  44.  
  45.   procedure MyHalt( Code : Integer );
  46.   var
  47.      RetCode : Integer;
  48.   begin
  49.      if Code < 0 then SayError( Code,'Halting' );
  50.      if ResetFlag then RetCode := SioDone(Port);
  51.      writeln('*** HALTING ***');
  52.      Halt;
  53.   end;
  54.  
  55. (* main program *)
  56.  
  57. label 500;
  58.  
  59. const
  60.   NAK = $15;
  61.   WrongBaud1 = 'Cannot recognize baud rate';
  62.   WrongBaud2 = 'Must be 300,600,1200,2400,4800,9600,19200,38400,57600, or 155200';
  63.  
  64. var
  65.   Filename : String12;
  66.   ResultMsg: String40;
  67.   c        : Char;
  68.   BaudCode : Integer;
  69.   Protocol : Char;
  70.   Buffer   : BufferType;
  71.   RetCode  : Integer;
  72.   TheByte  : Char;
  73.   i        : Integer;
  74.   MenuMsg  : String40;
  75.   StatusMsg: String40;
  76.   GetNameMsg: String40;
  77.   Text40   : String40;
  78.   OneKflag : Boolean;
  79.   NCGbyte  : Byte;
  80.   BatchFlag: Boolean;
  81.   Flag     : Boolean;
  82.   Version  : Integer;
  83.   TermChar : Byte;
  84.   CharPace : Integer;
  85.   Timeout  : Integer;
  86.   EchoFlag : Boolean;
  87. begin   (* main program *)
  88.   InitCRC;
  89.   TextMode(BW80);
  90.   ClrScr;
  91.   Window(1,1,80,24);
  92.   ResetFlag := FALSE;
  93.   Protocol := 'X';
  94.   OneKflag := FALSE;
  95.   NCGbyte := NAK;
  96.   BatchFlag := FALSE;
  97.   MenuMsg := 'Q)uit P)rotocol S)end R)eceive: ';
  98.   GetNameMsg := 'Enter filename: ';
  99.   StatusMsg := 'COM? X  "ESC for menu" ';
  100.   (* fetch PORT # from command line *)
  101.   if ParamCount < 2 then
  102.     begin
  103.       writeln('USAGE: "TERM <port> <baudrate> {script}" ');
  104.       halt;
  105.     end;
  106.   Val( ParamStr(1),Port, RetCode );
  107.   if RetCode <> 0 then
  108.     begin
  109.       writeln('Port must be 1 to 16');
  110.       Halt;
  111.     end;
  112.   (* COM1 = 0, COM2 = 1, etc. *)
  113.   Port := Port - 1;
  114.   BaudCode := MatchBaud(ParamStr(2));
  115.   if BaudCode < 0 then
  116.     begin
  117.       writeln(WrongBaud1);
  118.       writeln(WrongBaud2);
  119.       halt;
  120.     end;
  121.   (* patch up status message *)
  122.   StatusMsg[4] := chr($31+Port);
  123.   Insert(ParamStr(2),StatusMsg,8);
  124.   WriteMsg(StatusMsg,40);
  125.   if (Port<COM1) or (Port>COM16) then
  126.     begin
  127.       writeln('Port must be 1 to 16');
  128.       Halt
  129.     end;
  130.  
  131.   (*** custom configuration: 4 port card
  132.   RetCode := SioIRQ(COM3,IRQ2);
  133.   RetCode := SioIRQ(COM4,IRQ2);
  134.   ***)
  135.  
  136.   (*** custom configuration: DigiBoard PC/8
  137.   RetCode := SioPorts(8,COM1,$140,DIGIBOARD);
  138.   RetCode := SioUART(Port,$100+8*Port) ;
  139.   if RetCode < 0 then MyHalt( RetCode );
  140.   RetCode := SioIRQ(Port,IRQ5) ;
  141.   if RetCode < 0 then MyHalt( RetCode );
  142.   ***)
  143.  
  144.   (*** custom configuration: BOCA board BB2016
  145.   RetCode := SioPorts(16,COM1,$107,BOCABOARD);
  146.   RetCode := SioUART(Port,$100+8*Port) ;
  147.   if RetCode < 0 then MyHalt( RetCode );
  148.   RetCode := SioIRQ(Port,IRQ5) ;
  149.   if RetCode < 0 then MyHalt( RetCode );
  150.   ***)
  151.  
  152.   (* setup 2K receive buffer *)
  153.   GetMem(RxBufPtr,2048+16);
  154.   RxBufSeg := (Seg(RxBufPtr)+1) + (Ofs(RxBufPtr) SHR 4);
  155.   RetCode := SioRxBuf(Port, RxBufSeg, Size2048);
  156.   if RetCode < 0 then MyHalt( RetCode );
  157.   (* setup 2K transmit buffer *)
  158.   GetMem(TxBufPtr,2048+16);
  159.   TxBufSeg := (Seg(TxBufPtr)+1) + (Ofs(TxBufPtr) SHR 4);
  160.   RetCode := SioTxBuf(Port, TxBufSeg, Size2048);
  161.   if RetCode < 0 then MyHalt( RetCode );
  162.   (* reset port *)
  163.   RetCode := SioReset(Port,BaudCode);
  164.   (* if error then try one more time *)
  165.   if RetCode <> 0 then RetCode := SioReset(Port,BaudCode);
  166.   (* Was port reset ? *)
  167.   if RetCode <> 0 then
  168.     begin
  169.       writeln('Cannot reset COM',Port+1);
  170.       MyHalt( RetCode );
  171.     end;
  172.   (* Port successfully reset *)
  173.   ResetFlag := TRUE;
  174.   ClrScr;
  175.   (* show logon message *)
  176.   WriteLn('   -- TERM 7/16/94 --');
  177.   WriteLn;
  178.   Write('TX interrupts: ');
  179.   if SioInfo('I') = 0 then WriteLn('NO')
  180.   else WriteLn('YES');
  181.   Version := SioInfo('V');
  182.   WriteLn('      Library: ',Version SHR 4,'.',15 AND Version);
  183.   (* specify parity, # stop bits, and word length for port *)
  184.   RetCode := SioParms(Port, NoParity, OneStopBit, WordLength8);
  185.   if RetCode < 0 then MyHalt( RetCode );
  186.   RetCode := SioRxFlush(Port);
  187.   if RetCode < 0 then MyHalt( RetCode );
  188.   Write(' Flow control: ');
  189. {$IFDEF RTS_CTS_CONTROL}
  190.   (* enable RTS/CTS flow control *)
  191.   RetCode := SioFlow(Port,10*18);
  192.   WriteLn('YES');
  193. {$ELSE}
  194.   WriteLn('NO');
  195. {$ENDIF}
  196.   (* set FIFO level if have INS16550 *)
  197.   RetCode := SioFIFO(Port, LEVEL_8);
  198.   Write('   16550 UART: ');
  199.   if RetCode > 0 then WriteLn('YES')
  200.   else WriteLn('NO');
  201.   WriteLn;
  202.   (* set DTR & RTS *)
  203.   RetCode := SioDTR(Port,SetPort);
  204.   RetCode := SioRTS(Port,SetPort);
  205.  
  206. {$IFDEF AT_COMMAND_SET}
  207.   Write('Waiting for DSR');
  208.   repeat
  209.     if SioBrkKey OR KeyPressed then
  210.       begin
  211.         Write('Aborted by user...');
  212.         RetCode := SioDone(Port);
  213.         Halt
  214.       end;
  215.     Write('.');
  216.     RetCode := SioDelay(18);
  217.   until (SioDSR(Port)>0);
  218.   WriteLn;
  219. {$ENDIF}
  220.  
  221. {$IFDEF RTS_CTS_CONTROL}
  222.   Write('Waiting for CTS');
  223.   repeat
  224.     if SioBrkKey OR KeyPressed then
  225.       begin
  226.         Write('Aborted by user...');
  227.         RetCode := SioDone(Port);
  228.         Halt
  229.       end;
  230.     Write('.');
  231.     RetCode := SioDelay(18);
  232.   until (SioCTS(Port)>0);
  233.   WriteLn;
  234. {$ENDIF}
  235.  
  236. {$IFDEF AT_COMMAND_SET}
  237.   (* send initialization string to modem *)
  238.   Flag := ModemSendTo(Port,5,'!!AT E1 S7=60 S11=60 V1 X1 Q0 S0=1!');
  239.   if ModemWaitFor(Port,100,FALSE,'OK') then
  240.     begin
  241.       writeln; writeln('MODEM ready');
  242.     end
  243.   else writeln('WARNING: Expected OK not received');
  244. {$ENDIF}
  245.  
  246.  
  247. {$IFDEF SCRIPTS}
  248.   if ParamCount = 3 then
  249.   begin
  250.     RetCode := Script(Port,ParamStr(3),False);
  251.     if RetCode < 0 then SaySiErr(RetCode);
  252.   end;
  253. {$ENDIF}
  254.  
  255.   (* begin terminal loop *)
  256.   writeln;
  257.   writeln('Enter terminal loop ( Type ESC for menu )');
  258.   WriteMsg(StatusMsg,40);
  259.   LowVideo;
  260.   while TRUE do
  261.     begin (* while TRUE *)
  262.       (* did user press Ctrl-BREAK ? *)
  263.       if SioBrkKey then
  264.         begin
  265.           writeln('User typed Ctl-BREAK');
  266.           RetCode := SioDone(Port);
  267.           Halt;
  268.         end;
  269.       (* anything incoming over serial port ? *)
  270.       RetCode := SioGetc(Port,1);
  271.       if RetCode < -1 then MyHalt( RetCode );
  272.       if RetCode > -1 then write(chr(RetCode));
  273.       (* has user pressed keyboard ? *)
  274.       if KeyPressed then
  275.         begin (* keypressed *)
  276.           (* read keyboard *)
  277.           TheByte := ReadKey;
  278.           (* quit if user types ESC *)
  279.           if TheByte = chr($1b) then
  280.             begin (* ESC *)
  281.               WriteMsg(MenuMsg,1);
  282.               ReadMsg(ResultMsg,32,1);
  283.               c := UpCase(ResultMsg[1]);
  284.               case c of
  285.                 'Q':  (* QUIT *)
  286.                    begin
  287.                      WriteLn;
  288.                      WriteLn('TERMINATING: User pressed <ESC>');
  289.                      RetCode := SioDone(Port);
  290.                      Halt;
  291.                    end;
  292.                 'P':  (* PROTOCOL *)
  293.                    begin
  294.                      WriteMsg('A)scii X)modem Y)modem ymodem-G): ',1);
  295.                      ReadMsg(ResultMsg,35,1);
  296.                      c := UpCase(ResultMsg[1]);
  297.                      case c of
  298.                        'A': (* ASCII *)
  299.                           begin
  300.                             Protocol := 'A';
  301.                             (* setup ascii parameters *)
  302.                             TermChar := $18; (* CAN or control-X *)
  303.                             CharPace := 5;   (* 5 ms inter-byte delay *)
  304.                             Timeout := 7;    (* timeout after 7 seconds *)
  305.                             EchoFlag := TRUE;(* local echo *)
  306.                             WriteMsg('Protocol = ASCII',1);
  307.                           end;
  308.                        'X': (* XMODEM *)
  309.                           begin
  310.                             Protocol := 'X';
  311.                             OneKflag := FALSE;
  312.                             NCGbyte := NAK;
  313.                             BatchFlag := FALSE;
  314.                             WriteMsg('Protocol = XMODEM',1);
  315.                           end;
  316.                        'Y': (* YMODEM *)
  317.                           begin
  318.                             Protocol := 'Y';
  319.                             OneKflag := TRUE;
  320.                             NCGbyte := Ord('C');
  321.                             BatchFlag := TRUE;
  322.                             WriteMsg('Protocol = YMODEM',1);
  323.                           end;
  324.                        'G': (* YMODEM-G *)
  325.                           begin
  326.                             Protocol := 'G';
  327.                             OneKflag := TRUE;
  328.                             NCGbyte := Ord('G');
  329.                             BatchFlag := TRUE;
  330.                             WriteMsg('Protocol = YMODEM-G',1);
  331.                           end;
  332.                      end; (* case *)
  333.                      StatusMsg[6] := Protocol;
  334.                      WriteMsg(StatusMsg,40)
  335.                    end;
  336.                 'S': (* Send *)
  337.                    begin
  338.                      WriteMsg(GetNameMsg,1);
  339.                      ReadMsg(Text40,16,20);
  340.                      Filename := Text40;
  341.                      if Length(FileName) = 0 then goto 500;
  342.                      if Protocol = 'A' then
  343.                        begin
  344.                          (* Ascii *)
  345.                          Flag := TxAscii(Port,Filename,Buffer,CharPace,TermChar,Timeout,EchoFlag);
  346.                        end
  347.                      else
  348.                        begin
  349.                          Filename := '';
  350.                          if BatchFlag then Flag := YmodemTx(Port,Filename,Buffer,OneKflag)
  351.                          else Flag := XmodemTx(Port,Filename,Buffer,OneKflag);
  352.                        end
  353.                      end; (* Send *)
  354.                 'R': (* Receive *)
  355.                    begin
  356.                      if Protocol = 'A' then
  357.                        begin
  358.                          (* Ascii *)
  359.                          WriteMsg(GetNameMsg,1);
  360.                          ReadMsg(Text40,16,20);
  361.                          Filename := Text40;
  362.                          if Length(FileName) = 0 then goto 500;
  363.                          Flag := RxAscii(Port,Filename,Buffer,xyBufferSize,TermChar,Timeout,EchoFlag);
  364.                        end
  365.                      else
  366.                        begin
  367.                          Filename := '';
  368.                          if BatchFlag then Flag := YmodemRx(Port,Filename,Buffer,NCGbyte)
  369.                          else Flag := XmodemRx(Port,Filename,Buffer,NCGbyte);
  370.                        end
  371.                      end (* Receive *)
  372.                    else WriteMsg('Bad response',1);
  373.                    end; (* case *)
  374.                    500:
  375.                 end; (* ESC *)
  376.               (* send out over serial line *)
  377.               RetCode := SioPutc(Port, TheByte );
  378.               if RetCode < 0 then MyHalt( RetCode );
  379.             end (* keypressed *)
  380.       end (* while TRUE *)
  381. end.
  382.