Unit RemoteU ; Interface uses Dos, (* Standard Turbo Pascal Unit *) KGlobals, Packets, SendRecv ; Procedure RemoteProc (var Instring : String) ; Implementation (* ----------------------------------------------------------------- *) (* RemoteProc - Remote procedure. *) (* ----------------------------------------------------------------- *) Procedure RemoteProc (var Instring : String) ; Const Gsubtype : String[18] = ' CDEFHIJKLMPQRTUVW' ; TYPE RemoteCommandindex = ( rem_zero, rem_kermit, rem_cwd, rem_directory, rem_erase, rem_finish, rem_help, rem_login, rem_journal, rem_copy, rem_logout, rem_message, rem_program, rem_query, rem_rename, rem_type, rem_usage, rem_variable, rem_who); Var ErrorMsg : String ; Rem_CommandTable : String[255] ; Rem_Command : String ; Tempstring : String ; Index : integer ; Receiving : boolean ; Retries : integer ; j,CharCount,Bit8 : integer ; i,i1,i2,i3 : integer ; (* ----------------------------------------------------------------------- *) Procedure AddParmString ; var i,ix : integer ; Begin (* Add parms *) If length(instring) > 0 then Begin (* add parameter *) ix := Pos(';',instring) - 1 ; if ix <= 0 then ix := length(instring) ; SendData[OutdataCount+1] := ix + $20 ; For i := 1 to ix do SendData[OutdataCount+1+i] := ord(instring[i]) ; OutdataCount := OutdataCount + ix + 1 ; Instring := copy(instring,ix+1,length(instring)-ix); If Instring[1] = ';' then Instring := copy(instring,2,length(instring)-1); End ; End ; (* Add parms *) (* *********************************************************************** *) Begin (* RemoteProc *) rem_commandtable := concat('bad ', 'KERMIT ', 'CWD ', 'DIRECTORY ', 'ERASE ', 'FINISH ', 'HELP ', 'LOGIN ', 'JOURNAL ', 'COPY ', 'LOGOUT ', 'MESSAGE ', 'PROGRAM ', 'QUERY ', 'RENAME ', 'TYPE ', 'USAGE ', 'VARIABLE ', 'WHO ') ; rem_command := ' ' + Uppercase(GETTOKEN(instring)); if rem_command = ' HOST' then Begin (* Host Command *) End (* Host Command *) else Begin (* Generic Kermit Commands *) index := POS(rem_command,rem_commandtable) div 10 ; if index = 0 then Begin (* list commands *) Writeln (rem_command,' - Invalid REMOTE command. '); Writeln(' Valid REMOTE Commands are as follows: '); Writeln('KERMIT command - command for other kermit'); Writeln('CWD directory - Change Working Directory'); Writeln('DIRECTORY filespec - Directory '); Writeln('ERASE filespec - Erase (delete) a file '); Writeln('FINISH - Terminate Kermit server '); Writeln('HELP keywords - Help from server '); Writeln('LOGIN userid - Login '); Writeln('JOURNAL command - Transaction Logging '); Writeln('COPY filespec - Copy file '); Writeln('LOGOUT - Logout the remote host '); Writeln('MESSAGE destination - Message '); Writeln('PROGRAM program-name - Program execution '); Writeln('QUERY - Query server status '); Writeln('RENAME old-filespec - Rename file '); Writeln('TYPE filespec - Type (list) file '); Writeln('USAGE area - Disk Usage Query '); Writeln('VARIABLE command - Set or Query a Variable '); Writeln('WHO userid - Who is logged in '); End (* list commands *) else Begin (* Issue Remote command Request *) (* Send Init Packet *) OutPacketType := Ord('I'); PutInitPacket ; SendPacket ; STATE := R ; RECEIVING := TRUE ; BreakState := NoBreak ; RETRIES := 10 ; (* Up to 10 retries allowed. *) WHILE RECEIVING DO CASE STATE OF (* R ------ Initial receive State ------- *) (* Valid types - Y *) R : BEGIN (* Initial Receive State *) If ( Not RecvPacket) or (InPacketType=Ord('N')) then Resendit(10) else Begin (* Send Request *) If InPacketType=Ord('Y') then GetInitPacket ; If NoEcho then waitxon := false ; OutPacketType := Ord('G') ; SendData[1] := Ord(GSubtype[index]) ; OutDataCount := 1 ; OUTSEQ := 0 ; IF OUTSEQ >= 64 THEN OUTSEQ := 0; Case RemoteCommandIndex(index) of rem_zero: ; rem_kermit: Begin (* remote kermit command *) OutPacketType := Ord('K') ; OutDataCount := 0 ; AddParmString; End ; (* remote kermit command *) rem_cwd: Begin (* Change Working Directory *) AddParmString; Writeln (' Enter Password ') ; Readln(instring); AddParmString ; End ; (* Change Working Directory *) rem_directory: AddParmString; rem_erase: AddParmString; rem_finish: AddParmString; rem_help: AddParmString; rem_login: Begin (* Login *) AddParmString; Writeln (' Enter Password ') ; Readln(instring); AddParmString ; Writeln (' Enter Account Number ') ; Readln(instring); AddParmString ; End ; (* Login *) rem_journal: Begin (* Journal *) AddParmString; Writeln (' Enter Journal Argument ') ; Readln(instring); AddParmString ; End ; (* Jounral *) rem_copy: Begin (* Copy file *) AddParmString; Writeln (' Enter destination ') ; Readln(instring); AddParmString ; End ; (* Copy file *) rem_logout: AddparmString; rem_message: Begin (* Message *) AddParmString; Writeln (' Enter Message text ') ; Readln(instring); AddParmString ; End ; (* Message *) rem_program: Begin (* Program *) AddParmString; Writeln (' Enter Program commands ') ; Readln(instring); AddParmString ; End ; (* Program *) rem_query: ; rem_rename: Begin (* Rename file *) AddParmString; Writeln (' Enter New Name ') ; Readln(instring); AddParmString ; End ; (* Rename file *) rem_type: AddParmString; rem_usage: AddParmString; rem_variable: Begin (* Variable *) If length(instring) < 1 then begin (* get command *) Writeln (' QUERY assumed. ') ; instring := 'QUERY'; end ; (* get next argument *) AddParmString; If length(instring) < 1 then begin (* get next argument *) Writeln (' Enter First Argument ') ; Readln(instring); end ; (* get next argument *) AddParmString ; If length(instring) < 1 then begin (* get next argument *) Writeln (' Enter Second Argument ') ; Readln(instring); end ; (* get next argument *) AddParmString ; End ; (* Variable *) rem_who: Begin (* Who *) AddParmString; Writeln (' Enter Options ') ; Readln(instring); AddParmString ; End ; (* Who *) End ; (* Case *) SendPacket ; STATE := RF ; End ; (* Send Request *) END ; (* Initial Receive State *) (* RF ----- Receive Filename State ------- *) (* Valid received msg type : S,Z,F,B *) RF: IF (NOT RECVPACKET) OR (InPacketType=Ord('N')) then ReSendit(10) else (* Get a packet *) IF (InPacketType = Ord('Y')) or (InPacketType=Ord('E')) then BEGIN (* Got simple reply *) For i := 1 to InDataCount do Write(Chr(RecvData[i])) ; Writeln(' '); RECEIVING := false ; (* check for date or time setting *) For i := 1 to InDataCount do tempstring[i] := Chr(RecvData[i]); tempstring[0] := Chr(InDataCount) ; If Pos('DATE' ,Tempstring )= 1 then Begin (* set date *) Val(copy(tempstring,6,2),i1,i) ; Val(copy(tempstring,9,2),i2,i) ; Val(copy(tempstring,12,2),i3,i) ; SetDate(i3+1900,i1,i2); End ; (* set date *) If Pos('TIME' ,Tempstring )= 1 then Begin (* set time *) Val(copy(tempstring,6,2),i1,i) ; Val(copy(tempstring,9,2),i2,i) ; Val(copy(tempstring,12,2),i3,i) ; SetTime(i1,i2,i3,00) ; End ; (* set time *) END (* Got simple reply *) else IF InPacketType = Ord('S') then Begin GetInitPacket; PutInitPacket; OutPacketType := Ord('Y'); SendPacket; End else IF (InPacketType = Ord('X')) or (InPacketType = Ord('F')) then BEGIN (* Got file header *) For i := 1 to InDataCount do Write(Chr(RecvData[i])) ; Writeln(' '); STATE := RD ; SendPacketType('Y'); END (* Got file header *) else BEGIN (* Not S,F,B,Z packet *) STATE := A ; (* ABORT if not a S,F,B,Z type packet *) ABORT := NOT_SFBZ ; END ; (* Not S,F,B,Z packet *) (* RD ----- Receive Data State ------- *) (* Valid received msg type : D,Z *) RD: IF (NOT RECVPACKET) OR (InPacketType=Ord('N')) then ReSendit(10) else (* Got a good packet *) IF InPacketType = Ord('D') then BEGIN (* Receive data *) (* WRITELN ('RECEIVE data '); *) I := 1 ; WHILE I <= InDataCount DO BEGIN (* Write Data to file *) IF (RepChar<>$20)and (RecvData[I]=RepChar) then BEGIN (* Repeat char *) I := I+1 ; charcount := RecvData[I] - 32 ; I := I + 1 ; For j := 1 to charcount - 1 do Write(Chr(RecvData[i])); END ; (* Repeat char *) IF (Bit8Quote<>$20) and (RecvData[I]=Bit8Quote) then BEGIN (* 8TH BIT QUOTING *) I := I+1 ; BIT8 := $80 ; END (* 8TH BIT QUOTING *) else BIT8 := 0 ; IF RecvData[I] = rCntrlQuote then BEGIN (* CONTROL character *) I := I+1 ; IF RecvData[I] = $3F then (* Make it a del *) RecvData[I] := $7F else IF RecvData[I] >= 64 then (* Make it a control *) RecvData[I] := RecvData[I] - 64 ; END ; (* CONTROL character *) RecvData[I] := RecvData[I] + BIT8 ; Write(Chr(RecvData[i])) ; I := I + 1 ; END ; (* Write Data to File *) Case Breakstate of NoBreak : SendPacketType('Y'); BC : RECEIVING:=false ; BE : SendPacketType('N') ; BX : BreakAck('X') ; BZ : BreakAck('Z') ; End; (* Case BreakState *) END (* Receive data *) else IF (InPacketType = Ord('F')) or (InPacketType=Ord('X')) then BEGIN (* repeat *) OutSeq := OutSeq - 1 ; SendPacketType('Y') ; END (* repeat *) else IF InPacketType = Ord('Z') then SendPacketType('Y') else IF InPacketType = Ord('B') then State := C else BEGIN (* Not D,Z packet *) STATE := A; (* ABORT - Type not D,Z, *) ABORT := NOT_DZ ; END ; (* Not D,Z packet *) (* C ----- COMPLETED State ------- *) C: BEGIN (* COMPLETED Receiving *) SendPacketType('Y'); RECEIVING := FALSE ; END ; (* COMPLETED Receiving *) (* A ----- A B O R T State ------- *) A: BEGIN (* Abort Sending *) RECEIVING := FALSE ; (* SEND ERROR packet *) OutSeq := 0 ; ErrorMsg :=' Abort while receiving data' ; OutDataCount := length(ErrorMsg); for i := 1 to length(ErrorMsg) do SendData[i] := Ord(ErrorMsg[i]) ; OutPacketType := Ord('E'); SENDPACKET ; END ; (* Abort Sending *) END ; (* CASE of STATE *) End ; (* Issue Remote command Request *) End ; (* Generic Kermit Commands *) End ; (* RemoteProc *) End. (* Remote Unit *)