Columbia Kermit/kermit.zip/archives/tpdoskermit.zip/kermit.pas

Pascal/Delphi Source File | 1991-04-18 | 61KB | 2,208 lines

$R-,S-,I-,D+,T+,F-,V-,B-,N-
 $R+,S+,I-,D+,T+,F-,V-,B-,N-
$M $2000,$9000,$18000}     {8k STACK, 36k-96k HEAP

PROGRAM Kermits;

Uses MyDos, Crt, Timers, {Keyboard, }Async, Crcs, FeltEdit, FixAttr;

CONST
  CpRt : String[40] = 'KERMIT file transfer. V1.1a TMa, NH 1988';

  DiskStopInt : BOOLEAN = FALSE;

(**********************************************************************)
(*                                                                    *)
(*                   Start for Kermits egne procedures                *)
(*                                                                    *)
(**********************************************************************)

VAR TotalTime, TotalBytes, SendBytes, ReceiveBytes : LongInt;
    FileNr : WORD;

$I KERMIT.INC}            {Kermit const, type, var and some proc's.

PROCEDURE InitWindow;
VAR i : WORD;
    p : Pointer;
BEGIN
  FillChar(pw,SizeOf(pw),#0);
  ninn := PakkeNr; nut := PakkeNr;
  p := Next_Pac;

  FOR i := 0 TO 31 DO BEGIN
    pw[i].dptr    := p;
    pw[i+32].dptr := p;
    Inc(Word(p),108);                  {Room for 95 char + fudge factor}
  END;
  GotoXY(33,10); WriteStr('Window:');
  LongPakke := FALSE;
END;                                   { InitWindow }

PROCEDURE Warning(msg : String);
BEGIN
  ScrollWin(41,14,80,24,-1,KermitAttr);
  GotoXY(27,14); WriteStr('Last warning: '+msg);
END;

TYPE Retry_Code = (r_ok, r_keyboard, r_timeout, r_exit);
VAR r_code : Retry_Code;

FUNCTION Retry : Retry_Code;
VAR ch : CHAR;
    code : INTEGER;
    enable : BOOLEAN;
BEGIN
  r_code := r_ok;
  enable := FALSE;
  IF KeyPress THEN BEGIN
    BIOSKbd(-1,FALSE,ch,code);
    IF (ch = #0) THEN
      CASE code OF
        45 : enable := TRUE;
        59 : StopFile := TRUE;
        67 : BEGIN
               r_code := r_keyboard;
                  enable := TRUE;
             END;
        68 : r_code := r_exit;
      END;
  END
  ELSE IF NOT RunningTimer(t2) THEN BEGIN
    r_code := r_timeout;
    enable := TRUE;
  END;
  IF enable THEN BEGIN
    RS_Enable(CurComPort);
    StartLink;
  END;
  Retry := r_code;
END;                                   {Retry}

PROCEDURE SendLink(VAR buf; n : WORD);
LABEL Ferdig;
VAR d : CharArray ABSOLUTE buf;
    i, len : WORD;
    ok : BOOLEAN;
    ch : CHAR;
    dptr : ^CHAR;
BEGIN
  Inc(SendBytes,n+2);
  i := 10;
  IF SendTimeOut > 0 THEN
    i := SendTimeOut;
  StartTimerSek(t2,i);
  IF NOT WindowData THEN BEGIN
    WHILE (RS_Buffer[CurComPort].HostXoff OR
        NOT RS_Empty(CurComPort)) DO BEGIN
      RS_ClrBuffer(CurComPort);
      IF Retry <> r_ok THEN GOTO Ferdig;
    END;
    Delay(PacketDelay);             { Wait if neccessary! }
  END;
  REPEAT
    IF Retry <> r_ok THEN GOTO Ferdig;
    RS_Write(YourSOH,ok,CurComPort);
  UNTIL ok;
  IF CurBaud > 30000 THEN Delay(1);

  IF IBM_Mode = 1 THEN BEGIN
    REPEAT
      RS_BusyRead(ch,ok,CurComPort);
      IF NOT ok THEN
        IF Retry <> r_ok THEN GOTO Ferdig;
    UNTIL ok AND (ch = YourSOH);
    len := 1;
    i := 1;
    REPEAT
      IF len <= n THEN BEGIN
        RS_Write(d[len],ok,CurComPort);
        IF ok THEN BEGIN
          Inc(len);
          Delay(SendDelay);
        END;
      END;
      REPEAT
        RS_BusyRead(ch,ok,CurComPort);
        IF ok THEN BEGIN
          IF (d[i] = ch) OR (d[i] = ' ') THEN
            Inc(i);
        END
        ELSE
          IF Retry <> r_ok THEN GOTO Ferdig;
      UNTIL (len - i < 40) AND NOT ok;
    UNTIL (len > n) AND (i > n);
  END
  ELSE BEGIN
    dptr := Addr(d[1]);

    IF CurBaud > 30000 THEN BEGIN
      len := MaxPrTick;
      REPEAT
        IF len > n THEN len := n;
        RS_WriteBlock(dptr^,len,i,CurComPort);
        Dec(n,len);
        Inc(Word(dptr),len);
        Delay(1);
      UNTIL n = 0;
    END
    ELSE BEGIN
      REPEAT
        RS_WriteBlock(dptr^,n,i,CurComPort);
        IF Retry <> r_ok THEN GOTO Ferdig;
        Dec(n,i);
        Inc(Word(dptr),len);
      UNTIL n = 0;
    END;
  END;

  REPEAT
    RS_Write(YourCR,ok,CurComPort);
  UNTIL ok OR (Retry <> r_ok);

Ferdig:

END;                         { SendLink }

PROCEDURE GetLink(VAR buf; VAR n : WORD; max : WORD);
LABEL Ferdig, Restart_Packet;
VAR d : ARRAY [0..4000] OF CHAR ABSOLUTE buf;
    bytes, i, x : WORD;
    ch : CHAR;
    done : BOOLEAN;
    escape : STRING[10];
BEGIN
  StartTimerSek(t2,YourTimeOut);
  ch := ' ';

  REPEAT
    RS_BusyRead(ch,done,CurComPort);
    IF NOT done THEN
      IF Retry <> r_ok THEN GOTO Ferdig;
    Inc(ReceiveBytes,Ord(done));
  UNTIL (ch=MySOH);

  x := 3;

Restart_Packet:
  n := 0;

  d[0] := '~';                   { len   = 94 }
  d[3] := Chr(LenModulo+31);     { plen1 = 94/63 }
  d[4] := Chr(LenModulo+31);     { plen2 = 94/63 }

  REPEAT
    RS_ReadBlock(d[n],max - n,bytes,CurComPort);
    Inc(ReceiveBytes,bytes);
    IF bytes=0 THEN BEGIN
      IF d[0] > ' ' THEN BEGIN
        IF n > Ord(d[0]) - 32 THEN GOTO Ferdig;
      END
      ELSE
        IF n > (Ord(d[3]) - 32) * LenModulo + Ord(d[4]) - 32 THEN GOTO Ferdig;
      IF Retry <> r_ok THEN GOTO Ferdig;
      Write_String(d[0],1,1,Byte_Stay,n,KermitAttr);
    END
    ELSE IF NOT BinaryData AND (d[n] < ' ') THEN BEGIN
      IF d[n] = MyCR THEN GOTO Ferdig;
      IF d[n] = MySOH THEN BEGIN
        GOTO Restart_Packet;
      END;
      IF (d[n] = ^[) AND (IBM_Mode > 0) THEN BEGIN
        escape[0] := #0;
        REPEAT                         { Read an Escape Seq's }
          RS_BusyRead(ch,done,CurComPort);
          IF NOT done THEN BEGIN
            IF Retry <> r_ok THEN GOTO Ferdig;
          END
          ELSE
            escape := escape + ch;
        UNTIL done AND (ch IN ['@'..'Z','a'..'z']);

        Dec(escape[0]);
        IF ch = 'H' THEN BEGIN
          WHILE x < 81 DO BEGIN
            Inc(x);
            d[n] := ' ';
            Inc(n);
          END;
          x := 1;
          ch := escape[Length(escape)];
          WHILE ch > '1' DO BEGIN
            Inc(x);
            d[n] := ' ';
            Inc(n);
            Dec(ch);
          END;
        END;
      END;
      { Ignore other control characters ! }
    END
    ELSE BEGIN
      Inc(n,bytes);
      IF IBM_Mode > 0 THEN BEGIN
        Inc(x,bytes);
        IF x > 81 THEN x := 81;
      END;
      IF (n >= max) THEN GOTO Ferdig;
    END;
  UNTIL FALSE;
  Ferdig:
END;                         { GetLink }

FUNCTION CheckSum(VAR buf; n, CheckType : WORD): WORD;
BEGIN
  IF CheckType <= 2 THEN BEGIN
    n := ChkSum(buf,n);
    IF CheckType = 1 THEN
      CheckSum := (n + Lo(n) Shr 6) AND 63
    ELSE
      CheckSum := n AND $FFF;
  END
  ELSE { CRC }
    CheckSum := CRC(buf,n);
END;                         { CheckSum }

PROCEDURE SendPakkeT(VAR T : PakkeType);
VAR s : WORD;
BEGIN
  IF T.long THEN BEGIN
    T.plen := ' ';
    T.plen1 := Chr(32 + (T.TotLen - 1) DIV LenModulo);
    T.plen2 := Chr(32 + ((T.TotLen - 1) MOD LenModulo));
    s := CheckSum(T.plen,5,1);
    T.hchk := Chr(32 + s);
  END
  ELSE BEGIN
    IF (T.TotLen > 95) OR (T.TotLen < 4) THEN BEGIN
      WriteLn('Gal lengde: ',T.TotLen);
      Exit;
    END;
    T.plen := Chr(31 + T.TotLen);
  END;
  s := CheckSum(T.plen,T.TotLen-CheckType,CheckType);
  IF CheckType >= 2 THEN BEGIN
    IF CheckType = 3 THEN
      T.pdata[T.TotLen-5] := Chr(32 + (s Shr 12));
    T.pdata[T.TotLen-4] := Chr(32 + ((s Shr 6) AND 63));
  END;
  T.pdata[T.TotLen-3] := Chr(32 + (s AND 63));
  SendLink(T.plen,T.TotLen);
END;                         { SendPakkeT }

PROCEDURE SendPakke;
BEGIN
  SendPakkeT(TX_Pac^);
END;

PROCEDURE MakePakke(VAR p : PakkeType; nr : CarNum;
                    typ : PakkeCh; data : String);
BEGIN
  p.pnr := Chr(32 + nr);
  p.ptype := typ;
  p.TotLen := Length(data) + 3 + CheckType;
  p.plen := Chr(31 + p.TotLen);
  p.long := FALSE;
  Move(data[1],p.pdata,Length(data));
END;                         { MakePakke }

FUNCTION TestPakke(VAR p : PakkeType): BOOLEAN;
VAR chk, c : WORD;
BEGIN
  TestPakke := FALSE;
  IF p.TotLen <= 2 + CheckType THEN BEGIN
    IF p.TotLen > 0 THEN
      Warning('Too short packet!')
    ELSE IF (p.TotLen = 0) AND ShowTimeOut THEN
      Warning('TimeOut!');
    Exit;
  END;
  IF (p.ptype < 'A') OR (p.ptype > 'Z') THEN BEGIN
    Warning('Error in packet type!');
    Exit;
  END;
  IF p.plen > ' ' THEN BEGIN
    chk := Ord(p.plen) - 32;
    p.long := FALSE;
  END
  ELSE BEGIN
    chk := CheckSum(p.plen,5,1);
    IF chk <> Ord(p.hchk)-32 THEN BEGIN
      Warning('Error in header checksum!');
      Exit;
    END;
    chk := (Ord(p.plen1) - 32) * LenModulo + Ord(p.plen2) - 32;
    p.long := TRUE;
  END;
  IF chk >= p.TotLen THEN BEGIN
    Warning('Len error: '+Tstr(chk-p.TotLen-1,1));
    Exit;
  END;
  p.TotLen := Succ(chk);
  IF Ord(p.pnr) - 32 > 63 THEN Exit;
  chk := CheckSum(p.plen,p.TotLen - CheckType,CheckType);
  c := Ord(p.pdata[p.TotLen-3]) - 32;
  IF CheckType >= 2 THEN BEGIN
    Inc(c,(Ord(p.pdata[p.TotLen-4]) - 32) Shl 6);
    IF CheckType = 3 THEN
      Inc(c,(Ord(p.pdata[p.TotLen-5]) - 32) Shl 12);
  END;
  IF c = chk THEN
    TestPakke := TRUE
  ELSE
    Warning('CHK err: Calc='+Tstr(chk,1)+', Rec='+Tstr(c,1));
END;                                   {TestPakke}

PROCEDURE GetFast(VAR p; VAR len : WORD; max : WORD);
LABEL Avbryt;
VAR by : BYTE;
    ch : CHAR;
    ok : BOOLEAN;
    dptr : ^BYTE;
    md, dend, bytes, receive, status : WORD;
    count : WORD;
BEGIN
  StartTimerSek(t2,YourTimeOut);
  dptr := Addr(p);
  dend := Word(dptr) + max;

  receive := RS_Buffer[CurComPort].ICadr;
  status := receive + 5;

  count := MaxPrTick;
  ch := #255;
  REPEAT
    IF (Retry <> r_ok) OR NOT RunningTimer(t2) THEN GOTO Avbryt;
    RS_BusyRead(ch,ok,CurComPort);
    Inc(ReceiveBytes,Ord(ok));
  UNTIL ch = MySOH;

  RS_Set_TX_Int(0,CurComPort);
  InLine($FA);                         {CLI}

  Port[receive+1] := 0;                {Turn off all Serial int's}

  md := 2000;                          {Wait up to 8 ms for first char.}
  REPEAT
    repeat
      Dec(md);
      if md = 0 then goto avbryt;
    until Odd(Port[status]);           {Received data available}

    dptr^ := Port[receive];
    Inc(Word(dptr));
    md := 200;                         { >1 ms delay between two chars}
    Dec(count);
    IF count = 0 THEN BEGIN
      InLine($FB);
        md := 2000;
        count := MaxPrTick;
      InLine($FA);
    END;
  UNTIL Word(dptr) >= dend;

Avbryt:
  InLine($FB);
  Port[receive+1] := RX_int+RLS_int;   {Turn off all Serial int's}

  len := Word(dptr) - Ofs(p);
  Inc(ReceiveBytes,len);
END;

PROCEDURE GetPakke;
VAR max : WORD;
BEGIN
  IF LongPakke THEN max := 9030 ELSE max := 95;
  IF (CurBaud > 30000) THEN
    GetFast(RX_Pac^.plen,RX_Pac^.TotLen,max)
  ELSE
    GetLink(RX_Pac^.plen,RX_Pac^.TotLen,max);
  IF r_code = r_ok THEN BEGIN
    IF NOT TestPakke(RX_Pac^) THEN BEGIN
      MakePakke(RX_Pac^,PakkeNr,'T','P');
    END;
  END
  ELSE IF r_code = r_keyboard THEN
    MakePakke(RX_Pac^,PakkeNr,'T','K')
  ELSE IF r_code = r_timeout THEN
    MakePakke(RX_Pac^,PakkeNr,'T','T')
  ELSE IF r_code = r_exit THEN
    MakePakke(RX_Pac^,PakkeNr,'E','F10')
  ELSE BEGIN
    Warning('r_code error!');
    MakePakke(RX_Pac^,PakkeNr,'T','R');
  END;
END;                         { GetPakke }

PROCEDURE Extract(VAR st : String);
VAR i, l : WORD;
BEGIN
  i := 1;
  IF RX_Pac^.long THEN i := 4;

  l := RX_Pac^.TotLen - i - 2 - CheckType;
  IF l >= SizeOf(st) THEN l := SizeOf(st) - 1;
  st[0] := Chr(l);
  Move(RX_Pac^.pdata[i],st[1],l);
END;                         { Extract }

PROCEDURE DumpPointers;
CONST NackCh : ARRAY [0..10] OF CHAR = '-123456789A';
VAR n, i : WORD;
BEGIN
  st[0] := #31;
  FillChar(st[1],31,' ');
  n := nut;
  FOR i := 1 TO (ninn-nut) AND 63 DO BEGIN
    st[i] := NackCh[pw[n].retry];
    n := Succ(n) AND 63;
  END;
  GotoXY(41,10); WriteStr(st);
END;

PROCEDURE MakeInfoScreen(s : String);
BEGIN
  ClrAll;
  ClrLast;
  GotoXY(30,6); WriteStr('File name:');
  GotoXY(22,7); WriteStr('Bytes transferred:');
  GotoXY(30,9); WriteStr(s);
  GotoXY(22,11); WriteStr('Number of packets:');
  GotoXY(22,12); WriteStr('Number of retries:');
  GotoXY(29,13); WriteStr('Last error:');
  GotoXY(1,25); WriteStr('Kermit:  F1=Cancel File');

  GotoXY(61,MaxY);  WriteStr('F9=Retry  F10=Abort');
END;  { MakeInfoScreen }

PROCEDURE WriteFileName;
BEGIN
  GotoXY(41,6);
  IF OriginalName <> FileName THEN
    WriteStr(Pad(OriginalName + ' as '+FileName,40))
  ELSE
    WriteStr(Pad(FileName,40));
END;

PROCEDURE WriteBytes;
BEGIN
  GotoXY(41,7); Write(Bytes);
END;

PROCEDURE WriteFileSize;
BEGIN
  GotoXY(30,8); Write('File size: ',FileMax); ClrEol;
END;  { WriteSize }

PROCEDURE WriteStatus;
BEGIN
  GotoXY(41,9); WriteStr(StatusString); ClrEol;
END;

PROCEDURE WriteTotalNr;
BEGIN
  Inc(TotalNr);
  GotoXY(41,11); Write(TotalNr);
END;  { WriteTotalNr }

PROCEDURE WriteFeilNr;
BEGIN
  Inc(FeilNr);              {Auto-Increment FeilNr}
  GotoXY(41,12); Write(FeilNr);
END;

PROCEDURE WriteError;
BEGIN
  GotoXY(41,13); WriteStr(Pad(ErrorString,57));
  RS_ClrBuffer(CurComPort);
END;

PROCEDURE ZeroBytes;
BEGIN
  Bytes := 0;
  GotoXY(41,7); ClrEol;
END;

PROCEDURE AddBytes(n : WORD);
BEGIN
  Bytes := Bytes + n;
  WriteBytes;
END;                                   {AddBytes}

PROCEDURE SendPacket(PakkeNr : CarNum; typ : PakkeCh; st : String);
BEGIN
  MakePakke(TX_Pac^, pakkenr, typ, st);
  SendPakke;
END;                         { SendPacket }

PROCEDURE SendAbort(s : String);
BEGIN
  ErrorString := s;
  WriteError;
  SendPacket(PakkeNr,'E',s);
END;                         { SendAbort }

PROCEDURE MakeNextData; FORWARD;

TYPE KermitState = (Abort, Complete, SendInit, SendName,
                    SendAttr, SendData, SendEOF,
                    SendEnd, WaitInit, WaitName, WaitData, TimeOut);

PROCEDURE SendAndGet(VAR s : KermitState; OkState : KermitState;
                         data : BOOLEAN);
VAR Ferdig : BOOLEAN;
    nr : WORD;
BEGIN
  RetryNr := 0; Ferdig := FALSE;
  REPEAT
    SendPakke;
    IF data THEN
      MakeNextData;
    GetPakke;
    WITH RX_Pac^ DO BEGIN
      nr := Ord(pnr) - 32;
      IF ((ptype = 'Y') AND (nr = PakkeNr)) OR
         ((ptype = 'N')) AND (nr = Succ(PakkeNr) AND 63) THEN BEGIN
        Ferdig := TRUE;
        s := OkState;
        PakkeNr := Succ(PakkeNr) AND 63;
        WriteTotalNr;
      END
      ELSE IF (ptype IN ['N','T']) OR (ptype = TX_Pac^.ptype) THEN BEGIN
        Inc(RetryNr);
        WriteFeilNr;
        Warning(ptype+'-packet received!');
        IF RetryNr >= RetryLimit THEN BEGIN
          Ferdig := TRUE;
          s := Abort;
          SendAbort('Too many retries!');
        END;
      END
      ELSE IF ptype = 'E' THEN BEGIN
        Ferdig := TRUE;
        s := Abort;
        Extract(ErrorString);
        WriteError;
      END
      ELSE IF (nr = PakkeNr) OR (nr = Succ(PakkeNr) AND 63) THEN BEGIN
        SendAbort('Wrong packet type: '+ptype);
        ptype := 'E';
        Ferdig := TRUE;
        s := Abort;
      END;
    END;
  UNTIL Ferdig;
  IF s = Abort THEN ErrorLevel := 2;
END;                         { SendAndGet }

CONST
      Reserved1Bit = 32;
      Reserved2Bit = 16;
      A_PacketBit  =  8;
      WindowBit    =  4;
      LongPakkeBit =  2;

      BinaryDataBit= 32;

PROCEDURE MakeInitPacket(Ptyp : PakkeCh);
VAR s : String;
    b : BYTE;
BEGIN
  s := Pad('',14);
  IF LongMaxLength < 95 THEN BEGIN
    s[1] := Chr(32 + (LongMaxLength));
    LongPakke := FALSE;
  END
  ELSE
    s[1] := '~';
  IF Ptyp = 'Y' THEN
    IF Abs(YourTimeOut-MyTimeOut) < 2 THEN
      MyTimeOut := YourTimeOut - 2
  ELSE
    AttrPakke := TRUE;
  s[2] := Chr(32 + (MyTimeOut));
  s[3] := Chr(32 + (MyPad));
  s[4] := Chr(64 XOR Ord(MyPadChar));
  s[5] := Chr(32 + (Ord(MyCR)));
  s[6] := MyQCtrlChar;
  s[7] := Q8BitChar;
  IF (Ptyp = 'S') AND (CurBits=8) THEN
    s[7] := 'Y'
  ELSE IF (Ptyp = 'Y') AND NOT Q8Bit THEN
    s[7] := 'N';
  s[8] := Chr(FileCheck+48);
  s[9] := QrepChar;

  b := A_PacketBit + 1;
  IF LongPakke THEN BEGIN
    b := b OR LongPakkeBit;
    s[13] := Chr(32 + (LongMaxLength DIV LenModulo));
    s[14] := Chr(32 + (LongMaxLength MOD LenModulo));
  END;
  IF WindowData THEN BEGIN
    b := b OR WindowBit;
    s[12] := Chr(32 + WinSize);
  END;
  s[10] := Chr(b+32);
  b := 0;
  IF BinaryData THEN b := BinaryDataBit;
  s[11] := Chr(b+32);
  MakePakke(TX_Pac^, 0, ptyp, s);
END;                         { MakeInitPacket }

PROCEDURE TolkInitPacket;
VAR c, l, w, a2 : INTEGER;
    s    : String;
BEGIN
  Extract(s);
  s := Pad(s,30);
  YourMaxLength := Ord(s[1]) - 32;
  IF s[2] > ' ' THEN YourTimeOut := -32 + Ord(s[2]);
  IF RX_Pac^.ptype <> 'Y' THEN
    IF Abs(YourTimeOut-MyTimeOut) < 2 THEN
      MyTimeOut := YourTimeOut - 2;
  YourPad := -32 + Ord(s[3]);
  YourPadChar := Chr(64 XOR Ord(s[4]));
  IF s[5] > ' ' THEN YourCR := Chr(Ord(s[5]) - 32);
  IF s[6] > ' ' THEN YourQCtrlChar := s[6];
  IF s[7] IN ['!'..'>',#96..'~'] THEN BEGIN
    Q8bitChar := s[7];
    Q8bit := TRUE;
  END
  ELSE Q8bit := (s[7] = 'Y') AND (CurBits=7);
  CASE s[8] OF
    '2' : FileCheck := 2;
    '3' : FileCheck := 3;
    ELSE
      FileCheck := 1;
  END;
  Qrep := s[9] = QrepChar;
  IF Qrep THEN maxrep := 94 ELSE maxrep := 1;
  c := Ord(s[10]) - 32;
  a2 := 0;
  IF Odd(c) THEN a2 := Ord(s[11]) - 32;
  l := 10;
  WHILE Odd(Ord(s[l])) DO Inc(l);         {skip all other attribute bits}
  WindowData := WindowData AND (c AND WindowBit <> 0);
  IF WindowData THEN BEGIN
    WinSize := Ord(s[l+1]) - 32;      {We can accept any size up to 31}
    WindowData := WinSize > 1;
  END;
  LongPakke := LongPakke AND (c AND LongPakkeBit <> 0) AND NOT WindowData;
  AttrPakke := AttrPakke AND (c AND A_PacketBit <> 0);
  IF LongPakke THEN BEGIN
    l := (Ord(s[l+2]) - 32) * LenModulo + Ord(s[l+3]) - 32;
    IF l = 0 THEN
      LongMaxLength := 500
    ELSE IF l < LongMaxLength THEN
      LongMaxLength := l;
  END;
  BinaryData := BinaryData AND (a2 AND BinaryDataBit <> 0);
END;                                   {TolkInitPacket}

PROCEDURE XmitAttr(VAR state : KermitState);
VAR siz : String[12];
BEGIN
  UnPackTime(DTA.Time,FTime);

  Str((FileMax + 1023) DIV 1024:1,st);
  Str(FileMax:1,siz);
  st := '#/861124 14:56:30!'+Chr(32+Length(st))+
        st+'1'+Chr(32+Length(siz))+siz;

  ByteToDigits(FTime.year MOD 100,st[3]);
  ByteToDigits(FTime.month,st[5]);
  ByteToDigits(FTime.day,st[7]);
  ByteToDigits(FTime.hour,st[10]);
  ByteToDigits(FTime.min,st[13]);
  ByteToDigits(FTime.sec,st[16]);

  MakePakke(TX_Pac^, PakkeNr,'A',st);
  SendAndGet(state,SendData,FALSE);
  IF (state = SendData) THEN BEGIN
    Extract(st);
    IF (Length(st) > 0) AND (st[1] = 'N') THEN BEGIN
      StopFile := TRUE;
      state := SendEOF;
    END;
  END;
END;

PROCEDURE XmitEOF(VAR s : KermitState);
BEGIN
  Inc(TotalBytes,FilePos(fil));
  Close(fil);
  Debug('Enter XmitEOF');
  IF StopFile THEN BEGIN
    MakePakke(TX_Pac^, PakkeNr,'Z','D');
    Warning(FileName+' discarded!');
  END
  ELSE
    MakePakke(TX_Pac^, PakkeNr,'Z','');
  SendAndGet(s,SendName,FALSE);
END;                         { XmitEOF }

PROCEDURE XmitEnd(VAR s : KermitState);
BEGIN
  MakePakke(TX_Pac^, PakkeNr,'B','');
  SendAndGet(s,Complete,FALSE);
END;                         { XmitEnd }

TYPE STRING3 = RECORD
                 CASE BOOLEAN OF
                   FALSE: (st : STRING[3]);
                   TRUE:  (p  : Pointer);
               END;

VAR CodeTab : ARRAY [CHAR] OF STRING3;

PROCEDURE MakeCodeTab;
TYPE Str3Ptr = ^String3;
VAR lch, ch : CHAR;
    b       : WORD;
    CodePtr : Str3Ptr;
    st      : ARRAY [0..3] OF CHAR;
    len     : BYTE ABSOLUTE st;
BEGIN
  CodePtr := @CodeTab;
  FOR b := 0 TO 255 DO BEGIN
    ch := Chr(b);
    lch := Chr(b AND 127);
    len := 0;
    IF (ch > #127) AND Q8Bit THEN BEGIN
      len := 1;
      st[1] := Q8BitChar;
      ch := lch;
    END;
    IF (Succ(b) AND 127) <= 32 THEN BEGIN
      Inc(len);
      st[len] := YourQCtrlChar;
      ch := Chr(64 XOR Ord(ch));
    END
    ELSE IF ((lch = Q8BitChar) AND Q8Bit) OR ((lch = QrepChar) AND Qrep) OR
       (lch = YourQCtrlChar) THEN BEGIN
      Inc(len);
      st[len] := YourQCtrlChar;
    END;
    Inc(len);
    st[len] := ch;

    CodePtr^ := String3(st);
    Inc(Word(CodePtr),SizeOf(String3));
  END;
END;                                   {MakeCodeTab}

PROCEDURE MakeDataPac(VAR p : PakkeType);
LABEL Avbryt;
VAR ch : CHAR;
    st : STRING[3];
    pst : Pointer ABSOLUTE st;
    n, max, databytes : WORD;
    dptr : ^CHAR;
BEGIN
  p.ptype := 'D';
  p.pnr := Chr(32 + PakkeNr);
  dptr := @p.pdata[1];
  IF LongPakke THEN BEGIN
    Inc(Word(dptr),3);                 {Skip over long header}
    max := LongMaxLength - 7 - CheckType;
    p.long := TRUE;
  END
  ELSE BEGIN
    max := YourMaxLength - 7 - CheckType;
    p.long := FALSE;
  END;

  databytes := 0;
  IF EndOfFile THEN GOTO Avbryt;

  IF BinaryData THEN BEGIN
    Inc(max,4);
    IF BufCount < max THEN BEGIN
      IF BufCount > 0 THEN BEGIN
        Move(BufPtr^,dptr^,BufCount);
        Inc(Word(dptr),BufCount);
        Inc(databytes,BufCount);
        Dec(max,BufCount);
      END;

      BlockRead(fil,buffer^,BufSize,BufCount);

      IF (IOresult <> 0) OR (BufCount = 0) THEN BEGIN
        EndOfFile := TRUE;
        GOTO Avbryt;
      END;
      BufferPtr(BufPtr) := Buffer;
      IF max > BufCount THEN max := BufCount;
    END;
    Move(BufPtr^,dptr^,max);
    Inc(Word(BufPtr),max);
    Dec(BufCount,max);
    Inc(Word(dptr),max);
    Inc(databytes,max);
    GOTO Avbryt;
  END;

  max := Ofs(p.pdata[max]);

  REPEAT
    IF BufCount = 0 THEN BEGIN
      StopLink;
      BlockRead(fil,buffer^,BufSize,BufCount);
      StartLink;
      IF (IOresult <> 0) OR (BufCount = 0 ) THEN BEGIN
        EndOfFile := TRUE;
        GOTO AvBryt;
      END;
      BufferPtr(BufPtr) := Buffer;
      buffer^[BufCount] := Chr(NOT Ord(buffer^[BufCount - 1]));  {guard!}
    END;
    ch := BufPtr^;
    n := 1;
    Inc(Word(BufPtr));
    Dec(BufCount);
    WHILE (ch = BufPtr^) AND (n < MaxRep) DO BEGIN
      Inc(n);
      Inc(Word(BufPtr));
      Dec(BufCount);
    END;
    IF TextFile THEN BEGIN
      ch := UtConvert[ch];
      IF ch = ^Z THEN BEGIN
        EndOfFile := TRUE;
        Goto Avbryt;
      END;
    END;
    Inc(databytes,n);
    pst := CodeTab[ch].p;   {st := CodeTab[ch].st;}
    IF (n = 2) AND (st[0] = #1) THEN BEGIN
      dptr^ := st[1];
      Inc(Word(dptr));
      dptr^ := st[1];  {repeat 2 times!}
      Inc(Word(dptr));
    END
    ELSE BEGIN
      IF n >= 2 THEN BEGIN
        dptr^ := QrepChar;
        Inc(Word(dptr));
        dptr^ := Chr(n+32);
        Inc(WORD(dptr));
      END;

      dptr^ := st[1];
      Inc(WORD(dptr));
      IF st[0] > #1 THEN BEGIN
        dptr^ := st[2];
        Inc(WORD(dptr));
        IF st[0] > #2 THEN BEGIN
          dptr^ := st[3];
          Inc(WORD(dptr));
        END;
      END;
    END;
  UNTIL Word(dptr) >= max;
Avbryt:
  IF databytes = 0 THEN
    p.TotLen := 0
  ELSE BEGIN
    AddBytes(databytes);
    p.TotLen := Word(dptr) - Ofs(p.plen) + CheckType;
  END;
END;                                   {MakeDataPac}

PROCEDURE MakeNextData;
BEGIN
  IF NOT Next_Data_OK AND (CurBaud < 30000) THEN BEGIN
    MakeDataPac(Next_Pac^);
    Next_Data_OK := TRUE;
  END;
END;

PROCEDURE MakeData;
VAR temp : PakkeTypePtr;
BEGIN
  IF Next_Data_OK THEN BEGIN
    temp := TX_Pac;
    TX_Pac := Next_Pac;
    Next_Pac := temp;

    TX_Pac^.pnr := Chr(32 + PakkeNr);
    Next_Data_OK := FALSE;
  END
  ELSE
    MakeDataPac(TX_Pac^);
END;                         { MakeData }

PROCEDURE Ack(PakkeNr : WORD);
BEGIN
  SendPacket(PakkeNr,'Y','');
END;

PROCEDURE Nack(PakkeNr : WORD);
BEGIN
  SendPacket(PakkeNr,'N','');
END;

VAR state : KermitState;
    NackedNr : WORD;
    RX_Start : BOOLEAN;

PROCEDURE InitLesPakke;
BEGIN
  StartTimerSek(t2,YourTimeOut);
  RX_Start := TRUE;
END;

PROCEDURE LesPakke(VAR RX: PakkeType; VAR ok : BOOLEAN);
LABEL Ferdig, Init;
VAR bytes, n : WORD;
    buf : ARRAY [-3..100] OF CHAR ABSOLUTE RX;
BEGIN
  ok := FALSE;
  WITH RX DO BEGIN
    IF Retry <> r_ok THEN BEGIN
      IF r_code = r_timeout THEN
        MakePakke(RX,nut,'T','T')
      ELSE IF r_code = r_keyboard THEN
        MakePakke(RX,nut,'T','K')
      ELSE
        MakePakke(RX,nut,'E','F10');
      ok := TRUE;
      GOTO Init;
    END;
    IF RX_Start THEN BEGIN
      n := 100;
      REPEAT
        Dec(n);
        IF n = 0 THEN Exit;
        RS_ReadBlock(plen,96,bytes,CurComPort);
        IF bytes = 0 THEN Exit;
        Inc(ReceiveBytes,bytes);
      UNTIL plen = MySOH;
      RX_Start := FALSE;
      TotLen := 0;
      plen := '~';
    END;
    REPEAT
      RS_ReadBlock(buf[TotLen],96-TotLen,bytes,CurComPort);
      IF bytes = 0 THEN BEGIN
        IF TotLen > Ord(plen) - 32 THEN GOTO Ferdig;
        Exit;
      END;
      Inc(ReceiveBytes,bytes);
      IF NOT BinaryData AND (buf[TotLen] < ' ') THEN BEGIN
        IF buf[TotLen] = MyCR THEN GOTO Ferdig;
        IF buf[TotLen] = MySOH THEN BEGIN
          TotLen := 0;
          plen := '~';
        END;
        Exit;
      END;
      Inc(TotLen,bytes);
    UNTIL TotLen > 100;

  Ferdig:
    ok := TestPakke(RX) AND (TotLen < 96) AND NOT RX.long;
$IFDEF DEBUG
    IF LogFileMode = LogAll THEN BEGIN
      LogChar('<');
      FOR n := 0 TO Pred(TotLen) DO
        LogChar(buf[n]);
      LogChar('>');
    END;
$ENDIF
  Init:
    InitLesPakke;
  END;
END;                                   {LesPakke}

PROCEDURE TrySend;
BEGIN
  IF RS_Room(CurComPort) < 4000 THEN Exit; { >1 packet already in pipeline}
  IF NackedNr = 0 THEN BEGIN
    IF (ninn-nut) AND 63 < WinSize THEN BEGIN
      IF EndOfFile THEN BEGIN
{        IF nut = ninn THEN
        Debug('File completed'); }
        Exit;            {No more Data packets}
      END;
      PakkeNr := ninn;
      WITH pw[ninn] DO BEGIN
        MakeDataPac(dptr^);
        IF dptr^.TotLen > 0 THEN BEGIN
          SendPakkeT(dptr^);
          acknack := 0; {acked := FALSE; nacked := FALSE;}
          retry := 0;
          ninn := Succ(ninn) AND 63;
        END;
      END;
      Exit;
    END;
                                       {Window is full, see if any acked}
    IF pw[nut].retry > 0 THEN Exit;
    n := nut;
    REPEAT
      n := Succ(n) AND 63;
      IF n = ninn THEN Exit;
    UNTIL pw[n].acknack <> 0;
    SendPakkeT(pw[nut].dptr^);
    pw[nut].retry := 1;
    Exit;
  END
  ELSE BEGIN  {NackedNr > 0}
    n := nut;
    Dec(NackedNr);
    WHILE NOT pw[n].nacked DO BEGIN
      n := Succ(n) AND 63;
      IF n = ninn THEN BEGIN
        Warning('No NACK');
        Exit;
      END;
    END;
    SendPakkeT(pw[n].dptr^);
    pw[n].nacked := FALSE;
  END;
END;                                   {TrySend}

PROCEDURE DoPakke;
VAR msg : String;
BEGIN
  WITH RX_Pac^ DO BEGIN
    IF EndOfFile THEN Debug('EOF - '+Tstr((ninn-nut) AND 63,1));
    WriteTotalNr;
    nr := -32 +Ord(pnr);                  {Position in circular buffer}
    n := (nr - nut) AND 63;            {Offset from first packet}

    Extract(msg);

    IF ptype = 'T' THEN BEGIN
      RS_Enable(CurComPort);
      WriteFeilNr;
      WITH pw[nut] DO BEGIN
        IF NOT nacked THEN BEGIN
          Inc(NackedNr);
          nacked := TRUE;
        END;
      END;
      Inc(RetryNr);
      IF RetryNr > 10 THEN BEGIN
        SendAbort('Too many retries!');
        state := Abort;
      END;
      Exit;
    END;

    RetryNr := 0;

    IF ptype = 'Y' THEN BEGIN
      IF msg = 'X' THEN BEGIN
        StopFile := TRUE;
        state := SendEOF;
      END;
      IF n >= (ninn-nut) AND 63 THEN BEGIN
        Debug('ACK outside');
        Exit;    {ACK outside of window}
      END;
      WITH pw[nr] DO BEGIN
        acked := TRUE;
        IF nacked THEN BEGIN
          Dec(NackedNr);
          nacked := FALSE;
        END;
      END;
      WHILE pw[nut].acked DO BEGIN
        nut := Succ(nut) AND 63;
        IF ninn = nut THEN BEGIN
          IF EndOfFile THEN BEGIN
            state := SendEOF;
            Debug('Exit TrySend');
          END;
          Exit;
        END;
      END;
      Exit;
    END;
    IF ptype = 'N' THEN BEGIN
      RS_Enable(CurComPort);
      IF n >= (ninn-nut) AND 63 THEN BEGIN {NACK outside window}
        Debug('NACK outside');
        IF nut = ninn THEN BEGIN
          Debug('Window empty');
          Exit;
        END;
        nr := nut
      END;
      WriteFeilNr;
      WITH pw[nr] DO BEGIN
        Inc(retry);
        IF retry > 10 THEN BEGIN
          SendAbort('Too many retries!');
          state := Abort;
          Exit;
        END;
        NackedNr := Succ(NackedNr) - Ord(nacked);
        nacked := TRUE;
      END;
      Exit;
    END;
    IF ptype = 'E' THEN BEGIN
      Extract(ErrorString);
      IF ErrorString <> 'F10' THEN
        WriteError;
      state := Abort;
      Exit;
    END;
    SendAbort('Unexpected packet type: '+ptype);
    state := Abort;
  END;
END;

PROCEDURE SendWindow;
VAR done : BOOLEAN;
    i : WORD;
BEGIN
  NackedNr := 0;
  InitLesPakke;
  InitWindow;
  REPEAT
    TrySend;
    FOR i := 1 TO 4 DO BEGIN
      LesPakke(RX_Pac^,done);          {Bad packet will be ignored}
      IF done THEN DoPakke;
    END;
    DumpPointers;
    IF StopFile AND (state<>Abort) THEN state := SendEOF;
  UNTIL state IN [SendEOF,Abort];
{
  IF state = SendEOF THEN
    Debug('Exit SendEOF')
  ELSE
    Debug('Exit Abort');
}
  PakkeNr := ninn;
END;

PROCEDURE SendManyFiles(FilePattern : String);
VAR ok, server : BOOLEAN;
    po : INTEGER;
    fn : String;
BEGIN
  server := FilePattern <> '';
  IF NOT server THEN BEGIN
    ReadFileName('File(s) to send: ',FilePattern);
    IF FilePattern = '' THEN Exit;
  END;

  IF Pos('.',FilePattern) = 0 THEN
    FilePattern := FilePattern + '.';
  FindFirst(FilePattern,0,DTA);
  ok := DosError = 0;
  IF NOT ok THEN BEGIN
    Error('No files found!');
    Exit;
  END;

  FileName := DTA.Name;

    po := Ord(FilePattern[0]);
    WHILE po > 0 DO BEGIN
      IF FilePattern[po] IN ['\',':'] THEN BEGIN
        Delete(FilePattern,po+1,30);
        po := 0;
      END;
      Dec(po);
    END;
    IF po = 0 THEN FilePattern[0] := #0;
    state := SendInit;
    ShowTimeOut := TRUE;
    PakkeNr := 0;
    FeilNr := 0;
    TotalNr := 0;
    LastNr := 63;
    MakeInfoScreen('  Sending:');
    StatusString := 'Init';
    WriteStatus;
    InitStat;
    RS_ClrBuffer(CurComPort);
    REPEAT
      CASE state OF
        SendData : BEGIN
                     IF WindowData THEN SendWindow
                     ELSE BEGIN
                       MakeData;
                       IF StopFile OR (TX_Pac^.TotLen = 0) THEN
                         state := SendEOF
                       ELSE BEGIN
                         SendAndGet(state,SendData,TRUE);
                         IF state=Abort THEN BEGIN
                           Close(fil);
                         END
                         ELSE IF (RX_Pac^.TotLen > 4) AND
                                 (RX_Pac^.pdata[1] = 'X') THEN BEGIN
                           StopFile := TRUE;
                           state := SendEOF;
                         END;
                       END;
                     END;
                   END;
        SendInit : BEGIN
                     MakeInitPacket('S');
                     SendAndGet(state,SendName,FALSE);
                     IF state=SendName THEN BEGIN
                       TolkInitPacket;
                       MakeCodeTab;
                       CheckType := FileCheck;
                     END;
                   END;
        SendName : BEGIN
                     fn := FilePattern + FileName + #0;
                     OriginalName := FileName;
                     Assign(fil,fn);
                     Reset(fil,1);
                     Next_Data_OK := FALSE;
                     IF IOresult = 0 THEN BEGIN
                       WriteFileName;
                       FileMax := FileSize(fil);
                       WriteFileSize;
                       Inc(FileNr);
                       MakePakke(TX_Pac^, PakkeNr,'F',FileName);
                       SendAndGet(state,SendData,FALSE);
                       IF state=SendData THEN BEGIN
                         BufCount := 0;
                         BufferPtr(BufPtr) := Buffer;
                         EndOfFile := FALSE;
                         ZeroBytes;
                         StatusString := 'In Progress';
                         WriteStatus;
                         StopFile := FALSE;
                         IF AttrPakke THEN state := SendAttr;
                       END;
                     END
                     ELSE BEGIN
                       Error('File not found: '+fn);
                       state := Abort;
                     END;
                   END;
        SendAttr : BEGIN
                     XmitAttr(state);
                     IF state = Abort THEN
                       Close(fil)
                   END;
        SendEOF  : BEGIN
                     XmitEOF (state);
                     IF state <> Abort THEN BEGIN
                       FindNext(DTA);
                       ok := DosError = 0;
                       IF ok THEN BEGIN
                         state := SendName;
                         FileName := DTA.Name;
                       END
                       ELSE
                         state := SendEnd;
                     END;
                   END;
        SendEnd  : BEGIN
                     XmitEnd(state);
                     StatusString := 'Completed!';
                     WriteStatus;
                   END;
        Abort    : BEGIN
                     StatusString := 'Aborted';
                     WriteStatus;
                     SendAbort('Too many retries!');
                     Close(fil);
                     ErrorLevel := 3;
                   END;
      END;
    UNTIL state IN [Complete,Abort];
  Bell;
  ShowStat;
END;  { SendManyFiles }

TYPE PakkeChar = 'A'..'Z';
     PakkeSet = SET OF PakkeChar;
     ReceiveType = (RecF, GetF, ServF, TextF);

VAR Ferdig, CheckSkip, ValidDate : BOOLEAN;
    Expect : PakkeSet;

PROCEDURE TestDate;
VAR old : FILE;
    newTime, oldTime : LongInt;
BEGIN
  IF OriginalName <> FileName THEN BEGIN
    Assign(old,OriginalName); Reset(old,1);
    GetFTime(old,oldTime);
    Close(old);

    PackTime(FTime,newTime);
    IF ((newTime > oldTime) AND (NewDupHandle = SkipFile)) OR
       ((newTime <= oldTime) AND (OldDupHandle = SkipFile)) THEN
      StopFile := TRUE;
  END;
  CheckSkip := TRUE;
  IF IOresult <> 0 THEN WriteStr('Test Error'^G);
END;

PROCEDURE GetFileAttr;
VAR l, st : String;
    p, feil, len : INTEGER;
BEGIN
  Extract(st);
    WHILE st[0] >= #3 DO BEGIN
      len := Ord(st[2]) - 32;
      l := Copy(st,3,len);
      CASE st[1] OF
        '!' : BEGIN GotoXY(30,8); WriteStr('File size: '+Pad(l+'k',10)); END;
        '1' : BEGIN GotoXY(30,8); WriteStr('File size: '+Pad(l,10)); END;
        '#' : BEGIN
                p := Pos(' ',l);
                Val(Copy(l,p-6,2),FTime.year,feil);
                Inc(FTime.year,1900);
                IF feil = 0 THEN Val(Copy(l,p-4,2),FTime.month,feil);
                IF feil = 0 THEN Val(Copy(l,p-2,2),FTime.day,feil);
                IF feil = 0 THEN Val(Copy(l,p+1,2),FTime.hour,feil);
                IF feil = 0 THEN Val(Copy(l,p+4,2),FTime.min,feil);
                IF (feil = 0) AND (Ord(l[0]) >= p + 8) THEN
                  Val(Copy(l,p+7,2),FTime.sec,feil);
                IF feil = 0 THEN BEGIN
                  ValidDate := TRUE;
                  TestDate;
                END;
              END;
      END;
      Delete(st,1,len+2);
    END;
END;

PROCEDURE SetFileDate;
VAR t : LongInt;
BEGIN
  IF NOT ValidDate THEN Exit;
  PackTime(FTime,t);
  SetFTime(fil,t);
END;

VAR CtrlTab : ARRAY [CHAR] OF CHAR;

PROCEDURE MakeCtrlTab;
VAR ch : CHAR;
BEGIN
  FOR ch := #0 TO #255 DO CtrlTab[ch] := ch;
  FOR ch := #$3F TO #$5F DO CtrlTab[ch] := Chr(Ord(ch) XOR 64);
  FOR ch := #$BF TO #$DF DO CtrlTab[ch] := Chr(Ord(ch) XOR 64);
END;

PROCEDURE DecodeData(VAR p : PakkeType);
VAR n, mask : BYTE;
    ch : CHAR;
    dptr : ^CHAR;
    dlen, max, databytes : WORD;
BEGIN
  IF DiskError THEN Exit;
  max := 1;
  IF p.long THEN max := 4;
  dptr := Addr(p.pdata[max]);
  max := Ofs(p.pdata[p.TotLen - 2 - CheckType]);
  databytes := 0;
  IF BinaryData THEN BEGIN
    dlen := max - Word(dptr);
    IF BufCount < dlen THEN BEGIN
      Move(dptr^,BufPtr^,BufCount);
      BlockWrite(fil,buffer^,BufSize);
      IF IOresult <> 0 THEN BEGIN
        DiskError := TRUE;
        Exit;
      END;
      Inc(Word(dptr),BufCount);
      AddBytes(BufCount);
      Dec(dlen,BufCount);
      BufferPtr(BufPtr) := Buffer;
      BufCount := BufSize;
    END;
    Move(dptr^,BufPtr^,dlen);
    Inc(Word(BufPtr),dlen);
    Dec(BufCount,dlen);
    AddBytes(dlen);

    Exit;
  END;

  REPEAT
    ch := dptr^; Inc(WORD(dptr));
    n := 1;
    IF ch = RepQ THEN BEGIN
      n := BYTE(dptr^) - 32; Inc(WORD(dptr));
      ch := dptr^; Inc(WORD(dptr));
    END;
    mask := 0;
    IF ch = Bit8Q THEN BEGIN
      mask := $80;
      ch := dptr^; Inc(WORD(dptr));
    END;
    IF ch = YourQCtrlChar THEN BEGIN
      ch := CtrlTab[dptr^]; Inc(WORD(dptr));
    END;

    ch := CHAR(BYTE(ch) OR mask);

    IF TextFile THEN ch := InnConvert[ch];
    Inc(databytes,n);

    REPEAT
      BufPtr^ := ch;
      Inc(Word(BufPtr));
      Dec(BufCount);
      IF BufCount = 0 THEN BEGIN
        StopLink;
        BlockWrite(fil,buffer^,BufSize);
        StartLink;
        BufferPtr(BufPtr) := Buffer;
        BufCount := BufSize;
        IF IOresult <> 0 THEN BEGIN
          DiskError := TRUE;
          Exit;
        END;
      END;
      Dec(n);
    UNTIL n = 0;
  UNTIL WORD(dptr) >= max;
  AddBytes(databytes);
END;                                   {DecodeData}

PROCEDURE EOF_Packet;
VAR EraseFile : BOOLEAN;
    old, bak : FILE;
    Bak_file : String[64];
    punkt : INTEGER;
    oldTime, newTime : LongInt;
BEGIN
  Extract(st);
  IF BufCount < BufSize THEN BlockWrite(fil,Buffer^,BufSize-BufCount);
  SetFileDate;
  Inc(TotalBytes,FilePos(fil));
  Close(fil);
  IF (st = 'D') OR StopFile THEN BEGIN
    Erase(fil);
    Warning(Filename+' skipped!');
  END
  ELSE BEGIN
    IF OriginalName <> FileName THEN BEGIN
      Assign(old,OriginalName); Reset(old,1);
      IF ValidDate THEN BEGIN
        GetFTime(old,oldTime);
        PackTime(FTime,newTime);
        EraseFile := ((newTime>oldTime) AND (NewDupHandle=OverWriteFile)) OR
                    ((newTime<=oldTime) AND (OldDupHandle=OverWriteFile));
      END
      ELSE BEGIN
        EraseFile := DupHandle = OverWriteFile;
      END;
      Close(old);
      IF EraseFile THEN BEGIN
        punkt := Pos('.',OriginalName);
        IF punkt = 0 THEN punkt := Length(OriginalName)+1;
        BAK_file := Copy(OriginalName,1,punkt-1) + '.BAK';
        IF (OriginalName <> BAK_File) THEN BEGIN
          IF Exist(BAK_File) THEN BEGIN
            Assign(bak,BAK_File);
            Erase(bak);
          END;
          Rename(old,BAK_File);
          Rename(fil,OriginalName);
          Warning(FileName+' renamed to '+OriginalName);
        END;
      END;
    END;
  END;
  IF IOresult=0 THEN
    Ack(PakkeNr)
  ELSE BEGIN
    SendAbort('File close error!');
    Ferdig := TRUE;
  END;
  Expect := ['B','F'];
  StatusString := 'File Closed';
  WriteStatus;
END;

PROCEDURE TestPacketNr(VAR ok : BOOLEAN);
VAR i, j : WORD;
BEGIN
  ok := FALSE;
  n := (nr - nut) AND 63;
  IF n < (ninn-nut) AND 63 THEN BEGIN
    ok := n < WinSize;                 {Retransmitted packet}
    Exit;
  END;
  i := (nr - ninn) AND 63;             {Packets past last}
  IF i >= WinSize THEN Exit;           {Outside of max send window}
  FOR j := 0 TO i DO BEGIN
    IF (ninn-nut) AND 63 = WinSize THEN BEGIN
      IF NOT pw[nut].acked THEN BEGIN
        SendAbort('Window overflow!');
        ferdig := TRUE;
        Exit;
      END;
      DecodeData(pw[nut].dptr^);
      nut := Succ(nut) AND 63;
    END;
    WITH pw[ninn] DO BEGIN
      retry := 0;
      acked := FALSE;
      IF j < i THEN BEGIN
        Nack(ninn);
        retry := 1;
      END;
    END;
    ninn := Succ(ninn) AND 63;
  END;
  ok := TRUE;
END;                                   { TestPacketNr }

PROCEDURE WindowReceive;
VAR ok : BOOLEAN;
BEGIN                                  { RX_Pac has the first data packet }
  InitWindow;
  REPEAT
   DumpPointers;
   WITH RX_Pac^ DO BEGIN
    nr := -32 +Ord(pnr);
    CASE ptype OF
      'T' : BEGIN
        Inc(RetryNr);
        WriteFeilNr;
        IF RetryNr > 10 THEN BEGIN
          SendAbort('Too many timeouts!');
          Ferdig := TRUE;
          Exit;
        END;
        n := nut;
        WHILE pw[n].acked AND (n <> ninn) DO n := Succ(n) AND 63;
        IF (n <> ninn) OR (pdata[1] <> 'P') THEN
          Nack(n);                         { Most wanted packet nr! }
        RS_Enable(CurComPort);
      END;
      'E' : BEGIN
        Extract(ErrorString);
        IF ErrorString <> 'F10' THEN WriteError;
        IF ErrorLevel < 2 THEN ErrorLevel := 2;
        Ferdig := TRUE;
        Exit;
      END
      ELSE BEGIN
        RetryNr := 0;
        IF ptype = 'Z' THEN BEGIN
          Extract(st);
          IF st <> 'D' THEN BEGIN
            WHILE nut <> ninn DO BEGIN
              IF NOT pw[nut].acked THEN BEGIN
                SendAbort('No ACK at EOF:'+pnr);
                Ferdig := TRUE;
                Exit;
              END;
              DecodeData(pw[nut].dptr^);
              nut := Succ(nut) AND 63;
              DumpPointers;
            END;
          END;
          PakkeNr := nr;
          EOF_Packet;
          Exit;
        END;
        IF StopFile THEN
          SendPacket(nr,'Y','X')
        ELSE IF DiskError THEN BEGIN
          SendAbort('File write error!');
          ferdig := TRUE;
          Exit;
        END
        ELSE BEGIN
          TestPacketNr(ok);              {Sjekk om nr i vindu, sett n}
          IF ferdig THEN Exit;
          IF ok THEN WITH pw[nr] DO BEGIN
            IF ptype = 'D' THEN BEGIN
              IF NOT acked THEN BEGIN
                Move(RX_Pac^,dptr^,100);{Room for overhead}
                acked := TRUE;
              END
              ELSE BEGIN
                Inc(retry);
                IF retry > 10 THEN BEGIN
                  SendAbort('Too many retries!');
                  ferdig := TRUE;
                  Exit;
                END;
              END;
              Ack(nr);
            END
            ELSE BEGIN
              SendAbort('Unexpected packet type: '+ptype);
              Ferdig := TRUE;
              Exit;
            END;
          END
          ELSE BEGIN
            WriteFeilNr;
          END
        END;
      END;  {ELSE BEGIN}
    END;    {CASE ptype OF}
    GetPakke;
    WriteTotalNr;
   END;          {WITH RX_Pac^ DO}
  UNTIL FALSE;
END;                                   { WindowReceive }

PROCEDURE ReceiveFiles(GetFile : ReceiveType; GetName : String);
VAR LastPk : PakkeCh;
    state : KermitState;
    l, n : INTEGER;
    ch : CHAR;
    MainName, Ext, Path, st : String;
    ok, done : BOOLEAN;
BEGIN
  IF (GetFile=GetF) AND (GetName = '') THEN BEGIN
    ReadFileName('File(s) to Get: ',GetName);
    IF GetName[0]=#0 THEN Exit;
  END;
  RS_ClrBuffer(CurComPort);
  Expect := ['S'];
  LastPk := '@';
  PakkeNr := 0;
  TotalNr := 0;
  FeilNr  := 0;
  LastNr := 63;
  RetryNr := 0;
  Ferdig := FALSE;
  ShowTimeOut := TRUE;
  MakeInfoScreen('Receiving:');
  FileName[0] := #0;
  ErrorString[0] := #0;
  StatusString := 'Init';
  WriteStatus;
  RS_ClrBuffer(CurComPort);
  DiskError := FALSE;
  IF GetFile=GetF THEN BEGIN
    MakeInitPacket('I');
    SendAndGet(state,Complete,FALSE);
    IF state=Complete THEN
      TolkInitPacket;
    SendPacket(0,'R',GetName);
  END;
  PakkeNr := 0;

  IF GetFile<>ServF THEN
    GetPakke;

  InitStat;
  REPEAT
    WITH RX_Pac^ DO BEGIN
      IF ptype = 'T' THEN BEGIN
        Inc(RetryNr);
        IF RetryNr <= RetryLimit THEN BEGIN
          WriteFeilNr;
          Nack(PakkeNr);
        END
        ELSE BEGIN
          SendAbort('Too many retries!');
          Ferdig := TRUE;
          ErrorLevel := 1;
        END;
      END
      ELSE BEGIN
        RetryNr := 0;
        IF (pnr = Chr(32 + PakkeNr)) AND (ptype IN Expect) THEN BEGIN
          CASE ptype OF
            'D' :
            BEGIN
              IF NOT CheckSkip THEN BEGIN
                IF OriginalName <> FileName THEN
                  StopFile := DupHandle = SkipFile;
                CheckSkip := TRUE;
              END;
              IF WindowData THEN
                WindowReceive
              ELSE IF StopFile THEN
                SendPacket(PakkeNr,'Y','X')
              ELSE IF DiskError THEN
                SendAbort('File write error!')
              ELSE BEGIN
                IF NOT DiskStopInt THEN Ack(PakkeNr);
                Expect := ['D','Z'];
                DecodeData(RX_Pac^);
                IF DiskStopInt THEN Ack(PakkeNr);
              END;
            END;
            'S' : BEGIN
                    TolkInitPacket;
                    RepQ := #0;
                    IF Qrep THEN RepQ := QrepChar;
                    Bit8Q := #0;
                    IF Q8bit THEN Bit8Q := Q8bitChar;
                    MakeInitPacket('Y');
                    SendPakke;
                    CheckType := FileCheck;
                    IF GetFile = TextF THEN
                      Expect := ['X']
                    ELSE
                      Expect := ['F'];
                    StatusString := 'GetFileName';
                    WriteStatus;
                    MakeCtrlTab;
                  END;
            'X' :
            BEGIN
              FileName := 'CON'; OriginalName := FileName;
              Assign(fil,'KERMIT.$$$');
              ReWrite(fil,1);
              IF IOresult<>0 THEN BEGIN
                SendAbort('Cannot Create File!');
                Ferdig := TRUE;
              END
              ELSE BEGIN
                CheckSkip := FALSE;
                ValidDate := FALSE;
                BufferPtr(BufPtr) := Buffer;
                BufCount := BufSize;
                Expect := ['A','D','Z'];
                StatusString := 'In progress';
                WriteStatus;
                WriteFileName;
                ZeroBytes;
                StopFile := FALSE;
                Ack(PakkeNr);
                LongReply := TRUE;
              END;
            END;
            'F' :
            BEGIN
              Inc(FileNr);
              Extract(FileName);
              FOR l := 1 TO Ord(FileName[0]) DO
                IF NOT (FileName[l] IN FileNameSet) THEN
                  FileName[l] := 'X';
              Ext := '.';
              MainName[0] := #0;
              Path[0] := #0;
              IF Pos(':',FileName) = 2 THEN BEGIN
                Path := Copy(FileName,1,2);
                IF NOT (Path[1] IN ['A'..'Z']) THEN Path[0] := #0;
                Delete(FileName,1,2);
              END;
              l := Ord(FileName[0]);
              WHILE l > 0 DO BEGIN
                IF FileName[l] = '.' THEN BEGIN
                  IF Ext = '.' THEN BEGIN
                    Ext := Copy(FileName,l,4);
                    FileName := Copy(FileName,1,Pred(l));
                  END
                  ELSE
                    FileName[l] := 'X';
                END
                ELSE IF FileName[l] = '\' THEN BEGIN
                  Path := Path + Copy(FileName,1,l);
                  Delete(FileName,1,l);
                  l := 0;
                END
                ELSE IF FileName[l] = ':' THEN
                  FileName[l] := 'X';
                Dec(l);
              END;
              IF FileName[0] > #8 THEN FileName[0] := #8;
(*
              IF Path = '' THEN BEGIN
                Path := DownLoadPath;
                IF Path[Length(Path)] <> '\' THEN
                  Path := Path + '\';
              END;
*)
              OriginalName := Path+FileName+Ext;

              MainName := Copy(FileName+'________',1,8);
              l := 1;
              FileName := OriginalName;

              WHILE Exist(FileName) AND (l<100) DO BEGIN
                MainName[8] := Chr(l MOD 10 + 48);
                IF l>9 THEN MainName[7] := Chr(l DIV 10 + 48);
                FileName := MainName+Ext;
                Inc(l);
              END;
              IF Exist(FileName) THEN BEGIN
                SendAbort('Existing File!');
                Ferdig := TRUE;
              END
              ELSE BEGIN
                Assign(fil,FileName);
                ReWrite(fil,1);
                IF IOresult<>0 THEN BEGIN
                  SendAbort('Cannot Create File!');
                  Ferdig := TRUE;
                END
                ELSE BEGIN
                  CheckSkip := FALSE;
                  ValidDate := FALSE;
                  BufferPtr(BufPtr) := Buffer;
                  BufCount := BufSize;
                  Expect := ['A','D','Z'];
                  StatusString := 'In progress';
                  WriteStatus;
                  WriteFileName;
                  ZeroBytes;
                  StopFile := FALSE;
                  Ack(PakkeNr);
                END;
              END;
              LongReply := FALSE;
            END;
            'A' : BEGIN
                    GetFileAttr;
                    IF StopFile THEN
                      SendPacket(PakkeNr,'Y','N')
                    ELSE
                      Ack(PakkeNr);
                  END;
            'Z' : EOF_Packet;
            'B' : BEGIN
                    Ack(PakkeNr);
                    Ferdig := TRUE;
                    StatusString := 'Completed';
                    WriteStatus;
                  END;
          END;  { CASE }
          LastPk := ptype;
          LastNr := PakkeNr;
          PakkeNr := Succ(PakkeNr) AND 63;
          RetryNr := 0;
          WriteTotalNr;
        END
        ELSE IF (pnr = Chr(32 + LastNr)) AND (ptype = LastPk) THEN BEGIN
          Inc(RetryNr);
          WriteFeilNr;
          IF RetryNr > RetryLimit THEN BEGIN
            SendAbort('Too many retries!');
            Ferdig := TRUE;
          END
          ELSE BEGIN
            IF ptype = 'S' THEN BEGIN
              MakeInitPacket('Y');
              SendPakke;
            END
            ELSE
              Ack(LastNr);
          END;
        END
        ELSE IF ptype = 'E' THEN BEGIN
          Extract(ErrorString);
          IF ErrorString <> 'F10' THEN WriteError;
          IF ErrorLevel < 2 THEN ErrorLevel := 2;
          Ferdig := TRUE;
        END
        ELSE IF (ptype = 'D') AND WindowData THEN
          WindowReceive
        ELSE IF (ptype <> 'Y') AND (ptype <> 'N') AND
                (pnr <> Chr(32 + LastNr)) THEN BEGIN
          SendAbort('Wrong packet type: '+ptype);
          Ferdig := TRUE;
        END;
      END;
    END;
    IF NOT ferdig THEN
      GetPakke;
  UNTIL Ferdig;
  IF 'D' IN Expect THEN BEGIN
    Close(fil);
    IF IOresult = 0 THEN
      Erase(fil);
  END;
  Bell;
  ShowStat;
  IF LongReply THEN {ShowReply};
END;                         { ReceiveFiles }

PROCEDURE HostCommand;
BEGIN
  ClrLast;
  WriteStr('Remote Directory: ');
  SendPacket(0,'G','D');
  GetPakke;
  IF RX_Pac^.ptype = 'Y' THEN BEGIN
    Extract(st);
    IF st = '' THEN BEGIN
      ReceiveFiles(TextF,'');
    END
    ELSE BEGIN
      GotoXY(1,25);
      WriteLn(st);
    END;
    GetF10;
  END;
END;                                   {HostCommand}

PROCEDURE FinishServer;
BEGIN
  ClrLast;
  WriteStr('Logging out remote server: ');
  SendPacket(0,'G','F');
  GetPakke;
  IF RX_Pac^.ptype = 'Y' THEN BEGIN
    WriteStr('Done!');
    Delay(1000);
  END;
END;                         { FinishServer }

VAR
  StartPath : String[80];

PROCEDURE Server;
VAR FilP, FilN, st : String;
    ok, ResetTimer : BOOLEAN;
BEGIN
  ResetTimer := TRUE;
  ClrScr;
  REPEAT
    IF (ServerTime > 0) AND ResetTimer THEN BEGIN
      MaxServer.count := ServerTime * 1092;
      MaxServer.UserInt := FALSE;
      StartTimer(MaxServer);
    END;
    CheckType := 1;                          { First packet is always type 1 }
    ClrLast;
    WriteStr('Kermit  SERVER');
    GotoXY(72,MaxY); WriteStr('F10=Exit');
    PakkeNr := 0;
    GetPakke;
    ResetTimer := TRUE;
    ShowTimeOut := FALSE;
    IF RX_Pac^.pnr = ' ' THEN BEGIN
      CASE RX_Pac^.ptype OF
        'S' : ReceiveFiles(ServF,'');
        'I' : BEGIN
                TolkInitPacket;
                MakeInitPacket('Y');
                SendPakke;
              END;
        'R' : BEGIN
                Extract(FilP);
                IF FilP[0] = #0 THEN
                  ok := FALSE
                ELSE BEGIN
                  IF Pos('.',FilP) = 0 THEN FilP := FilP + '.';
                  FindFirst(FilP,0,DTA);
                  ok := DosError = 0;
                END;
                IF ok THEN
                  SendManyFiles(FilP)
                ELSE
                  SendAbort('No Files Found!');
              END;
        'T' : BEGIN
                IF ServerTimeOut THEN Nack(PakkeNr);
                ResetTimer := FALSE;
              END;
        'E' : BEGIN
                Extract(ErrorString);
                IF ErrorString = 'F10' THEN BEGIN
                  IF ErrorLevel = 0 THEN ErrorLevel := 1;
                  Exit;
                END;
                WriteError;
              END;
        'G' : BEGIN
                Extract(st);
                IF st[1] IN ['F','L'] THEN BEGIN
                  Ack(0);
                  Exit;
                END
                ELSE
                  SendAbort('Unknown Generic Command!');
              END;
        'C' : BEGIN
                Extract(st);
                IF st = '' THEN st := StartPath;
                ChDir(st);
                GetDir(0,DownLoadPath);
                IF IOresult = 0 THEN ;
                SendPacket(PakkeNr,'Y','New dir: '+DownLoadPath);
              END;
        ELSE SendAbort('Unknown Server Command!');
      END;
    END
    ELSE
      Nack(PakkeNr);
  UNTIL (ServerTime > 0) AND NOT RunningTimer(MaxServer);
END;                                   {Server}

$I Terminal

PROCEDURE Kermit;
VAR
  key : KeyType;
  heap : Pointer;
  st : String;
  i : INTEGER;
BEGIN                        { Kermit }
  Mark(heap);

  New(RX_Pac); New(TX_Pac); New(Next_Pac);

  IF MemAvail < KermitBufSize + 2048 THEN
    KermitBufSize := (MemAvail - 2048) AND $F800;

  GetMem(buffer,KermitBufSize+1);
  BufSize := KermitBufSize;

  AttrPakke := TRUE;

  YourMaxLength := 80;
  PakkeNr := 0;
  ServerTime := 0;
  PacketDelay := 0;
  r_code := r_ok;

  IF ArgC >= 1 THEN BEGIN
    ShowTimeOut := TRUE;
    CheckType := 1;

    Init_Params;

    st := ArgV[1];

    IF Pos(st,'SERVER') = 1 THEN Server
    ELSE IF (Pos(st,'SEND') = 1) AND (ArgC >= 2) THEN SendManyFiles(ArgV[2])
    ELSE IF Pos(st,'RECEIVE') = 1 THEN ReceiveFiles(RecF,'')
    ELSE IF (Pos(st,'GET') = 1) AND (ArgC >= 2) THEN ReceiveFiles(GetF,ArgV[2])
    ELSE BEGIN
      GotoXY(1,25);
      WriteLn('Usage: Kermit [SERVER] | [SEND <file>] | [RECEIVE] | [GET <file>');
      Exit;
    END;
  END
  ELSE BEGIN
    REPEAT
      ShowTimeOut := TRUE;
      CheckType := 1;

      Meny(key);

      CASE key OF
      1 : BEGIN
            SendManyFiles('');
            GetF10;
          END;
      2 : BEGIN
            ReceiveFiles(RecF,'');
            GetF10;
          END;
      3 : BEGIN
            ReceiveFiles(GetF,'');
            GetF10;
          END;
      4 : Server;
      5 : SaveParam;
      6 : HostCommand;
      7 : BEGIN
            GotoXY(1,25); WriteLn; CursorOn; Exec(FindEnv('COMSPEC='),'');
            IF DosError <> 0 THEN BEGIN
              WriteLn('EXEC error # ',DosError);
              Delay(2000);
            END;
          END;
      8 : BEGIN
            GotoXY(1,25);
            ClrEol;
            GotoXY(72,25); Write('F10-Exit');
            Window(1,18,80,24);
            ClrScr;
            CursorOn;
            Terminal;
            Window(1,1,80,25);
          END;
      9 : FinishServer;
      END;
    UNTIL key = 10;
  END;
  Release(heap);
END;                         { Kermit }

VAR
  ok : BOOLEAN;
  ch : CHAR;
  key : WORD;

CONST
  US_Tab : ARRAY [1..6] OF CHAR = '[\]{|}';
  NO_Tab : ARRAY [1..6] OF CHAR = '';

BEGIN                                  {Kermits}
  CheckBreak := FALSE;
  FileMode := 0;

  OrigText := TextAttr;
  OrigMenu := OrigText XOR 8;
  OrigField := FeltAttr;
  OrigEdit := EditAttr;

  GetDir(0,StartPath); DownLoadPath := StartPath;

  FOR ch := #0 TO #255 DO InnConvert[ch] := ch;
  UtConvert := InnConvert;
  FOR key := 1 TO 6 DO BEGIN
    InnConvert[US_Tab[key]] := NO_Tab[key];
    UtConvert[NO_Tab[key]] := US_Tab[key];
  END;

  RS_MakeBuffer($1000,0,0,0,0);        {Use same buffers for all ports!}

  MakeStr(4,5,64,LeftJ,'Current Dir: ',DownLoadPath,Addr(FileNameSet),ToUpper);

  MakeLong(10,7,6,LeftJ,'Baud: ',CurBaud,2,115200);
  MakeWord(10,8,1,LeftJ,'Bits: ',CurBits,7,8);
  MakeEnum(8,9,5,CenterJ,'Parity: ',CurParity,5,ParityStr);
  MakeWord(5,10,1,LeftJ,'Stop Bits: ',CurStop,1,2);
  MakeWord(6,11,1,LeftJ,'Com Port: ',CurComPort,1,4);

  MakeWord(32,7,4,LeftJ, 'Max Packet: ',LongMaxLength,20,9020);
  MakeWord(32,8,2,LeftJ, 'Max Window: ',WinSize,0,31);
  MakeWord(28,9,3,LeftJ, 'Packet Timeout: ',MyTimeOut,0,120);
  MakeWord(28,10,3,LeftJ,'Server Timeout: ',ServerTime,0,500);
  MakeByte(32,11,1,LeftJ,'Check Type: ',FileCheck,1,3);

  MakeBool(58,7,5,LeftJ, 'Long Packets: ',LongPakke);
  MakeBool(56,8,5,LeftJ, 'Sliding Window: ',WindowData);
  MakeEnum(61,9,4,LeftJ,  'File Type: ',TextFile,2,BinText);
  MakeEnum(62,10,3,LeftJ,  'IBM Mode: ',IBM_Mode,3,Std_IBM);
  MakeBool(60,11,5,LeftJ,'High Speed: ',BinaryData);

  MakeByte(2,13,2,LeftJ, 'Packet Start: ',BYTE(MySOH),1,31);
  MakeByte(4,14,2,LeftJ, 'Packet End: ',BYTE(MyCR),1,31);
  MakeChar(4,15,1,LeftJ, 'Ctl Prefix: ',MyQCtrlChar,NIL,0);
  MakeChar(3,16,1,LeftJ, '8bit Prefix: ',Q8bitChar,NIL,0);
  MakeChar(4,17,1,LeftJ, 'Rep Prefix: ',QrepChar,NIL,0);

  MakeEnum(34,15,10,CenterJ,' No Date: ',DupHandle,3,DupString);
  MakeEnum(34,16,10,CenterJ,'Old File: ',OldDupHandle,3,DupString);
  MakeEnum(34,17,10,CenterJ,'New File: ',NewDupHandle,3,DupString);

  MakeByte(60,13,3,LeftJ, 'Text Color: ',KermitAttr,0,255);
  MakeByte(60,14,3,LeftJ, 'Menu Color: ',MenuAttr,0,255);
  MakeByte(59,15,3,LeftJ,'Field Color: ',FieldAttr,0,255);
  MakeByte(60,16,3,LeftJ, 'Edit Color: ',EditAttr,0,255);

  MakeBool(58,17,5,LeftJ,'Direct Video: ',DirVideo);

  IF NOT GetParam THEN Halt(1);

  DirectVideo := DirVideo;
  ClrScr;        {Keep current screen colors!}

  CursorOff;
  Kermit;
  CursorOn;

  RS_Stop(CurComPort);
  ChDir(StartPath);
  GotoXY(1,25);
END.