{$IFDEF MSDOS}
{$F+,O+}
{$ENDIF}

{$I-}

Unit
  tQWK;

Interface

Uses
  tGlob,
  tMisc,
  Areas,
  MKopen,
  MainComm,
  Protocol,
{$IFNDEF WIN32}
  DOS,
{$ELSE}
  SysUtils,
  Forms,
  WApro,
  Console,
{$ENDIF}
  Resource,
  Log,
  OpCrt,
  Objects,
  BSC,
  CompSys,
  Parse;

Procedure qwkDownLoad;
Procedure qwkUpLoad;
Procedure qwkSelect;
Procedure qwkReadList;
Procedure qwkWriteList;

Var
  qwkAreas      : PNotSortedCollection;

Implementation

Type
  NdxRecord = Record
    MsgPointer  : LongInt;
    Conference  : Byte;
  End;

  tqResult = (qAborted, qOk, qNotFound);

Var
  F               : Text;
  i, oArea        : LongInt;
  oMsgArea        : tMsgArea;
  AjustLastReads  : Boolean;
  S, S1           : String;
  ID              : String [8];

Function qwkActive (Name: String; Var Num: LongInt): Boolean;
Var
  Found           : Boolean;
  j               : LongInt;

Begin
  S1 := Long2Str (Crc32Str (Name));
  Found := False;

  For j := 0 To qwkAreas^. Count-1 Do
  If S1 = PString (qwkAreas^. At (j))^ Then
  Begin
    Found := True;
    Num := j;
    Break;
  End;

  qwkActive := Found;
End;

Procedure ControlDatGen (ID, FName: PathStr);
Var
  Confs, k : LongInt;
  BinName  : PathStr;

Begin
  Assign (F, FName);
  ReWrite (F);

  If IOResult = 0 Then
  Begin
    WriteLn (F, Cnf. BBSname);
    WriteLn (F, Cnf. Location);
    WriteLn (F, 'XXX-XXX' {Cnf. Phone});
    WriteLn (F, Cnf. SysOp + ', Sysop');
    WriteLn (F, '0000' + ', ' + ID);
    WriteLn (F, StrDate + ',' + StrTime);
    WriteLn (F, R. Name); WriteLn (F); WriteLn (F, '0'); WriteLn (F, '0');

    BinName := AddBackSlash (JustPathName (Cnf. MsgAreasFile)) + 'msgarea' + tGlob. LineExt;

    If OpenMsgAreas Then
    Begin
      i := 1;
      oArea := R. MsgArea;
      oMsgArea := MsgArea;
      Confs := -1;

      While ReadMsgArea (MsgArea, i) Do
      Begin
        Inc (i);

        If Not ((MsgArea. ReadSec > R. Security)
           Or (MsgArea. ShowSec > R. Security)
           Or (Not FlagsValid (R. Flags, MsgArea. ReadFlags))
           Or (Not FlagsValid (R. Flags, MsgArea. ShowFlags))
           Or  Not qwkActive (MsgArea. Name, k))
        Then Inc (Confs);
      End;

      WriteLn (F, Long2Str (Confs));
      i := 1;

      While ReadMsgArea (MsgArea, i) Do
      Begin
        Inc (i);

        If (MsgArea. ReadSec > R. Security) Or
           (MsgArea. ShowSec > R. Security) Or
           (Not FlagsValid (R. Flags, MsgArea. ReadFlags)) Or
           (Not FlagsValid (R. Flags, MsgArea. ShowFlags)) Or
            Not qwkActive (MsgArea. Name, k)
        Then Continue;

        WriteLn (F, Long2Str (i-1));
        WriteLn (F, ZeroMsg (MsgArea. Name, True));
      End;

      CloseFileAreas;
      R. MsgArea := oArea;
      MsgArea := oMsgArea;
    End;

    For i := 1 To WordCount (Cnf. QWKadd, [' ', ',']) Do
    Begin
      S := DefaultName (ExtractWord (i, Cnf. QWKadd, [' ', ',']),
      EmuExt [R. Emu], lang (laTxtFiles));
      If FileExists (S) Then WriteLn (F, UpString (JustFileName (S)));
    End;

    Close (F);
  End;
End;

Procedure DoorIDGen (FName: PathStr);
Begin
  Assign (F, FName); ReWrite (F);

  If IOResult = 0 Then
  Begin
    WriteLn (F, 'DOOR = Tornado QWK module');
    WriteLn (F, 'VERSION = ' + ExtractWord (2, NameVer, [' ']));
    WriteLn (F, 'SYSTEM = ' + NameVer);
    WriteLn (F, 'CONTROLNAME = ADD');
    WriteLn (F, 'CONTROLTYPE = DROP');
    WriteLn (F, 'CONTROLTYPE = CITY');
    WriteLn (F, 'CONTROLTYPE = PASSWORD');
    WriteLn (F, 'CONTROLTYPE = BPHONE');
    WriteLn (F, 'CONTROLTYPE = HPHONE');
    Close (F);
  End;
End;

Function BasicReal2Long (InValue: LongInt): LongInt;
Var
  Temp  : LongInt;
  Expon : Integer;

Begin
  Expon := ((InValue shr 24) and $ff) - 152;
  Temp := (InValue and $007FFFFF) or $00800000;
  If Expon < 0 Then Temp := Temp Shr Abs (Expon) Else Temp := Temp Shl Expon;
  If (InValue and $00800000) <> 0 Then BasicReal2Long := -Temp Else BasicReal2Long := Temp;
  If Expon = 0 Then BasicReal2Long := 0;
End;

Function Long2BasicReal (InValue: LongInt): LongInt;
Var
  Negative      : Boolean;
  Expon         : LongInt;

Begin
  If InValue = 0 Then Long2BasicReal := 0 Else
  Begin
    If InValue < 0 Then
    Begin
      Negative := True;
      InValue := Abs (InValue);
    End Else
      Negative := False;

    Expon := 152;

    If InValue < $007FFFFF Then
    While ((InValue and $00800000) = 0) Do
    Begin
      InValue := InValue Shl 1;
      Dec (Expon);
    End Else
    While ((InValue And $FF000000) <> 0) Do
    Begin
      InValue := InValue Shr 1;
      Inc (Expon);
    End;

    InValue := InValue And $007FFFFF;
    If Negative Then InValue := InValue Or $00800000;
    Long2BasicReal := InValue + (Expon Shl 24);
  End;
End;

Function QWKexport: tqResult;
Var
  DAT, NDX             : File;
  Produced, S          : String;
  Block                : Array [1..128] Of Char;
  MsgNum, MsgNumber,
  RecNumPos, RecNumber,
  SaveFPos, k          : LongInt;
  ConfNum, MsgTxtPos   : Word;
  NDXrec               : NdxRecord;
  ColorNum             : Byte;

Begin
  MsgNumber := 0;
  Assign (DAT, Cnf. DoorInfoDir + 'messages.dat');
  ReWrite (DAT, 1);
  QWKexport := qOk;

  If IOResult = 0 Then
  Begin
    Produced := 'Produced by ' + NameVer + ' ' + Copyright;
    FillChar (Block, SizeOf (Block), #32);
    BlockWrite (DAT, Produced [1], Length (Produced));
    BlockWrite (DAT, Block, 129-Length (Produced));

    If OpenMsgAreas Then
    Begin
      i := 1;
      oArea := R. MsgArea;
      oMsgArea := MsgArea;

      While ReadMsgArea (MsgArea, i) Do
      Begin
        Inc (i);

        If DrawAborted Then
        Begin
          QWKexport := qAborted;
          Close (DAT); Close (NDX);
          If IOResult <> 0 Then;
          tDeleteFile (Cnf. DoorInfoDir + 'messages.dat');
          tDeleteFile (Cnf. DoorInfoDir + 'control.dat');
          tDeleteFile (Cnf. DoorInfoDir + 'door.id');
          tDeleteFile (Cnf. DoorInfoDir + '*.ndx');
          CloseMsgAreas;
          Exit;
        End;

        If (MsgArea. ReadSec > R. Security) Or
           (MsgArea. ShowSec > R. Security) Or
           (Not FlagsValid (R. Flags, MsgArea. ReadFlags)) Or
           (Not FlagsValid (R. Flags, MsgArea. ShowFlags)) Or
            Not qwkActive (MsgArea. Name, k)
        Then Continue;

        If Not OpenMessageArea (False, False) Then Continue;

        ColorNum := Random (15);
        While ColorNum < 9 Do ColorNum := Random (15);
        UpdateUserMacro;

        ComWrite (#13 + EmuClrEoL, 0);
        ComWrite (EmuColor (ColorNum) + lang (laScanMsgAreas), eoMacro + eoCodes);

        Assign (NDX, Cnf. DoorInfoDir + LeftPadCh (Long2Str (i-1), '0', 3) + '.ndx');
        ReWrite (NDX, 1);
        If IOResult <> 0 Then;

        If R. LastRead >= 0 Then
        If MsgArea. BaseType = btJam
        Then MsgNum := Msg^. GetLastRead (Crc32Str (LoString (R. Name)))
        Else MsgNum := Msg^. GetLastRead (R. LastRead);

        If (R. LastRead < 0) Or (MsgNum = 0) Then MsgNum := 1;

        Msg^. GetMsgNumRelative;
        Msg^. SeekFirst (MsgNum);
        Msg^. SeekNext;

        If Not Msg^. SeekFound Then
        Begin
          Close (NDX);
          Erase (NDX);
          If IOResult <> 0 Then;
        End Else
        Begin
          While Msg^. SeekFound Do
          Begin
            Msg^. MsgStartUp;

            If Msg^. IsPriv And
               (LoString (R. Name) <> Trim (LoString (Msg^. GetTo))) And
              ((MsgArea. SysOpSec > R. Security) Or
               (Not FlagsValid (R. Flags, MsgArea. SysOpFlags))) And
               (LoString (R. Name) <> Trim (LoString (Msg^. GetFrom))) Then
            Begin
              Msg^. SeekNext;
              Continue;
            End;

            Inc (MsgNumber);
            If MsgNumber > 1 Then BlockWrite (DAT, Block, 1);

            NDXrec. MsgPointer := Long2BasicReal (Trunc ((FilePos (DAT)-1)/128)+1);
            NDXrec. Conference := i-1;
            BlockWrite (NDX, NDXrec, SizeOf (NDXrec));

            SlashRotate;
            S := PadCh (Long2Str (MsgNumber), ' ', 7); BlockWrite (DAT, S [1], 7);
            S := Msg^. GetDate; BlockWrite (DAT, S [1], 8);
            S := Msg^. GetTime; BlockWrite (DAT, S [1], 5);
            S := PadCh (Msg^. GetTo, ' ', 25); BlockWrite (DAT, S [1], 25);
            S := PadCh (Msg^. GetFrom, ' ', 25); BlockWrite (DAT, S [1], 25);
            S := PadCh (Msg^. GetSubj, ' ', 25); BlockWrite (DAT, S [1], 25);
            S := Replicate (' ', 12); BlockWrite (DAT, S [1], 12);
            S := PadCh ('0', ' ', 8); BlockWrite (DAT, S [1], 8);
            RecNumPos := FilePos (DAT);
            S := Replicate (' ', 6); BlockWrite (DAT, S [1], 6);
            S := #225; BlockWrite (DAT, S [1], 1);
            ConfNum := i-1; BlockWrite (DAT, ConfNum, 2);
            S := '   '; BlockWrite (DAT, S [1], 3);

            Msg^. MsgTxtStartUp;
            MsgTxtPos := 0;
            RecNumber := 1;

            While Not Msg^. EOM Do
            Begin
              S := PlaceSubStr (TrimTrail (Msg^. GetString (80)), 'ã', 'y') + 'ã';
              If S [1] = #1 Then Continue;
              Inc (MsgTxtPos, Length (S));
              BlockWrite (DAT, S [1], Length (S));
              While MsgTxtPos > 128 Do
              Begin
                Inc (RecNumber);
                MsgTxtPos := MsgTxtPos-128;
              End;
            End;

            Inc (RecNumber);
            BlockWrite (DAT, Block, 128-MsgTxtPos);
            SaveFPos := FilePos (DAT); Seek (DAT, RecNumPos);
            S := PadCh (Long2Str (RecNumber), ' ', 6);
            BlockWrite (DAT, S [1], 6);

            If IOResult = 101 Then
            Begin
              Close (NDX); Erase (NDX);
              Close (DAT); Erase (DAT);
              LogWrite ('!', sm (sstatDiskFull));
              QWKexport := qAborted;
              Exit;
            End;

            Seek (DAT, SaveFPos);

            Msg^. SeekNext;
          End;

          Close (NDX);
        End;

        If AjustLastReads Then
        If R. LastRead >= 0 Then
        If MsgArea. BaseType = btJam
        Then Msg^. SetLastRead (Crc32Str (LoString (R. Name)), Msg^. GetMsgNum)
        Else Msg^. SetLastRead (R. LastRead, Msg^. GetMsgNum);

        CloseMsgArea (Msg);
      End;

      CloseMsgAreas;
      R. MsgArea := oArea;
      MsgArea := oMsgArea;
    End;

    Close (DAT);

    If gFileSize (Cnf. DoorInfoDir + 'messages.dat') = 129 Then
    Begin
      tDeleteFile (Cnf. DoorInfoDir + 'messages.dat');
      QWKexport := qNotFound;
    End;

  End;
End;

Procedure qwkDownLoad;
Var
  ASC, List : PathStr;

Begin
  If qwkAreas^. Count = 0 Then
  Begin
    Message (lang (laNoQWKAreas));
    Exit;
  End;

  If Query (lang (laQWKscan), True, ofFramed) Then
  Begin
    AjustLastReads := Query (lang (laQWKajust), True, ofFramed);

    Case QWKexport Of
      qOk       : Begin
                    ID := UpString (DelChars ([' ', '.', ',', '/', '#', '*', '?', '$'], Cnf. BBSname));
                    ControlDatGen (ID, Cnf. DoorInfoDir + 'control.dat');
                    DoorIDGen (Cnf. DoorInfoDir + 'door.id');

                    List := Cnf. TempDir + 'qwk' + Copy ('.lst', 1, 4-Length (Long2Str (BbsLine))) + Long2Str (BbsLine);
                    Assign (F, List);
                    ReWrite (F);

                    WriteLn (F, Cnf. DoorInfoDir + 'messages.dat');
                    WriteLn (F, Cnf. DoorInfoDir + 'control.dat');
                    WriteLn (F, Cnf. DoorInfoDir + 'door.id');
                    WriteLn (F, Cnf. DoorInfoDir + '*.ndx');

                    For i := 1 To WordCount (Cnf. QWKadd, [' ', ',']) Do
                    Begin
                      ASC := DefaultName (ExtractWord (i, Cnf.
                      QWKadd, [' ', ',']), EmuExt [R. Emu],
                      lang (laTxtFiles));
                      If FileExists (ASC) Then WriteLn (F, ASC);
                    End;

                    Close (F);

                    S := PlaceSubStr (Cnf. QWKpack, '%1', Cnf. DoorInfoDir + ID + '.qwk');
                    S := PlaceSubStr (S, '%2', List);

                    DosShell (S, exCommand, False);

                    tDeleteFile (Cnf. DoorInfoDir + 'messages.dat');
                    tDeleteFile (Cnf. DoorInfoDir + 'control.dat');
                    tDeleteFile (Cnf. DoorInfoDir + 'door.id');
                    tDeleteFile (Cnf. DoorInfoDir + '*.ndx');
                    tDeleteFile (List);
                    Transfer (Cnf. DoorInfoDir + ID + '.qwk', Transmit, tsNormal);
                    tDeleteFile (Cnf. DoorInfoDir + ID + '.qwk');
                  End;

      qNotFound : Begin
                    ComWrite (#13 + EmuClrEOL, 0);
                    Message (lang (laQWKnotFound));
                  End;
    End;
  End;
End;

Procedure qwkUpLoad;
Type
  tMsgBlock = Array [1..128] Of Char;

Var
  F                        : File Of tMsgBlock;
  Block                    : tMsgBlock;
  AreaNum, RecNum, i, j,
  Posted                   : Word;
  MsgTo, MsgFrom, MsgSubj  : String [60];
  FMsg                     : Text;
  SR, SR1                  : {$IFNDEF WIN32} SearchRec {$ELSE} TSearchRec {$ENDIF};
  SomeProcessed            : Boolean;

Function TestMailBomb (fName: String): Boolean;
Var
  CO      : CompressorType;
  CompAll, RealAll : LongInt;

Begin
  TestMailBomb := False;
  CompAll := 0;
  RealAll := 0;
  If DetectCompressor (fName, CO) Then
  Begin
    CO^. CheckProtection;
    If CO^. Broken Then Exit;

    CO^. FindFirstEntry;
    While Not CO^. LastEntry Do
    Begin
      With IBM (CO^. Entry) Do
      Begin
       Inc (CompAll, CompressedSize);
       Inc (RealAll, OriginalSize);
      End;
      CO^. FindNextEntry;
    End;
    LogWrite ('*', 'Un-/Compressed size: '+ Long2Str (RealAll) + '/' + Long2Str(CompAll) +
                   ' (' + Long2Str (Round (RealAll/CompAll)) + ':1)');
    If Round (RealAll/CompAll) > Cnf. QWKRatio Then
    Begin
      TestMailBomb := True;
      LogWrite ('*', 'Mailbomb detected!');
    End;
  End;
End;

Begin
  UpLoadToUser := '';
  AutoDL := True;
  SmartChDir (Cnf. DoorInfoDir);
  Transfer ('', Receive, tsNormal);
  AutoDL := False;
  SmartChDir (Cnf. Path);

  Posted := 0;
  SomeProcessed := False;
  ID := UpString (DelChars ([' ', '.', ',', '/', '#', '*', '?', '=', '+', '\', '|'], Cnf. BBSname));
{$IFDEF WIN32}
  DOSerror :=
{$ENDIF}
  FindFirst (Cnf. DoorInfoDir + '*.REP', AnyFile{$IFNDEF OS2}-VolumeID{$ENDIF}-Hidden-Directory, SR);

  While (DosError = 0) And (SR. Name <> '') Do
  Begin

    If TestMailBomb (Cnf. DoorInfoDir + JustFileName (SR. Name)) Then Break;

    LogWrite ('+', sm (smProcessREP) + Trim (NiceFileName (Cnf. DoorInfoDir + SR. Name, 60)) + ' ...');
    SmartChDir (Copy (Cnf. DoorInfoDir, 1, Length (Cnf. DoorInfoDir)-1));
    DosShell (PlaceSubStr (Cnf. QWKunpack, '%1', JustFileName (SR. Name)), exCommand, False);
    SmartChDir (Copy (Cnf. Path, 1, Length (Cnf. Path)-1));
    If IOResult <> 0 Then;

  {$IFDEF WIN32}
    DOSerror :=
  {$ENDIF}
    FindFirst (Cnf. DoorInfoDir + '*.MSG', AnyFile{$IFNDEF OS2}-VolumeID{$ENDIF}-Hidden-Directory, SR1);

    If DOSerror = 0 Then
    Begin
      Assign (F, Cnf. DoorInfoDir + SR1. Name); ReSet (F);
      Read (F, Block);

      While Not EoF (F) Do
      Begin
        Read (F, Block);

        S := Block [  2]; For i :=   3 To   8 Do S := S + Block [i]; AreaNum := Str2Long (Trim (S));
        S := Block [117]; For i := 118 To 122 Do S := S + Block [i]; RecNum := Str2Long (Trim (S));
        S := Block [ 22]; For i :=  23 To  46 Do S := S + Block [i]; MsgTo := Trim (S);
        S := Block [ 47]; For i :=  48 To  71 Do S := S + Block [i]; MsgFrom := Trim (S);
        S := Block [ 72]; For i :=  73 To  96 Do S := S + Block [i]; MsgSubj := Trim (S);

        Assign (FMsg, Cnf. DoorInfoDir + 'msgtext.tor');
        ReWrite (FMsg);

        If IOResult = 0 Then
        Begin
          S := '';

          For i := 1 To RecNum Do
          Begin
            Read (F, Block);

            For j := 1 To 128 Do
            If Block [j] <> 'ã' Then S := S + Block [j] Else
            Begin;
              WriteLn (FMsg, TrimTrail (S));
              S := '';
            End;

            If EoF (F) Then Break;
          End;

          Close (FMsg);

          PostFile (Cnf. DoorInfoDir + 'msgtext.tor', AreaNum,
          MsgFrom, MsgTo, MsgSubj, MsgArea. Address,
          MsgArea. Address, pfAutoOpen+pfUseDefaultAddr);

          Inc (Posted);
          Erase (FMsg);
        End;
      End;
      Close (F);
      Erase (F);
      If IOResult <> 0 Then;

      SomeProcessed := True;
      tDeleteFile (Cnf. DoorInfoDir + SR. Name);
      LogWrite ('+', PlaceSubStr (sm (smREPok), '%1', Long2Str (Posted)));
    End Else
    Begin
      LogWrite ('!', sm (smFile) + Trim (NiceFileName (Cnf. DoorInfoDir + ID + '.MSG', 60)) + sm (smNotFound));
      Message (Trim (NiceFileName (lang (laFileName) + ID + '.MSG', 60)) + lang (laNotFound));
    End;

  {$IFNDEF MSDOS}
    FindClose (SR1);
  {$ENDIF}
  {$IFDEF WIN32}
    DOSerror :=
  {$ENDIF}
    FindNext (SR);
  End;
{$IFNDEF MSDOS}
  FindClose (SR);
{$ENDIF}
  If SomeProcessed Then Message (lang (laREPok));
End;

Procedure qwkSelect;
Var
  n       : LongInt;
  M       : PNotSortedCollection;
  oAttr   : Byte;

Procedure SelectArea;

Procedure SwitchArea (n: LongInt);
Var
  j : LongInt;

Begin
  If (n > 0) and (((i+3 >= R. Lines) and (n <= i+1)) or
     ((i+1 < R. Lines) and (n < i+1))) Then
  Begin
    qwkListChanged := True;

    If QWKactive (PString (M^. At (n-1))^, j) Then
    Begin
      qwkAreas^. AtPut (j, Nil);
      ComWriteLn (lang (laQWKdeleted) + PString (M^. At (n-1))^, eoCodes+eoMacro);
    End Else
    Begin
      qwkAreas^. Insert (NewStr (S1));
      ComWriteLn (lang (laQWKadded) + PString (M^. At (n-1))^, eoCodes+eoMacro);
    End;

  End;
End;

Var
  k     : Byte;
  S1    : String;
  n     : LongInt;

Begin
  If S <> '' Then
  For k := 1 To WordCount (S, [' ', ',']) Do
  Begin
    S1 := ExtractWord (k, S, [' ', ',']);

    If Pos ('-', S1) = 0 Then
    Begin
      n := Str2Long (S1);
      SwitchArea (n);
    End Else
      For n := Str2Long (Copy (S1, 1, Pos ('-', S1) - 1))
      To Str2Long (Copy (S1, Pos ('-', S1) + 1, 255))
      Do SwitchArea (n);

  End;

  n := -1;
  While n <= qwkAreas^. Count-1 Do
  Begin
    Inc (n);
    If n > qwkAreas^. Count-1 Then Break;
    If qwkAreas^. At (n) = nil Then
    Begin
      qwkAreas^. AtDelete (n);
      Dec (n);
    End;
  End;

End;

Const
  Marker         : Array [Boolean] Of String [1] = (' ', '*');
  ShowOnlyActive : Boolean = False;
  Found          : Boolean = False;

Var
  z             : LongInt;

Function ProcBlock1: Boolean;
Begin
  ProcBlock1 := MoreNums (S, lang (laQWKenternum));
End;

Label
  EndOf,
  Loop,
  Loop1,
  ShowList;

Begin
  If Not OpenMsgAreas Then Exit;
  M := New (PNotSortedCollection, Init (1, 1));
  i := 1;

  If ReadMsgArea (tMA, i) Then
  Begin
  Loop1:
    If (tMA. Name <> '') And FlagsValid (R. Flags, tMA. ShowFlags) And
       (tMA. ShowSec <= R. Security) And
       (WordInString (MsgGroup. Tag, tMA. Group) Or
       (MsgGroup. Tag = '')  Or (tMA. Group = ''))
    Then
       M^. Insert (NewStr (tMA. Name));

    Inc (i);
    If ReadMsgArea (tMA, i) Then GoTo Loop1;
  End;

  CloseMsgAreas;
  ShowOnlyActive := False;

  ShowList:
  Cls;
  i := 0;
  S := '';
  ComWriteLn (lang (laQWKList) + '|', eoCodes + eoMacro);
  InitMore (WhereY-1);

  While i < M^. Count Do
  Begin
    Found := qwkActive (PString (M^. At (i))^, z);
    If (Found And ShowOnlyActive) Or Not ShowOnlyActive Then
    Begin
      ComWriteLn (EmuColor (Cnf. ColorScheme [umNumber]) + LeftPadCh (Long2Str (
                  i+1), ' ', 5) + EmuColor (Cnf. ColorScheme [umDot]) + '.' +
                  Marker [Found] + ' ' + EmuColor (Cnf. ColorScheme [umItem]) +
                  PString (M^. At (i))^, eoMacro+eoCodes);

      While True Do
      Begin
        If Not ProcBlock1 Then
        Begin
          ComWriteLn ('', 0);
          GoTo Loop;
        End;

        If S <> '' Then
        Begin
          SelectArea;
          MoreLines := R. Lines;
          S := '';
          Continue;
        End Else
          Break;
      End;

    End;
    Inc (i);
  End;

  ComWriteLn ('', 0);
  Loop:
  n := MenuBar (lang (laQWKcontrols), '*%-0123456789'#13);
{$IFDEF WIN32}
  If Application. Terminated Then Exit;
{$ENDIF}

  Case n Of
       1 : Begin
             ShowOnlyActive := False;
             GoTo ShowList;
           End;

       2 : Begin
             ShowOnlyActive := True;
             GoTo ShowList;
           End;

       3 : Begin
             If qwkAreas^. Count > 0 Then qwkListChanged := True;
             qwkAreas^. FreeAll;
             qwkAreas^. DeleteAll;
             ComWriteLn ('|' + lang (laNoQWKAreas) + '|', eoCodes + eoMacro);
           End;

   4..13 : Begin
             S := Long2Str (n-4);
             If R. HotKeys Then KeyBufAdd (S [1]) Else HotKeysStr := S [1] + HotKeysStr;
             oAttr := TextAttr;
             ComWrite (#13 + EmuClrEOL, 0);
             ComWrite (lang (laQWKenternum), eoCodes+eoMacro);
             S := '';
             ComRead (S, 10, ofAllowEmpty);
             ComWrite (#13 + EmuClrEOL + EmuColor (oAttr), 0);
             SelectArea;
           End;

      14 : GoTo EndOf;
  End;
  GoTo Loop;

  EndOf:
  Dispose (M, Done);
End;

Procedure qwkReadList;
Var
  F     : Text;

Begin
  Wait4Flag ('qwkfile.tbf');
  SetFlag ('qwkfile.tbf');

  qwkAreas^. FreeAll;
  qwkAreas^. DeleteAll;

  Assign (F, Cnf. Path + 'qwk.tor');
  ReSet (F);

  If IOResult = 0 Then
  Begin
    S1 := HexL (Crc32Str (R. Name));

    While Not EoF (F) Do
    Begin
      ReadLn (F, S);

      If S [1] = '#' Then
      If Copy (S, 2, 255) = S1 Then
      Begin
        S := '1';
        While Not EoF (F) and (S [1] <> '#') Do
        Begin
          ReadLn (F, S);
          qwkAreas^. Insert (NewStr (S));
        End;
        Break;
      End;
    End;

    Close (F);
  End;

  DelFlag ('qwkfile.tbf');
End;

Procedure qwkWriteList;
Var
  F, F1   : Text;

Begin
  If qwkListChanged Then
  Begin
    Wait4Flag ('qwkfile.tbf');
    SetFlag ('qwkfile.tbf');

    Assign (F, Cnf. Path + 'qwk.tor');
    ReSet (F); If IOResult <> 0 Then ReWrite (F);

    If IOResult = 0 Then
    Begin
      Assign (F1, Cnf. TempDir + 'qwk.tmp'); ReWrite (F1);
      S1 := HexL (Crc32Str (R. Name));

      While Not EoF (F) Do
      Begin
        ReadLn (F, S);

        If S [1] = '#' Then
        If Copy (S, 2, 255) = S1 Then
        Begin
          S := '1';
          While Not EoF (F) and (S [1] <> '#') Do ReadLn (F, S);
          Continue;
        End;

        WriteLn (F1, S);
      End;

      If qwkAreas^. Count > 0 Then
      Begin
        WriteLn (F1, '#' + S1);
        For i := 0 To qwkAreas^. Count-1
        Do WriteLn (F1, PString (qwkAreas^. At (i))^);
      End;

      Close (F);
      Close (F1);

      tDeleteFile (Cnf. Path + 'qwk.tor');
      tRenameFile (Cnf. TempDir + 'qwk.tmp', Cnf. Path + 'qwk.tor');
    End;

    DelFlag ('qwkfile.tbf');
  End;
End;

End.