home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Columbia Kermit
/
kermit.zip
/
pub
/
queenskermit
/
remoteu.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
2020-01-01
|
15KB
|
378 lines
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 *)