home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / c / qk3rmt.pas < prev    next >
Pascal/Delphi Source File  |  2020-01-01  |  15KB  |  378 lines
  1. Unit RemoteU ;
  2. Interface
  3.     uses Dos,           (* Standard Turbo Pascal Unit *)
  4.          KGlobals,
  5.          Packets,
  6.          SendRecv ;
  7.     Procedure RemoteProc (var Instring : String) ;
  8. Implementation
  9. (* ----------------------------------------------------------------- *)
  10. (*  RemoteProc - Remote procedure.                                   *)
  11. (* ----------------------------------------------------------------- *)
  12. Procedure RemoteProc (var Instring : String) ;
  13. Const
  14.     Gsubtype : String[18] =  ' CDEFHIJKLMPQRTUVW' ;
  15. TYPE
  16.     RemoteCommandindex = (
  17.                   rem_zero,
  18.                   rem_kermit,
  19.                   rem_cwd,
  20.                   rem_directory,
  21.                   rem_erase,
  22.                   rem_finish,
  23.                   rem_help,
  24.                   rem_login,
  25.                   rem_journal,
  26.                   rem_copy,
  27.                   rem_logout,
  28.                   rem_message,
  29.                   rem_program,
  30.                   rem_query,
  31.                   rem_rename,
  32.                   rem_type,
  33.                   rem_usage,
  34.                   rem_variable,
  35.                   rem_who);
  36. Var
  37.     ErrorMsg : String ;
  38.     Rem_CommandTable : String[255] ;
  39.     Rem_Command : String ;
  40.     Tempstring : String ;
  41.     Index : integer ;
  42.     Receiving : boolean ;
  43.     Retries : integer ;
  44.     j,CharCount,Bit8 : integer ;
  45.     i,i1,i2,i3 : integer ;
  46. (* ----------------------------------------------------------------------- *)
  47. Procedure AddParmString ;
  48. var i,ix : integer ;
  49.     Begin (* Add parms *)
  50.     If length(instring) > 0 then
  51.          Begin (* add parameter *)
  52.          ix := Pos(';',instring) - 1 ;
  53.          if ix <= 0 then ix := length(instring) ;
  54.          SendData[OutdataCount+1] := ix + $20 ;
  55.          For i := 1 to ix do
  56.               SendData[OutdataCount+1+i] := ord(instring[i]) ;
  57.          OutdataCount := OutdataCount + ix + 1 ;
  58.          Instring := copy(instring,ix+1,length(instring)-ix);
  59.          If Instring[1] = ';' then
  60.               Instring := copy(instring,2,length(instring)-1);
  61.          End ;
  62.     End ; (* Add parms *)
  63.  
  64. (* *********************************************************************** *)
  65. Begin (* RemoteProc *)
  66. rem_commandtable  := concat('bad       ',
  67.                        'KERMIT    ',
  68.                        'CWD       ',
  69.                        'DIRECTORY ',
  70.                        'ERASE     ',
  71.                        'FINISH    ',
  72.                        'HELP      ',
  73.                        'LOGIN     ',
  74.                        'JOURNAL   ',
  75.                        'COPY      ',
  76.                        'LOGOUT    ',
  77.                        'MESSAGE   ',
  78.                        'PROGRAM   ',
  79.                        'QUERY     ',
  80.                        'RENAME    ',
  81.                        'TYPE      ',
  82.                        'USAGE     ',
  83.                        'VARIABLE  ',
  84.                        'WHO       ') ;
  85.     rem_command := ' ' + Uppercase(GETTOKEN(instring));
  86.     if rem_command = ' HOST' then
  87.          Begin (* Host Command *)
  88.          End   (* Host Command *)
  89.                              else
  90.          Begin (* Generic Kermit Commands *)
  91.          index := POS(rem_command,rem_commandtable) div 10 ;
  92.          if index = 0 then
  93.               Begin (* list commands *)
  94.               Writeln (rem_command,' - Invalid REMOTE command. ');
  95.               Writeln('    Valid REMOTE Commands are as follows: ');
  96.               Writeln('KERMIT    command       - command for other kermit');
  97.               Writeln('CWD       directory     - Change Working Directory');
  98.               Writeln('DIRECTORY filespec      - Directory               ');
  99.               Writeln('ERASE     filespec      - Erase (delete) a file   ');
  100.               Writeln('FINISH                  - Terminate Kermit server ');
  101.               Writeln('HELP      keywords      - Help from server        ');
  102.               Writeln('LOGIN     userid        - Login                   ');
  103.               Writeln('JOURNAL   command       - Transaction Logging     ');
  104.               Writeln('COPY      filespec      - Copy file               ');
  105.               Writeln('LOGOUT                  - Logout the remote host  ');
  106.               Writeln('MESSAGE   destination   - Message                 ');
  107.               Writeln('PROGRAM   program-name  - Program execution       ');
  108.               Writeln('QUERY                   - Query server status     ');
  109.               Writeln('RENAME    old-filespec  - Rename file             ');
  110.               Writeln('TYPE      filespec      - Type (list) file        ');
  111.               Writeln('USAGE     area          - Disk Usage Query        ');
  112.               Writeln('VARIABLE  command       - Set or Query a Variable ');
  113.               Writeln('WHO       userid        - Who is logged in        ');
  114.               End   (* list commands *)
  115.                       else
  116.               Begin (* Issue Remote command Request *)
  117.     (* Send Init Packet *)
  118.   OutPacketType := Ord('I');
  119.     PutInitPacket ;
  120.     SendPacket ;
  121.     STATE := R ;
  122.     RECEIVING := TRUE ;
  123.     BreakState := NoBreak ;
  124.     RETRIES := 10 ;       (* Up to 10 retries allowed. *)
  125.  
  126.     WHILE RECEIVING DO  CASE STATE OF
  127.  
  128. (* R ------ Initial receive State ------- *)
  129. (* Valid types  - Y *)
  130. R : BEGIN (* Initial Receive State  *)
  131.     If ( Not RecvPacket) or (InPacketType=Ord('N')) then Resendit(10)
  132.                                                     else
  133.          Begin (* Send Request *)
  134.          If InPacketType=Ord('Y') then GetInitPacket ;
  135.          If NoEcho  then waitxon := false ;
  136.          OutPacketType := Ord('G') ;
  137.          SendData[1] := Ord(GSubtype[index]) ;
  138.          OutDataCount :=  1 ;
  139.          OUTSEQ   := 0 ;
  140.          IF OUTSEQ >= 64 THEN OUTSEQ := 0;
  141.          Case RemoteCommandIndex(index) of
  142.      rem_zero:   ;
  143.      rem_kermit:   Begin (* remote kermit command *)
  144.                    OutPacketType := Ord('K') ;
  145.                    OutDataCount :=  0 ;
  146.                    AddParmString;
  147.                    End ; (* remote kermit command *)
  148.  
  149.       rem_cwd:     Begin (* Change Working Directory *)
  150.                    AddParmString;
  151.                    Writeln (' Enter Password ') ;
  152.                    Readln(instring);
  153.                    AddParmString ;
  154.                    End ; (* Change Working Directory *)
  155. rem_directory:     AddParmString;
  156.     rem_erase:     AddParmString;
  157.    rem_finish:     AddParmString;
  158.      rem_help:     AddParmString;
  159.     rem_login:     Begin (* Login *)
  160.                    AddParmString;
  161.                    Writeln (' Enter Password ') ;
  162.                    Readln(instring);
  163.                    AddParmString ;
  164.                    Writeln (' Enter Account Number ') ;
  165.                    Readln(instring);
  166.                    AddParmString ;
  167.                    End ; (* Login *)
  168.   rem_journal:     Begin (* Journal *)
  169.                    AddParmString;
  170.                    Writeln (' Enter Journal Argument ') ;
  171.                    Readln(instring);
  172.                    AddParmString ;
  173.                    End ; (* Jounral *)
  174.      rem_copy:     Begin (* Copy file *)
  175.                    AddParmString;
  176.                    Writeln (' Enter destination ') ;
  177.                    Readln(instring);
  178.                    AddParmString ;
  179.                    End ; (* Copy file *)
  180.    rem_logout:     AddparmString;
  181.   rem_message:     Begin (* Message *)
  182.                    AddParmString;
  183.                    Writeln (' Enter Message text ') ;
  184.                    Readln(instring);
  185.                    AddParmString ;
  186.                    End ; (* Message *)
  187.   rem_program:     Begin (* Program *)
  188.                    AddParmString;
  189.                    Writeln (' Enter Program commands ') ;
  190.                    Readln(instring);
  191.                    AddParmString ;
  192.                    End ; (* Program *)
  193.     rem_query:     ;
  194.    rem_rename:     Begin (* Rename file *)
  195.                    AddParmString;
  196.                    Writeln (' Enter New Name ') ;
  197.                    Readln(instring);
  198.                    AddParmString ;
  199.                    End ; (* Rename file *)
  200.      rem_type:     AddParmString;
  201.     rem_usage:     AddParmString;
  202.  rem_variable:     Begin (* Variable *)
  203.                    If length(instring) < 1 then
  204.                         begin (* get command *)
  205.                         Writeln (' QUERY assumed. ') ;
  206.                         instring := 'QUERY';
  207.                         end ; (* get next argument *)
  208.                    AddParmString;
  209.                    If length(instring) < 1 then
  210.                         begin (* get next argument *)
  211.                         Writeln (' Enter First Argument ') ;
  212.                         Readln(instring);
  213.                         end ; (* get next argument *)
  214.                    AddParmString ;
  215.                    If length(instring) < 1 then
  216.                         begin (* get next argument *)
  217.                         Writeln (' Enter Second Argument ') ;
  218.                         Readln(instring);
  219.                         end ; (* get next argument *)
  220.                    AddParmString ;
  221.                    End ; (* Variable *)
  222.       rem_who:     Begin (* Who  *)
  223.                    AddParmString;
  224.                    Writeln (' Enter Options ') ;
  225.                    Readln(instring);
  226.                    AddParmString ;
  227.                    End ; (* Who *)
  228.          End ; (* Case *)
  229.  
  230.          SendPacket ;
  231.          STATE := RF ;
  232.          End ; (* Send Request *)
  233.  
  234.     END ; (* Initial Receive State  *)
  235.  
  236.  
  237.     (* RF ----- Receive Filename State ------- *)
  238.     (* Valid received msg type  : S,Z,F,B     *)
  239.     RF: IF (NOT RECVPACKET) OR (InPacketType=Ord('N')) then  ReSendit(10)
  240.                                                        else
  241.         (* Get a packet *)
  242.         IF (InPacketType = Ord('Y')) or (InPacketType=Ord('E')) then
  243.               BEGIN (* Got simple reply  *)
  244.               For i := 1 to InDataCount do
  245.                    Write(Chr(RecvData[i])) ;
  246.               Writeln(' ');
  247.               RECEIVING := false ;
  248.               (* check for date or time setting *)
  249.               For i := 1 to InDataCount do  tempstring[i] := Chr(RecvData[i]);
  250.               tempstring[0] := Chr(InDataCount) ;
  251.               If  Pos('DATE' ,Tempstring )= 1 then
  252.                    Begin (* set date *)
  253.                    Val(copy(tempstring,6,2),i1,i) ;
  254.                    Val(copy(tempstring,9,2),i2,i) ;
  255.                    Val(copy(tempstring,12,2),i3,i) ;
  256.                    SetDate(i3+1900,i1,i2);
  257.                    End ; (* set date *)
  258.               If  Pos('TIME' ,Tempstring )= 1 then
  259.                    Begin (* set time *)
  260.                    Val(copy(tempstring,6,2),i1,i) ;
  261.                    Val(copy(tempstring,9,2),i2,i) ;
  262.                    Val(copy(tempstring,12,2),i3,i) ;
  263.                    SetTime(i1,i2,i3,00) ;
  264.                    End ; (* set time *)
  265.               END   (* Got simple reply *)
  266.                                    else
  267.         IF InPacketType = Ord('S') then
  268.               Begin
  269.               GetInitPacket;
  270.               PutInitPacket;
  271.               OutPacketType := Ord('Y');
  272.               SendPacket;
  273.               End
  274.                                    else
  275.         IF (InPacketType = Ord('X')) or (InPacketType = Ord('F')) then
  276.               BEGIN (* Got file header *)
  277.               For i := 1 to InDataCount do
  278.                    Write(Chr(RecvData[i])) ;
  279.               Writeln(' ');
  280.               STATE := RD ;
  281.               SendPacketType('Y');
  282.               END   (* Got file header *)
  283.                                    else
  284.          BEGIN (* Not S,F,B,Z packet *)
  285.          STATE := A ;   (* ABORT if not a S,F,B,Z type packet *)
  286.          ABORT := NOT_SFBZ ;
  287.          END ; (* Not S,F,B,Z packet *)
  288.  
  289.  
  290.     (* RD ----- Receive Data State ------- *)
  291.     (* Valid received msg type  : D,Z      *)
  292.     RD: IF (NOT RECVPACKET) OR (InPacketType=Ord('N')) then ReSendit(10)
  293.                                                        else
  294.         (* Got a good packet *)
  295.         IF InPacketType = Ord('D') then
  296.               BEGIN (* Receive data *)
  297.         (*    WRITELN ('RECEIVE data ');  *)
  298.               I := 1 ;
  299.               WHILE I <= InDataCount DO
  300.                  BEGIN (* Write Data to file  *)
  301.                    IF (RepChar<>$20)and (RecvData[I]=RepChar) then
  302.                         BEGIN (* Repeat char   *)
  303.                         I := I+1 ;
  304.                         charcount := RecvData[I] - 32 ;
  305.                         I := I + 1 ;
  306.                         For j := 1 to charcount - 1 do
  307.                              Write(Chr(RecvData[i]));
  308.                         END ;  (* Repeat char  *)
  309.                    IF (Bit8Quote<>$20) and (RecvData[I]=Bit8Quote) then
  310.                         BEGIN (* 8TH BIT QUOTING  *)
  311.                         I := I+1 ;
  312.                         BIT8 := $80 ;
  313.                         END   (* 8TH BIT QUOTING  *)
  314.                                                                    else
  315.                         BIT8 := 0 ;
  316.                    IF RecvData[I] = rCntrlQuote then
  317.                         BEGIN (* CONTROL character *)
  318.                         I := I+1 ;
  319.                         IF RecvData[I] = $3F then   (* Make it a del *)
  320.                                                    RecvData[I] := $7F
  321.                                              else
  322.                         IF RecvData[I] >= 64 then   (* Make it a control *)
  323.                                           RecvData[I] := RecvData[I] - 64 ;
  324.  
  325.                        END ; (* CONTROL character *)
  326.                    RecvData[I] := RecvData[I] + BIT8 ;
  327.                    Write(Chr(RecvData[i])) ;
  328.                    I := I + 1 ;
  329.                  END ; (* Write Data to File *)
  330.               Case Breakstate of
  331.                    NoBreak : SendPacketType('Y');
  332.                    BC : RECEIVING:=false ;
  333.                    BE : SendPacketType('N') ;
  334.                    BX : BreakAck('X') ;
  335.                    BZ : BreakAck('Z') ;
  336.                End; (* Case BreakState *)
  337.               END   (* Receive data *)
  338.                               else
  339.          IF (InPacketType = Ord('F')) or (InPacketType=Ord('X')) then
  340.               BEGIN (* repeat *)
  341.               OutSeq := OutSeq - 1 ;
  342.               SendPacketType('Y') ;
  343.               END   (* repeat *)
  344.                                                                    else
  345.          IF InPacketType = Ord('Z') then SendPacketType('Y')
  346.                                     else
  347.          IF InPacketType = Ord('B') then State := C
  348.                                     else
  349.          BEGIN (* Not D,Z packet *)
  350.          STATE := A;   (* ABORT - Type not  D,Z, *)
  351.          ABORT := NOT_DZ ;
  352.          END ; (* Not D,Z packet *)
  353.  
  354.  
  355.     (* C ----- COMPLETED  State ------- *)
  356.      C:  BEGIN (* COMPLETED Receiving *)
  357.          SendPacketType('Y');
  358.          RECEIVING := FALSE ;
  359.          END ; (* COMPLETED Receiving *)
  360.  
  361.     (* A ----- A B O R T  State ------- *)
  362.      A:  BEGIN (* Abort Sending *)
  363.          RECEIVING := FALSE ;
  364.          (* SEND ERROR packet *)
  365.          OutSeq   := 0 ;
  366.          ErrorMsg :=' Abort while receiving data' ;
  367.          OutDataCount := length(ErrorMsg);
  368.          for i := 1 to length(ErrorMsg) do
  369.               SendData[i] := Ord(ErrorMsg[i]) ;
  370.          OutPacketType := Ord('E');
  371.          SENDPACKET ;
  372.          END ; (* Abort Sending *)
  373.  
  374.          END ; (* CASE of STATE *)
  375.               End ; (* Issue Remote command Request *)
  376.          End  ;  (* Generic Kermit Commands *)
  377. End ; (* RemoteProc *)
  378. End. (* Remote Unit *)