home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / c / qk3sas.pas < prev    next >
Pascal/Delphi Source File  |  2020-01-01  |  10KB  |  233 lines
  1. Unit SetShow ;
  2. Interface
  3.   uses Crt,             (* Standard Turbo Pascal Unit *)
  4.        KGlobals,        (* Kermit Globals *)
  5.        Modempro,
  6.        Sysfunc,
  7.        Packets,
  8.        Vt100,
  9.        Tek4010,
  10.        SendRecv ;
  11.     Procedure ShowOptions ;
  12.     Procedure SetOptions (var instring:String);
  13.     Procedure DisplayCommands;
  14. Implementation
  15. Type SetofChar = Set of Char ;
  16. (* ================================================================== *)
  17. (* ShowOptions - Show Parameter Options setting for Kermit.           *)
  18. (*                                                                    *)
  19. (* ================================================================== *)
  20. Procedure ShowOptions ;
  21.  
  22. Begin (* ShowOptions Procedure *)
  23. ClrScr ; (* Clear the Screen *)
  24. GotoXY(1,1);   (* Start at line 1 *)
  25. Writeln('         QK-KERMIT  version ',version,' -  ',Date);
  26. Writeln('            ',termtype,' ',graphics );
  27. Writeln(' ');
  28. Writeln('  Current Setting           Options ');
  29. Writeln('-------------------    --------------------------------------');
  30. Writeln('Baud Rate  = ',Baudrate,'      ( 300 600 1200 2400 4800 9600 19.2 )');
  31. Write  ('Parity     = ') ;
  32.   Case paritytype(parity) of
  33.      OddP : write('Odd  ');
  34.      EvenP: write('Even ');
  35.      MarkP: write('Mark ');
  36.      NoneP: write('None ');
  37.   end ; (* parity case *)
  38. Writeln('     ( Odd   Even  Mark  None ) ');
  39. Write  ('Duplex     = ');
  40.   If LocalEcho then Write('Half ')
  41.                else Write('Full ');
  42.   writeln('     ( Half  Full ) ');
  43.  
  44. Write  ('Protocol   = ');
  45.     If NoEcho  then write('NoEcho   ')
  46.                else If XonXoff then write('IBM-Xon  ')
  47.                                else write('Standard ');
  48.     writeln(' ( IBM-Xon    NoEcho     Standard )');
  49. Writeln(' ');
  50. Write  ('Disk Drive = ',chr(DefaultDrive+$41),':   ') ;
  51.   writeln('     ( A:    B:    C:    D:   )');
  52. Write  ('Com Port   = ');
  53.   If PrimaryPort then Write('One  ')
  54.                  else Write('Two  ');
  55.   writeln('     ( One   Two  ) ' );
  56. Write  ('Destination=');
  57.   If ForPrinter  then Write(' Printer ')
  58.                  else Write(' Disk    ');
  59.   writeln('  ( Disk  Printer )');
  60. Writeln(' ');
  61. If ParmFlag then Begin (* Display Packet Parameters *)
  62. Writeln('-------------------------------------------------------------');
  63. Writeln('Packet Parameters');
  64. Writeln('  Packetsize = ',sPacketsize,'  Timeout   = ',sTimeout:2,'   *');
  65. Writeln('  NumPad     = ',sNumPad:2,'  PadChar   = ',sPadChar:2,'   *');
  66. Write  ('  Startchar  = ',StartChar:2,'  EolChar   = ',sEolChar:2);
  67. Writeln(' * use decimal values ');
  68. Write  ('  CntrlQuote =  ',chr(sCntrlQuote),'  Bit8Quote =  ',chr(Bit8quote));
  69. Writeln(' | use character values ');
  70. Write  ('  CheckType  =  ',chr(CheckType),'  RepChar   =  ',chr(RepChar));
  71. Writeln(' |   use NULL for null character )');
  72. Writeln(' RemotePacketsize = ',rPacketsize);
  73.                 End ; (* Display Packet Parameters *)
  74. If logging then
  75.     Begin writeln(' '); writeln(' Logging data to file ',LogName); end;
  76.  
  77. End;  (* ShowOptions Procedure *)
  78. (* ================================================================== *)
  79. (* SetOptions - Set Parameter Options setting for Kermit.             *)
  80. (*                                                                    *)
  81. (* ================================================================== *)
  82. Procedure SetOptions (var instring:String);
  83. Const
  84.     OP1Table : String[40] = '     300  600  1200 2400 4800 9600 19.2 ';
  85.     OP2Table : String[30] = 'ODD  EVEN MARK NONE HALF FULL ';
  86.     OP3Table : String[40] = 'IBM-XON   NOECHO    STANDARD  ONE  TWO  ';
  87.     OP4Table : String[40] = 'A:   B:   C:   D:   DISK PRINTER  ';
  88.     PP1Table : String[44] = '           PACKETSIZE TIMEOUT    NUMPAD     ';
  89.     PP2Table : String[44] = 'PADCHAR    STARTCHAR  EOLCHAR    CNTRLQUOTE ';
  90.     PP3Table : String[33] = 'BIT8QUOTE  CHECKTYPE  REPCHAR    ' ;
  91. Type
  92.     Options = (zero,b300,b600,b1200,b2400,b4800,b9600,b19200,
  93.                PO,PE,PM,PN,HALF,FULL,
  94.                Xon,xon1,NoEcho1,noecho2,Stand,stand1,one,two,
  95.                A,B,C,D,Disk,Print,print1) ;
  96.    PParms = (Pzero,Psize,PTime,PNumPad,PPadChar,
  97.              PStartChar,PEolChar,PcntrlQuote,Pbit8Quote,
  98.              PChecktype,PRepChar);
  99. Var
  100.     Option : String ;
  101.     OptionTable : String[255];
  102.     PParmTable : String[122];
  103.     Ix : integer ;
  104.     ScanOptions : boolean ;
  105.  
  106.          Function GetValue ( MinVal,MaxVal : integer) : integer ;
  107.          var I,Retcode : integer ;
  108.          Begin (* Get Value *)
  109.          Val(Gettoken(Instring),I,Retcode);
  110.          If (Retcode=0) and (I>=MinVal) and (I<= MaxVal) then GetValue := I
  111.                                                          else
  112.               Begin
  113.               GetValue := MinVal ;
  114.               Writeln('>>> Invalid value specified <<<');
  115.               Delay(2000);
  116.               End;
  117.          End ; (* Get Value *)
  118.  
  119.          Procedure SetChar ( var Pchar : byte ; ValidChars : setofchar );
  120.          Var atoken : string[10];
  121.          Begin (* set char *)
  122.          Atoken := UpperCase(Gettoken(Instring)) ;
  123.          If Atoken = 'NULL' then Pchar := $20 else
  124.          If (Length(Atoken)=1) and (Atoken[1] in ValidChars) then
  125.               Pchar := Ord(Atoken[1])
  126.                                                              else
  127.               Begin Writeln('>>> Invalid Specification <<<');delay(2000);End;
  128.          End ; (* set char *)
  129.  
  130. Begin (* SetOptions Procedure *)
  131. OptionTable := OP1Table + OP2Table + OP3Table + OP4Table ;
  132. PParmTable := PP1Table + PP2Table + PP3Table ;
  133. If length(instring)<1 then
  134.     Begin (* Get Settings *)
  135.     ShowOptions;
  136.     Write  ('Enter Option Setting >');
  137. (*    If audioflag then   *)
  138.        Begin Sound(1000); Delay(250); Sound(2000); Delay(50); Nosound;end;
  139.     Readln(instring);
  140.     End ; (* Get Settings *)
  141. ScanOptions := true ;
  142. While (length(instring)>0) and ScanOptions do
  143.     Begin (* Parse instring *)
  144.     Option := GetToken(instring);
  145.     ScanOptions := Option<>';';
  146.     Option := Concat(' ',Uppercase(Option));
  147.     ix := Pos(Option,OptionTable) div 5 ;
  148.     If ix <> 0 then
  149.          Case Options(ix) of
  150.          b300   : Baudrate := 300 ;
  151.          b600   : Baudrate := 600 ;
  152.          b1200  : Baudrate := 1200 ;
  153.          b2400  : Baudrate := 2400 ;
  154.          b4800  : Baudrate := 4800 ;
  155.          b9600  : Baudrate := 9600 ;
  156.          b19200 : Baudrate := 19200 ;
  157.          PO     : Parity   := OddP ;
  158.          PE     : parity   := EvenP ;
  159.          PM     : Parity   := MarkP ;
  160.          PN     : parity   := NoneP ;
  161.          HALF   : LocalEcho:= True ;
  162.          FULL   : LocalEcho:= False ;
  163.          Xon    : Begin XonXoff := True;  NoEcho := False; End;
  164.          NoEcho1: Begin XonXoff := False; NoEcho := True;  End;
  165.          Stand  : Begin XonXoff := False; NoEcho := False; End;
  166.          One    : PrimaryPort := True ;
  167.          Two    : PrimaryPort := False ;
  168.          A      : SetDefaultDrive(0) ;
  169.          B      : SetDefaultDrive(1) ;
  170.          C      : SetDefaultDrive(2) ;
  171.          D      : SetDefaultDrive(3) ;
  172.          Disk   : ForPrinter := false ;
  173.          Print  : ForPrinter := true ;
  174.          End   (* case of options *)
  175.                else
  176.          Begin (* check packet parms *)
  177.          ix := Pos(Option,PParmTable) div 11 ;
  178.          If (ix <> 0) and ParmFlag then
  179.               Case PParms(ix) of
  180.          Psize:          sPacketsize := GetValue(10,MaxPacketSize) ;
  181.          PTime:          sTimeout    := GetValue(0,255) ;
  182.          PNumPad:        sNumPad     := GetValue(0,255) ;
  183.          PPadChar:       sPadChar    := GetValue(0,127) ;
  184.          PStartChar:     StartChar   := GetValue(1,31) ;
  185.          PEolChar:       sEolChar    := GetValue(1,31) ;
  186.          PcntrlQuote:    SetChar(sCntrlQuote,['!'..'/']) ;
  187.          Pbit8Quote:     SetChar(Bit8Quote,['!'..'>','`'..'~','Y','N']) ;
  188.          PChecktype:     SetChar(CheckType,['1'..'3']) ;
  189.          PRepChar :      SetChar(RepChar,['!'..'>','`'..'~'] -
  190.                                  [chr(sCntrlQuote),chr(Bit8Quote)] );
  191.               End ; (* Case of  PParms *)
  192.          If chr(CheckType) in ['1','2','3'] then else CheckType := 49 ;
  193.          End ; (* check packet parms *)
  194.     ResetModem; Initmodem ;
  195.     SetModem ;
  196.     End ; (* Parse instring *)
  197. ShowOptions ;
  198. End ; (* SetOptions Procedure *)
  199.  
  200. (* ================================================================== *)
  201. (* DisplayCommands - Display all the valid Kermit Commands.           *)
  202. (*                                                                    *)
  203. (* ================================================================== *)
  204. Procedure DisplayCommands;
  205.  
  206. Begin (* DisplayCommands Procedure *)
  207. ClrScr ;
  208. Writeln('                ( Q K - K E R M I T  COMMANDS )');
  209. Writeln('-----------------------------------------------------------------');
  210. Writeln('CONNECT <options>  - connect to a remote host as a dumb terminal.');
  211. Writeln('WAIT               - wait for a connection to be made.');
  212. Writeln('SEND    <local-filename > AS <remote-filename> RAW');
  213. Writeln('RECEIVE <remote-filename> AS <local-filename > REPLACE');
  214. Writeln('SET    <options>   - set option settings.');
  215. Writeln('STATUS             - display optional settings and status');
  216. Writeln('            ');
  217. Writeln('DIRECTORY,ERASE,RENAME,TYPE,RUN <filename> - local commands');
  218. Writeln('MKDIR,CHDIR,RMDIR  <directoryname>         - local commands');
  219. Writeln('REMOTE <commands>                          - remote commands');
  220. Writeln('            ');
  221. Writeln('LOG  <filename>    - Record data received in a log file.');
  222. Writeln('TAKE <filename>    - Take and execute commands from a  file.');
  223. Writeln('      also see script commands CLEAR,INPUT,OUTPUT,ECHO,PAUSE ');
  224. Writeln('DEFINE <dword> <dstring> - define a word to equal a string.');
  225. Writeln('AUDIO,PARMS,LINE25 - toggle options .');
  226. Writeln('QUIT  <QuitOption> - terminate local or remote kermit program.');
  227. Writeln('                     QuitOptions : LOCAL,REMOTE,DISCONnect,ALL');
  228. Writeln(' ');
  229. Writeln('   Note: All parameters are optional and all commands maybe');
  230. Writeln('         abbreviated to a minimum of unique characters.');
  231. Writeln('---------------------------------------------------------------');
  232. End; (* DisplayCommand Procedure *)
  233. end.