home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / c / qk3ker.pas < prev    next >
Pascal/Delphi Source File  |  2020-01-01  |  18KB  |  351 lines
  1. {$R-,S-,I-,D+,T-,F-,V-,B-,N-,L+ }
  2. {$M 32768,0,131072 }
  3. Program Kermit ;
  4. (* ***************************************************************** *)
  5. (*                                                                   *)
  6. (* Author - Victor Lee                                               *)
  7. (*          Queen's University ,               Phone                 *)
  8. (*          Kingston, Ontario, CANADA         (613)-545-2033         *)
  9. (*          K7L 3N6                                                  *)
  10. (* Comments and problems can be sent to VIC at QUCDN.BITNET          *)
  11. (*                                or to Victor.Lee@Queens.CA         *)
  12. (*                                                                   *)
  13. (* Date -  1985 January                                              *)
  14. (*      -  1985 May  1    first official release                     *)
  15. (* Acknowlegement -                                                  *)
  16. (*       Victoria Henderson - original Tek4010 coding.               *)
  17. (*       Contributions from Kevin Lowey, Gisbert W.Selke  and        *)
  18. (*          special thank to many others who have reported bugs,     *)
  19. (*          provided fixes, and offered suggestions for improvement. *)
  20. (*                                                                   *)
  21. (* Date -  1988 April     Version 3.0                                *)
  22. (*              Version 3.0 is a major rewrite of QK-Kermit using    *)
  23. (*              Turbo Pascal 4.0.  This version is for MsDos systems *)
  24. (*              only and CP/M systems are no longer supported.       *)
  25. (*              Improved graphic support, Large packet size,         *)
  26. (*              and script commands for automated logons.            *)
  27. (* Modifications                                                     *)
  28. (*         1988 May     - Ack Data Packets earlier.                  *)
  29. (*              June 29 - Fix bug in using Directory Prefixes in     *)
  30. (*                        Sendfile.                                  *)
  31. (*              July 15 - Don't mask out bit8 if parity NONE         *)
  32. (*              Sept 16 - Tek4100 terminal emulation replaces        *)
  33. (*                        the Tek4010, to enable color graphics.     *)
  34. (*              Sept 30 - Fix from Andy Rutherford (AGRSI@CUNYVM)    *)
  35. (*                        to handle non-graphics Monochrome monitor. *)
  36. (*              Oct  7  - Official Release of 3.1                    *)
  37. (*                                                                   *)
  38. (* ***************************************************************** *)
  39. (*  Kermit UNITS                                                     *)
  40. (*                                                                   *)
  41. (*  KGLOBALS - Global variables and utility procedures               *)
  42. (*       GetToken                                                    *)
  43. (*       UpperCase                                                   *)
  44. (*       Prefixof                                                    *)
  45. (*       NewAsFile                                                   *)
  46. (* SYSFUNC  - These are operating system dependent procedures        *)
  47. (*       KeyChar                                                     *)
  48. (*       CursorUp,CursorDown,CursorRight,CursorLeft                  *)
  49. (*       Scroll,FatCursor,                                           *)
  50. (*       LocalScreen,RemoteScreen                                    *)
  51. (*       SetDefaultDrive,DefaultDrive                                *)
  52. (* MODEMPRO - These are Machine dependent Modem procedures           *)
  53. (*       InitModem,ResetModem,SetModem,                              *)
  54. (*       AnswerModem,DialModem                                       *)
  55. (*       RecvChar,SendChar,SendBreak,                                *)
  56. (*       CharsInBuffer,EmptyBuffer                                   *)
  57. (* PACKETS - packet related procedures                               *)
  58. (*       ReadChar,ReadMChar                                          *)
  59. (*       SendPacket,RecvPacket,                                      *)
  60. (*       ReSendit,SendPacketType,                                    *)
  61. (*       PutInitPacket,GetInitPacket                                 *)
  62. (* SENDRECV - Sending and Receiving file procedures                  *)
  63. (*       RECVFILE                                                    *)
  64. (*       SENDFILE                                                    *)
  65. (*       BreakAck                                                    *)
  66. (* VT100 - Terminal Emulation procedure                              *)
  67. (*       CONNECT                                                     *)
  68. (* TEK4100 - Graphics terminal emulation procedure                   *)
  69. (*       Tektronics                                                  *)
  70. (* SETSHOW - set and show options                                    *)
  71. (*       ShowOptions                                                 *)
  72. (*       SetOptions                                                  *)
  73. (*       DisplayCommands                                             *)
  74. (* LOCAL - local procedures                                          *)
  75. (*      DisplayDir  - Display directory.                             *)
  76. (*      EraseFiles  - Erase files.                                   *)
  77. (*      RenameFiles - Rename files.                                  *)
  78. (*      DisplayFile - Display file (TYPE file ).                     *)
  79. (*     (RunFile     - Run a program  ( See SYSFUNC procedures ) )    *)
  80. (* DEFWORDS - Define Words procedures                                *)
  81. (*       AssignDefWord                                               *)
  82. (*       DisplayDefWords                                             *)
  83. (*       CheckDefWords                                               *)
  84. (*       WriteDefWord                                                *)
  85. (*       DEFINEWORD                                                  *)
  86. (*       LoadDefWords                                                *)
  87. (*       SaveDefWords                                                *)
  88. (* REMOTEU  - Remote request procedures                              *)
  89. (*      RemotePro                                                    *)
  90. (* MISCCOMM - Miscellaneous command                                  *)
  91. (*       Logit      - log the session to a file.                     *)
  92. (*       Takeit     - take commands from a file.                     *)
  93. (*       QuitExit   - terminate kermits and log out.                 *)
  94. (* DRIVERS - graphics drivers from Turbo pascal 4.0                  *)
  95. (* FONTS   - graphics fonts from Turbo pascal 4.0                    *)
  96. (*                                                                   *)
  97. (* ***************************************************************** *)
  98.  
  99. uses Dos,Crt,printer,graph,    (* Standard Turbo Pascal Units *)
  100.      KGlobals,                 (* Kermit Globals *)
  101.      ModemPro,
  102.      Vt100,tek4100,
  103.      SetShow,SendRecv,RemoteU,
  104.      MiscComm,Local,Defwords ;
  105.  
  106. TYPE
  107.     Commandindex = (
  108.                   zero,
  109.                   wait,
  110.                   connect,
  111.                   send,
  112.                   receive,
  113.                   setparm,
  114.                   status,
  115.                   directory,
  116.                   erase,
  117.                   rename,
  118.                   typefile,
  119.                   runfile,
  120.                   remote,
  121.                   log,
  122.                   take,
  123.                   define,
  124.                   help,
  125.                   mkdirl,
  126.                   rmdirl,
  127.                   chdirl,
  128.                   audio,
  129.                   parms,
  130.                   line25,
  131.                   quit,
  132.                   null );
  133.     Commandindex2= (zero2,input,output,pause,echo,clear);
  134.  
  135. VAR
  136.     timeout : boolean ;
  137.     inbyte : byte ;
  138.     Hour,hh,mm,ss,ms : word ;
  139.     i,j,inlength,inputTimer,timer,alarm : integer ;
  140.     inputstring, NameString : string ;
  141.     command, commandtable,commandtable2,inbuff : string ;
  142.  
  143. (* ***************************************************************** *)
  144. (* ********    Outter Block of Kermit ****************************** *)
  145. (* ***************************************************************** *)
  146.  
  147.  
  148. BEGIN (* KERMIT *)
  149. commandtable := concat('bad       ',
  150.                        'WAIT      ',
  151.                        'CONNECT   ',
  152.                        'SEND      ',
  153.                        'RECEIVE   ',
  154.                        'SET       ',
  155.                        'STATUS    ',
  156.                        'DIRECTORY ',
  157.                        'ERASE DEL ',
  158.                        'RENAME    ',
  159.                        'TYPE      ',
  160.                        'RUN EXEC  ',
  161.                        'REMOTE    ',
  162.                        'LOG       ',
  163.                        'TAKE      ',
  164.                        'DEFINE    ',
  165.                        'HELP  ?   ',
  166.                        'MKDIR MD  ',
  167.                        'RMDIR RD  ',
  168.                        'CHDIR CD  ',
  169.                        'AUDIO     ',
  170.                        'PARMS     ',
  171.                        'LINE25    ',
  172.                        'QUIT EXIT ',
  173.                        'DO LOCAL  ') ;
  174.  
  175. commandtable2 := concat('bad2      ',
  176.                         'INPUT     ',
  177.                         'OUTPUT    ',
  178.                         'PAUSE     ',
  179.                         'ECHO      ',
  180.                         'CLEAR     ') ;
  181.  
  182.    Writeln('          * ======================================== * ');
  183.    Writeln('          *  Queen''s University  -  KERMIT /',termtype,' * ');
  184.    Writeln('          *                                          * ');
  185.    Writeln('          *      Version ',version,Gversion,' - ',Date,'  * ');
  186.    Writeln('          *      Author   -  Victor Lee              * ');
  187.    Writeln('          *      Graphics ',Graphics,'  * ');
  188.    Writeln('          * ======================================== * ');
  189.  
  190. inputstring := '' ;
  191. For i := 1 to ParamCount do
  192.      inputstring := inputstring + ' ' + paramstr(i) ;
  193. Running := True ;
  194. While Running Do
  195.     Begin (* Command Loop *)
  196.     if audioflag then
  197.        Begin sound(1500);delay(50);sound(300);delay(50);nosound; end ;
  198.     if length(inputstring)<1 then
  199.          if TakeActive then
  200.               Begin (* Get command from file *)
  201.               Readln(Commandfile,inputstring);
  202.               TakeActive := not Eof(commandfile);
  203.               if Eof(commandfile) then close(commandfile);
  204.               End
  205.                              else
  206.              Begin (* ask for input *)
  207.              Write('QK-Kermit>');              (* PROMPT for input *)
  208.              readln(inputstring);
  209.              End ; (* ask for input *)
  210.  
  211.     command := Uppercase(GETTOKEN(inputstring));
  212.     CheckDefWords(DefList,command,Inputstring);
  213.     command := ' ' + command ;
  214.     WaitXon := false ;
  215.  
  216.     case commandindex(POS(command,commandtable) div 10 ) of
  217.           zero    : If length(command)>1 then
  218.                         Begin (* check table 2 - Script commands *)
  219.                       case commandindex2(POS(command,commandtable2) div 10) of
  220.                    zero2 :
  221.                            Begin (* bad command *)
  222.                            Writeln('Invalid Command >>>>> ',Command,' <<<<<');
  223.                            Writeln('--- Type HELP to see valid Commands.--- ');
  224.                            End ; (* bad command *)
  225.                   input  : Begin (* Input Command *)
  226.                            Val(GetToken(InputString),InputTimer,j) ;
  227.                            i := 1 ;
  228.                            GetTime(hh,mm,ss,ms);
  229.                            Alarm := mm*60 + ss + InputTimer ;
  230.                            inlength := length(inputstring);
  231.                            timeout:=false;
  232.                            While (i <= inlength) and  (not timeout) do
  233.                            If RecvChar(inbyte) then
  234.                                Begin (* got char *)
  235.                                If chr(inbyte) = InputString[i] then
  236.                                      begin (* matches *)
  237.                                      InBuff[i] := chr(inbyte) ;
  238.                                      InBuff[0] := chr(i) ;
  239.                                      i := i + 1 ;
  240.                                      end   (* matches *)
  241.                                                                else
  242.                                      i := 1 ;
  243.                                write(chr(inbyte));
  244.                                End  (* got char *)
  245.                                               else
  246.                                Begin  (* time it *)
  247.                                GetTime(Hour,mm,ss,ms);
  248.                                Timer := mm*60 + ss ;
  249.                                If Hour<>hh then Timer := Timer + 3600 ;
  250.                                If Timer > Alarm then timeout := true ;
  251.                                End ; (* time it *)
  252.  
  253.                            if timeout then writeln('Timed Out')
  254.                               ;  (*    else writeln(inputstring); *)
  255.                            inputstring := '';
  256.                            End ; (* Input Command *)
  257.                   output : Begin (* Output Command *)
  258.                            For i := 1 to length(inputstring) do
  259.                                if inputstring[i]='~' then
  260.                                   Sendchar(CR_) (* carriage return *)
  261.                                                      else
  262.                                   Sendchar(ord(inputstring[i]));
  263.                            InputString := '';
  264.                            End ; (* Output Command *)
  265.                   pause  : Begin (* pause *)
  266.                            Val(GetToken(Inputstring),i,j);
  267.                            delay(i);
  268.                            End ; (* pause *)
  269.                   echo   : Begin writeln(inputstring); inputstring := ''; end;
  270.                   clear  : Begin (* Clear *)
  271.                            DialModem ;
  272.                            For i := 1 to 255 do Inbuff := ' ';
  273.                            End ;  (* Clear *)
  274.                         end ; (* case *)
  275.                         End ; (* check table 2 - Script commands *)
  276.           wait     : Begin AnswerModem ; Connection ; End ;
  277.           connect  : Begin
  278.                      If length(inputstring) > 1 then SetOptions(inputstring);
  279.                      CONNECTION ;
  280.                      End;
  281.           send     : SENDFILE (inputstring);
  282.           receive  : RECVFILE (inputstring );
  283.           setparm  : SetOptions(inputstring);
  284.           status   : ShowOptions ;
  285.           directory: DisplayDir (inputstring);
  286.           erase    : EraseFiles (GetToken(inputstring));
  287.           rename   : RenameFile (inputstring);
  288.           typefile : DisplayFile (GetToken(inputstring));
  289.           runfile  : Begin (* RunFile *)
  290.                      NameString := GetToken(Inputstring) ;
  291.                      if Pos('.',NameString) = 0 then
  292.                            NameString := NameString + '.EXE' ;
  293.                      EXEC (NameString,inputstring);
  294.                      Case DosError  of
  295.                      2: Writeln('File ',NameString,' not Found');
  296.                      5: Writeln('Acess Denied');
  297.                      8: Writeln('Insufficient Memory to load program');
  298.                     10: Writeln('Invalid Environment.');
  299.                     11: Writeln('Unable to Execute file');
  300.                       end ; (* DosError Case *)
  301.                      inputstring := '' ;
  302.                      end ;  (* RunFile *)
  303.           remote   : RemoteProc (inputstring);
  304.           log      : Logit  (GetToken(inputstring));
  305.           take     : Takeit (GetToken(inputstring));
  306.           define   : DefineWord(inputstring);
  307.           help     : DisplayCommands ;
  308.           mkdirl   : Begin (* Make Directory *)
  309.                      NameString := GetToken(Inputstring) ;
  310.                      {$I-} Mkdir (NameString) ; {$I+}
  311.                      If IoResult = 0 then
  312.                           writeln('Directory ',NameString,' maked OK.')
  313.                                      else
  314.                           writeln('Unable to make directory - ',NameString);
  315.                      End ;(* Make Directory *)
  316.           chdirl   : Begin (* Change Directory *)
  317.                      NameString := GetToken(Inputstring) ;
  318.                      {$I-} Chdir (NameString) ; {$I+}
  319.                      If IoResult = 0 then
  320.                           writeln('Directory changed to ',NameString)
  321.                                      else
  322.                           writeln('Unable to change directory - ',NameString);
  323.                      End ;(* Change Directory *)
  324.           rmdirl   : Begin (* Remove Directory *)
  325.                      NameString := GetToken(Inputstring) ;
  326.                      {$I-} Rmdir (NameString) ; {$I+}
  327.                      If IoResult = 0 then
  328.                           writeln('Directory ',NameString,' removed. ')
  329.                                      else
  330.                           writeln('Unable to remove directory - ',NameString);
  331.                      End ;(* Remove Directory *)
  332.           audio    : AudioFlag := AudioFlag xor True ;
  333.           parms    : ParmFlag := ParmFlag xor True ;
  334.           line25   : Line25Flag := Line25Flag xor True ;
  335.           quit     : QuitExit (UpperCase(GetToken(inputstring)));
  336.           null     : ;
  337.        end ;  (*  Case commandindex *)
  338.     End ; (* Command Loop *)
  339.  
  340.  If Logging then Close(Logfile);
  341.  If NewDefs then SaveDefWords ;
  342.  If audioflag then
  343.     begin sound(1500);delay(200);sound(3000);delay(200);end ;
  344.  ResetModem;
  345.  
  346.  If audioflag then
  347.     begin sound(2000);delay(200); nosound; end ;
  348.  ClrScr;
  349.  Gotoxy(20,10); Write( ' G O O D - B Y E ');
  350.  
  351. END.  (* KERMIT *)