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