home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Columbia Kermit
/
kermit.zip
/
archives
/
tpdoskermit.zip
/
kermit.inc
< prev
next >
Wrap
Text File
|
1991-04-18
|
15KB
|
644 lines
(******************* KERMIT.INC ************************)
CONST
MaxY = 25;
LenModulo = 95;
CONST
ErrorLevel : WORD = 0;
SendDelay : WORD = 0;
FileNameSet : SET OF CHAR =
['!','#'..')','-','.','0'..':','@'..'Z','\','^'..'z','~'];
VAR
InnConvert, UtConvert : ARRAY [CHAR] OF CHAR;
VAR t2, MaxServer : TimerTableRec; {Br vre global!}
DTA : SearchRec;
FTime : DateTime;
MaxPrTick : WORD;
CONST
KermitBufSize : WORD = $F000;
CONST
Qrep : BOOLEAN = TRUE;
Q8Bit : BOOLEAN = TRUE;
ServerTimeOut : BOOLEAN = FALSE;
RetryLimit : BYTE = 10;
YourTimeOut : BYTE = 15;
SendTimeOut : BYTE = 5;
MyPad : BYTE = 0;
MyPadChar : CHAR = ^@;
YourPad : BYTE = 0;
YourPadChar: CHAR = ^@;
TYPE
CharArray = ARRAY [1..9040] OF CHAR;
CarNum = 0..222;
IBM_Type = 0..2;
UnCarCh = ' '..#254;
PakkeCh = '@'..'Z';
PakkeType = RECORD
TotLen: WORD;
long : BOOLEAN;
plen : CHAR;
pnr : UnCarCh;
ptype : PakkeCh;
CASE BOOLEAN OF
TRUE : (plen1,
plen2,
hchk : CHAR);
FALSE : (pdata : CharArray);
END;
PakkeTypePtr = ^PakkeType;
TYPE
PacketWindow = RECORD
retry : WORD;
dptr : ^PakkeType;
CASE BYTE OF
0 : (acked, nacked : BOOLEAN);
1 : (acknack : WORD);
END;
FilBuffer = ARRAY [0..$F000] OF CHAR;
BufferPtr = ^FilBuffer;
VAR
nr, i, n, ninn, nut : WORD;
pw : ARRAY [0..63] OF PacketWindow;
LongReply, DiskError : BOOLEAN;
StopFile, AttrPakke : BOOLEAN;
fil : FILE;
YourMaxLength, RetryNr, LastNr, PakkeNr,
CheckType, FeilNr, PacketDelay : WORD;
BufSize, BufCount, MaxRep : WORD;
Bytes : LongInt;
buffer : BufferPtr;
BufPtr : ^CHAR;
FileMax, TotalNr : LongInt;
ShowTimeOut, EndOfFile : BOOLEAN;
OriginalName, FileName, ErrorString, DownLoadPath,
StatusString : String[80];
RX_Pac, TX_Pac, Next_Pac : PakkeTypePtr;
Next_Data_OK : BOOLEAN;
RepQ, Bit8Q : CHAR;
st : String;
TYPE DupHandleType = (RenameFile, OverWriteFile, SkipFile);
(**********************************************************************)
(* Here are all variables that can be stored on disk: *)
(**********************************************************************)
CONST
Versjon : String[4] = 'V0.1';
DupHandle : DupHandleType = RenameFile;
OldDupHandle : DupHandleType = SkipFile;
NewDupHandle : DupHandleType = OverWriteFile;
CurBaud : LongInt =115200;
CurBits : WORD = 8;
CurStop : WORD = 1;
CurParity : ParityType = No_Parity;
CurComPort : WORD = 1;
LongMaxLength: WORD = 9020;
WinSize : WORD = 31;
MyTimeOut : WORD = 12;
ServerTime : WORD = 0;
LongPakke : BOOLEAN = TRUE;
WindowData : BOOLEAN = FALSE;
TextFile : BOOLEAN = FALSE;
IBM_Mode : IBM_Type = 0;
BinaryData : BOOLEAN = TRUE;
FileCheck : BYTE = 2;
MySOH : CHAR = #1;
YourSOH : CHAR = #1;
MyCR : CHAR = #13;
YourCR : CHAR = #13;
MyQCtrlChar : CHAR = '#';
YourQCtrlChar: CHAR = '#';
Q8bitChar : CHAR = '&';
QrepChar : CHAR = '~';
KermitAttr : BYTE = 0;
MenuAttr : BYTE = 0;
FieldAttr : BYTE = 0;
SaveEdit : BYTE = 0;
DirVideo : BOOLEAN = TRUE;
Marker_Byte : BYTE = 0;
(**********************************************************************)
(* Slutt p setup-variable! *)
(**********************************************************************)
DupString : ARRAY[DupHandleType] OF FeltStr =
('Rename','OverWrite','Skip');
BinText : ARRAY [BOOLEAN] OF FeltStr = ('BIN','TEXT');
Std_IBM : ARRAY [IBM_Type] OF FeltStr = ('Std','I-E','IBM');
ParityStr : ARRAY [ParityType] OF FeltStr =
('NONE','EVEN','ODD','MARK','SPACE');
PROCEDURE SplitFileName(fn : String; VAR drive,path,name,ext : String);
VAR e : WORD;
BEGIN
e := Pos(':',fn);
drive := '';
IF e > 0 THEN BEGIN
IF e = 2 THEN drive := Copy(fn,1,2);
Delete(fn,1,e);
END;
e := Length(fn);
ext := '';
WHILE (e > 0) AND (fn[e] <> '.') AND (fn[e] <> '\') DO Dec(e);
IF (e > 0) AND (fn[e] = '.') THEN BEGIN
ext := Copy(fn,e,4);
fn[0] := Chr(e-1);
END;
e := Length(fn);
path := '';
WHILE (e > 0) AND (fn[e] <> '\') DO Dec(e);
IF e > 0 THEN path := Copy(fn,1,e);
name := Copy(fn,e+1,8);
END;
FUNCTION Exist(fn : String): BOOLEAN;
VAR f : FILE;
at : WORD;
BEGIN
Assign(f,fn);
GetFAttr(f,at);
Exist := DosError = 0;
END;
PROCEDURE MoveW(VAR fra, til; len : WORD); BEGIN Move(fra,til,len*2); END;
PROCEDURE Bell; BEGIN Sound(1000); Delay(150); NoSound; END;
PROCEDURE ByteToDigits(by : BYTE; VAR buf);
VAR b : ARRAY [1..2] OF BYTE ABSOLUTE buf;
BEGIN
b[1] := by DIV 10 + 48;
b[2] := by MOD 10 + 48;
END;
FUNCTION Pad(st : String; len : INTEGER): String;
BEGIN
WHILE len > Length(st) DO st := st + ' ';
Pad := st;
END;
PROCEDURE SetCursor(mode : WORD);
BEGIN
Inline(
$B4/$01 {mov ah,1}
/$8B/$4E/<MODE {mov cx,[bp<mode]}
/$CD/$10 {int $10}
);
END;
PROCEDURE CursorOn;
BEGIN
IF LastMode = 7 THEN
SetCursor($C0D)
ELSE
SetCursor($607);
END;
PROCEDURE CursorOff;
BEGIN
SetCursor($2000);
END;
PROCEDURE ClrAll; BEGIN ClrScr; END;
PROCEDURE ClrLast; BEGIN GotoXY(1,25); ClrEol; END;
PROCEDURE WriteStr(st : String);
BEGIN
Write(st);
END;
PROCEDURE Error(msg : String);
BEGIN
ClrLast;
Write(msg,' Hit Esc!');
CursorOn;
REPEAT UNTIL ReadKey = #27;
CursorOff;
ClrLast;
END;
(*
PROCEDURE ReadString(help : INTEGER; prompt : String; len : BYTE;
VAR st : String; VAR ok : BOOLEAN);
VAR xpos : BYTE;
BEGIN
WriteStr(prompt);
st := '';
xpos := 1;
ok := EditStr(st,xpos,len,0,NIL,LeftJ);
END;
PROCEDURE ReadString(help : INTEGER; prompt : String;
maxlen : INTEGER;VAR st : String;VAR ok: BOOLEAN);
VAR key : WORD;
ch : CHAR;
BEGIN
ClrLast;
CursorOn;
Write(prompt);
st := '';
REPEAT
key := ReadKey;
IF key = $4400 THEN BEGIN
st := '';
ok := FALSE;
CursorOff;
Exit;
END
ELSE IF Lo(key) <> 0 THEN BEGIN
ch := Chr(Lo(key));
CASE ch OF
^H : IF Length(st) > 0 THEN BEGIN
Dec(st[0]);
Write(^H' '^H);
END;
^M : BEGIN
ok := TRUE;
CursorOff;
Exit;
END;
ELSE IF Length(st) < MaxLen THEN BEGIN
st := st + ch;
Write(ch);
END;
END;
END;
UNTIL FALSE;
END;
PROCEDURE ReadNum(help : INTEGER;prompt : String;min, max : WORD;
VAR svar : WORD);
VAR st : String;
n, feil : INTEGER;
ok : BOOLEAN;
BEGIN
REPEAT
ClrLast;
ReadString(help,prompt,10,st,ok);
IF st = '' THEN Exit;
Val(st,n,feil);
UNTIL (feil = 0) AND (n >= min) AND (n <= max);
svar := n;
END;
*)
PROCEDURE ReadFileName(prompt : String; VAR fil : String);
VAR e : EditRecord;
ok : CharSet;
BEGIN
fil := '';
ok := FileNameSet + ['*','?'];
e.x := 1; e.y := 25; e.len := 53; e.prompt := prompt;
e.ftype := StrT; e.xpos := 1; e.just := LeftJ;
e.StrP := Addr(fil);
e.okSetS := Addr(ok);
e.ModeS := ToUpper;
CursorOn;
REPEAT
EditOne(e);
UNTIL EditChar IN [^M,#68,^[];
CursorOff;
END;
FUNCTION Tstr(n, len : WORD): String;
VAR st : STRING[20];
BEGIN
Str(n:len,st);
Tstr := st;
END;
PROCEDURE StartTimerSek(VAR t : TimerTableRec; sek : WORD);
BEGIN
t.count := sek *18;
t.UserInt := FALSE;
StartTimer(t);
END;
PROCEDURE BIOSKbd(help : INTEGER; expand : BOOLEAN; VAR ch : CHAR;
VAR scan : INTEGER);
BEGIN
ch := ReadKey;
IF ch = #0 THEN scan := Ord(ReadKey) ELSE scan := 2;
END;
FUNCTION KeyPress : BOOLEAN;
BEGIN
KeyPress := KeyPressed;
END;
PROCEDURE ScrollWin(x0,y0,x1,y1,lines,attr : INTEGER);
VAR sx, sy : WORD;
BEGIN
sx := WhereX; sy := WhereY;
Window(x0,y0,x1,y1);
GotoXY(1,1);
IF lines = 0 THEN ClrScr
ELSE IF lines > 0 THEN DelLine
ELSE InsLine;
Window(1,1,80,25);
GotoXY(sx,sy);
END;
PROCEDURE GetF10;
BEGIN
IF TotalBytes = 0 THEN Exit;
ClrLast;
WriteStr('File transfer completed! Hit any key to continue ... ');
IF ReadKey = #0 THEN IF ReadKey = #0 THEN;
END;
PROCEDURE UpperStr(VAR st : String);
VAR i : INTEGER;
BEGIN
FOR i := 1 TO Length(st) DO st[i] := UpCase(st[i]);
END;
CONST MaxArgC = 2;
MaxOptC = 1;
VAR InitFileName : STRING[80];
ArgV : ARRAY [1..2] OF String[64];
ArgC, OptC : BYTE;
OptV : ARRAY [1..1] OF String[64];
PROCEDURE ParseCmd;
VAR i : INTEGER;
st : String;
BEGIN
ArgC := 0;
OptC := 0;
FOR i := 1 TO ParamCount DO BEGIN
st := ParamStr(i);
UpperStr(st);
IF st[1] = '/' THEN BEGIN
Inc(OptC);
OptV[OptC] := st;
END
ELSE BEGIN
Inc(ArgC);
ArgV[ArgC] := st;
END;
END;
END;
PROCEDURE GetInitFileName;
VAR env_ptr : ^WORD;
i : INTEGER;
drive, path, name, ext, od, op, on, oe : String[80];
BEGIN
ParseCmd;
IF Hi(DosVersion) >= 3 THEN BEGIN
env_ptr := Ptr(MemW[PrefixSeg:$2C],0);
WHILE env_ptr^ <> 0 DO Inc(Word(env_ptr));
Inc(Word(env_ptr),4);
InitFileName := '';
REPEAT
InitFileName := InitFileName + CHAR(env_ptr^);
Inc(Word(env_ptr));
UNTIL CHAR(env_ptr^) = #0;
END
ELSE
InitFileName := 'KERMIT';
SplitFileName(InitFileName,drive,path,name,ext);
ext := '.INI';
IF (OptC >= 1) AND (Copy(OptV[1],1,3) = '/I=') THEN BEGIN
SplitFileName(Copy(OptV[1],4,80),od,op,on,oe);
IF (od <> '') OR (op <> '') THEN BEGIN
drive := od;
path := op;
END;
IF on <> '' THEN name := on;
IF oe <> '' THEN ext := oe;
END;
InitFileName := drive+path+name+ext;
END; {GetInitFileName}
PROCEDURE SaveParam;
VAR f : FILE;
BEGIN
Assign(f,InitFileName);
ReWrite(f,1);
BlockWrite(f,Versjon,Ofs(Marker_Byte)-Ofs(Versjon));
Close(f);
IF IOresult <> 0 THEN Error('Save error!');
END;
FUNCTION GetParam : BOOLEAN;
VAR f : FILE;
v : String[4];
bytes : WORD;
ok : BOOLEAN;
BEGIN
GetParam := FALSE;
GetInitFileName;
IF Exist(InitFileName) THEN BEGIN
Assign(f,InitFileName);
Reset(f,1);
v := '';
BlockRead(f,v,SizeOf(v));
bytes := Ofs(Marker_Byte)-Ofs(Versjon);
ok := FALSE;
IF (v <> Versjon) OR (FileSize(f) <> bytes) THEN Exit;
Seek(f,0);
BlockRead(f,Versjon,bytes);
ok := IOresult = 0;
Close(f);
IF NOT ok OR (IOresult <> 0) THEN BEGIN
Error('Get .INI error!');
Exit;
END;
IF KermitAttr <> 0 THEN TextAttr := KermitAttr;
IF SaveEdit <> 0 THEN EditAttr := SaveEdit;
END;
GetParam := TRUE;
END;
PROCEDURE StartLink;
BEGIN
IF NOT DiskStopInt OR BinaryData THEN Exit;
RS_Enable(CurComPort);
RS_WriteFirst(^Q,CurComPort);
END;
PROCEDURE StopLink;
BEGIN
IF DiskStopInt AND NOT BinaryData THEN RS_WriteFirst(^S,CurComPort);
END;
(******************** Statistics **********************)
FUNCTION DOS_Time : LongInt;
VAR h, m, s, s100 : WORD;
BEGIN
GetTime(h,m,s,s100);
DOS_Time := h * 36000 + m * 600 + s * 10 + (s100+5) DIV 10;
END;
PROCEDURE InitStat;
BEGIN
TotalTime := DOS_Time; TotalBytes := 0; SendBytes := 0; ReceiveBytes := 0;
FileNr := 0;
END;
PROCEDURE ShowStat;
VAR ch : CHAR;
t : REAL;
BEGIN
IF TotalBytes+SendBytes+ReceiveBytes > 0 THEN BEGIN
TotalTime := DOS_Time - TotalTime;
Window(22,5,80,10);
ClrScr;
WriteLn(' Total bytes: ',TotalBytes);
WriteLn(' Total files: ',FileNr);
WriteLn(' Bytes sent: ',SendBytes);
WriteLn(' Bytes received: ',ReceiveBytes);
WriteLn(' Total time: ',TotalTime DIV 10,'.',TotalTime MOD 10);
Write (' Effective Baud: ',TotalBytes * 100 DIV TotalTime);
Window(1,1,80,25);
END;
END;
TYPE
KeyType = 0..40;
KeySet = SET OF KeyType;
VAR OrigText, OrigMenu, OrigField, OrigEdit : BYTE;
PROCEDURE Init_Params;
VAR ok : BOOLEAN;
temp : LongInt;
BEGIN
RS_Init(CurBaud,CurBits,CurStop,CurParity,ok,CurComPort);
temp := 115200 DIV ((115200 + (CurBaud Shr 1)) DIV CurBaud);
IF temp <> CurBaud THEN BEGIN CurBaud := temp; ok := FALSE; END;
MaxPrTick := CurBaud DIV 250;
IF CurBaud > 30000 THEN BEGIN
DiskStopInt := TRUE;
WindowData := FALSE;
RS_Buffer[CurComPort].AutoXoff := FALSE;
END;
IF IBM_Mode > 0 THEN BEGIN
MySOH := '%';
YourSOH := '%';
BinaryData := FALSE;
END;
IF BinaryData THEN BEGIN
CurBits := 8;
CurParity := No_Parity;
RS_Buffer[CurComPort].AutoXoff := FALSE;
END;
{
IF (CurBaud <= 2400) AND WindowData THEN
RS_Start(RX_Int+TX_Int+RLS_int,CurComPort)
ELSE
}
RS_Start(RX_Int+RLS_int,CurComPort);
YourQCtrlChar := MyQCtrlChar;
YourSOH := MySOH;
YourCR := MyCR;
END;
PROCEDURE Meny(VAR k : KeyType);
VAR
temp : LongInt;
st, keyset : String;
ch : CHAR;
OldPath : String[64];
OldMenu, OldAttr : BYTE;
dta : SearchRec;
PROCEDURE ShowMeny;
BEGIN
IF MenuAttr = 0 THEN MenuAttr := OrigMenu;
IF FieldAttr = 0 THEN FieldAttr := OrigField;
FeltAttr := FieldAttr;
IF KermitAttr = 0 THEN KermitAttr := OrigText;
TextAttr := KermitAttr;
IF SaveEdit = 0 THEN SaveEdit := OrigEdit;
EditAttr := SaveEdit;
ClrScr;
GotoXY(22,3); Write(CpRt);
GotoXY(34,14); WriteStr('Duplicate File Names');
OldAttr := TextAttr;
TextAttr := MenuAttr;
GotoXY(1,25);
WriteStr('F1-Send F2-Receive F3-Get F4-Server F5-Save F7-DOS F8-Term F9-Logout F10-Exit');
TextAttr := OldAttr;
OldMenu := MenuAttr;
END;
BEGIN
ShowMeny;
CursorOn;
REPEAT
OldPath := DownLoadPath; OldAttr := KermitAttr;
RS_Stop(CurComPort);
ShowAll;
EditAllRecords; {EditChar inneholder siste tast}
IF (KermitAttr <> OldAttr) OR (FieldAttr <> FeltAttr) OR
(MenuAttr <> OldMenu) THEN BEGIN
ShowMeny;
ShowAll;
END;
SaveEdit := EditAttr;
Init_Params;
IF DownLoadPath <> OldPath THEN BEGIN
ChDir(DownLoadPath);
IF IOresult = 0 THEN
GetDir(0,DownLoadPath)
ELSE BEGIN
DownLoadPath := OldPath;
ShowAll;
END;
END;
DirectVideo := DirVideo;
UNTIL EditChar IN [#59..#68];
CursorOff;
k := Ord(EditChar) - 58;
END; {Meny}