{ $ DEFINE INDEXDEBUG}
{$IFDEF WtrGate}{$IFDEF UseOvr}{$O+,F+}{$ENDIF}{$ENDIF}
UNIT Squish;

{$i platform.inc}

{ MD 23-07-93 Structures gebasseerd op code gevonden in de PDN }

INTERFACE

USES Database;

PROCEDURE Squish_Init;
PROCEDURE Squish_Done;

PROCEDURE Squish_ImportMessage (AreaName,Path,DecodePath : STRING; DecodeFiles : BOOLEAN);
PROCEDURE Squish_ScanArea (AreaRecNr : AreaBaseRecordNrType; AreaRec : AreaBaseRecord; IsPrimaryNetmailArea,IsBadArea:BOOLEAN);

PROCEDURE Squish_PurgeArea (AreaRec : AreaBaseRecord);
FUNCTION  Squish_LinkArea (AreaRec : AreaBaseRecord) : BOOLEAN;

PROCEDURE Squish_Rescan (VAR AreaRec : AreaBaseRecord);

{## move other "tools" here as well}


IMPLEMENTATION

USES FBuffer,
     Fido,
     Ramon,
     Start,
     Dos,
     Globals,
     Cfg,
     Logs,
     Msgs,
     UnixTime,
     {Stats,}
     Scan,
     Decode,
     Slice,
     MsgUtil,
     PackBuf,
     Trans,
     Rescan,
     UserBase;  {## check again }

TYPE SearchType    = (FIRST_ENTRY,NEXT_ENTRY);
     UMSGID_TYPE   = LONGINT;
     RECPOS_TYPE   = LONGINT;

     _Address  = RECORD
                       Zone,
                       Net,
                       Node,
                       Point : WORD;
                 END;

     FrameType = (SQ_FIRST,
                  SQ_LAST,
                  SQ_PREV,
                  SQ_NEXT);

CONST NULLFRAME       = 0;
      SQMSG_FROM_SIZE = 36;
      SQMSG_TO_SIZE   = 36;
      SQMSG_SUBJ_SIZE = 72;
      MAX_REPLY       = 10;      { max number of stored replies to one msg }
      SQNEWENTRYS     = 200;     { reserveer ruimte voor nieuwe berichten }
      SQUISH_D_EXT    = '.SQD';
      SQUISH_I_EXT    = '.SQI';

      SquishBaseMaximumLockTrys = 15; { = 15 seconds }

{    .SQD file     }
{ +==============+ }
{ | base header  | }
{ +==============+ }
{ | frame header | }
{ |--------------| }
{ | msg header   | }
{ |--------------| }
{ | kludges      | }
{ |--------------| }
{ | body         | }
{ +==============+ }
{ | frame header | }
{ |--------------| }
{ | msg header   | }
{ |--------------| }
{ | kludges      | }
{ |--------------| }
{ | body         | }
{ +==============+ }
{ . etc.         . }
{ +==============+ }

{ This is the first RECORD in the *.SQD file }

TYPE _SQBASETYPE = RECORD
                         Len        : WORD;                 { LENGTH OF THIS STRUCTURE! }
                         Rsvd1      : WORD;                 { Reserved word }
                         Num_msg,                           { number of msgs }
                         High_msg,                          { highest msg -  always equal to num_msg }
                         Skip_msg   : LONGINT;              { # of msgs to keep in beginning of area }
                         High_water : UMSGID_TYPE;          { High water marker (umsgid) }
                         Uid        : UMSGID_TYPE;          { Last usmgid }
                         Base       : ARRAY[1..80] OF CHAR; { Base name for SquishFile }
                         Begin_frame,                       { Offset of first frame in file }
                         Last_frame,                        { Offset to last frame in file }
                         First_free,                        { Offset of first FREE frame in file }
                         Last_free,                         { Ofs of the last free frame }
                         End_frame  : RECPOS_TYPE;          { Pointer to end of file }
                         Max_msg    : LONGINT;              { Maximum number of messages }
                         Keep_days  : WORD;                 { Max age of messages }
                         sz_sqhdr   : WORD;                 { Size of frame header }
                         Rsvd2      : ARRAY[1..124] OF BYTE;{ Reserved area }
                   END;

{ After the BASE record, follows a frame record for EACH message. The   }
{ begin_frame in the base should point to the first frame header, and   }
{ the next_frame in the frame header should point to the next one, etc. }

TYPE _SQFHDRTYPE = RECORD
                         Id           : LONGINT;     { sqhdr.id must always equal SQHDRID }
                         Next_frame,                 { pointer to next msg in base }
                         Prev_frame   : RECPOS_TYPE; { pointer to prior msg in base }
                         Frame_length,               { length of this frame (not counting header) }
                         Msg_length,                 { length of msg in frame. may be less than
                                                       frame_length if this frame has been recycled. }
                         CLen         : LONGINT;     { Length of the control information. }
                         Frame_type   : WORD;        { Either FRAME_MESSAGE or FRAME_FREE. The API
                                                       has been designed to allow things such
                                                       as FRAME_LZSS or FRAME_LZH to be hacked on
                                                       later, without changing the application. }
                         rsvd         : WORD;        { Reserved }
                   END;

{ But right after each frame header, follows the squish message header, }
{ then the control info, then the text.                                 }

TYPE _SQMHDRTYPE = RECORD
                         Attr         : LONGINT;
                         FromWhom     : ARRAY[1..SQMSG_FROM_SIZE] OF CHAR;
                         ToWhom       : ARRAY[1..SQMSG_TO_SIZE] OF CHAR;
                         Subj         : ARRAY[1..SQMSG_SUBJ_SIZE] OF CHAR;
                         Orig,
                         Dest         : _ADDRESS;   { Origination and destination addresses }
                         Date_written,              { When user wrote the msg (UTC) }
                         Date_arrived : LONGINT;    { When msg arrived on-line (UTC) }
                         Utc_ofs      : WORD;       { Minutes offset from UTC of message writer }
                         Replyto      : UMSGID_TYPE;
                         Replies      : ARRAY[1..MAX_REPLY] OF UMSGID_TYPE;
                         Azdate       : ARRAY[1..20] OF CHAR;  { ASCII date }
                   END;

{ Each SQD file has a SQI FILES.  The message number YOU see (the user) }
{ in MAX is really the counter starting from 1 of each record in SQI.   }
{ But the TRUE UNIQUE Message ID is in umsgid. The ofs value will       }
{ point to the frame header in SQD.  These files are small and you      }
{ may read them into a array SqiPtrArrayType using the functions below. }

TYPE _SQIDXTYPE = RECORD
                        Ofs    : RECPOS_TYPE;  { Offset of frame header }
                        Umsgid : UMSGID_TYPE;  { Unique message identifier }
                        Hash   : LONGINT;      { 'To' name hash value }
                  END;

{ RAWI 970529: About the .SQL file: it is an array of UMSGIDs, indexed   }
{              by a field in the user base. It can be found in the index }
{              file, which leads to the message body.                    }
{              It seems that setting high_water to 0 invalidates the     }
{              contents of the .SQL file.                                }
{              No packing required.                                      }

{ Variabelen definties }
VAR SquishBase     : _SQBASETYPE;
    SquishFrameHdr : _SQFHDRTYPE;
    SquishMsgHdr   : _SQMHDRTYPE;

    CurrentFrame   : LONGINT;     { position on disk }

    SquishIndexNumb   : LONGINT;    { number of entries in the index  }

    CurrentBase       : STRING[79];  { empty means no base open }
    SquishBaseF       : FBufferType;
    SquishIndexF      : FILE;
    SquishIndexIsOpen : BOOLEAN;

    LastWritePos      : LONGINT;
    PurgeLR_IndexTel  : WORD;

    Import_ReplaceMsgId : BOOLEAN;

    AttachedFiles       : STRING;

    TouchCounter        : BYTE;

CONST SQHDRID    = $AFAE4453;  { squish headers must have this number }
      FRAME_msg  = 0;          { it's a live message }
      FRAME_free = 1;          { the message is dead, avail for new msg }
      FRAME_rle  = 2;          { type of compression, not implemented }
 {    FRAME_lzw  = 3;          { type of compression, not implemented }
 {    FRAME_update = 3;        { being updated? }


{--------------------------------------------------------------------------}
{ Squish2FidoAdres                                                         }
{                                                                          }
{ Converteerd een squish type fido adres naar ons intern type.             }
{                                                                          }
PROCEDURE Squish2FidoAdres (Source : _Address; VAR Target : FidoAddrType);
BEGIN
     WITH Target DO
     BEGIN
          { kan dit niet rapper met een Move() ofzo? }
          Zone:=Source.Zone;
          Net:=Source.Net;
          Node:=Source.Node;
          Point:=Source.Point;
          Domain:='';
     END; { with }
END;


{---------------------------------------------------------------------------}
{ SquishFido2SquishAdres                                                    }
{                                                                           }
{ Deze routine converteer een squish fido adres naar ons type.              }
{                                                                           }
PROCEDURE SquishFido2SquishAdres (Source : FidoAddrType; VAR TarGet : _Address);
BEGIN
     WITH Target DO
     BEGIN
          { kan dit niet rapper met een Move() ofzo? }
          Zone:=Source.Zone;
          Net:=Source.Net;
          Node:=Source.Node;
          Point:=Source.Point;
     END; { with }
END;


{--------------------------------------------------------------------------}
{ PackedDosDateTime2SquishDateTime                                         }
{                                                                          }
FUNCTION PackedDosDateTime2SquishDateTime (SquishDT : LONGINT) : LONGINT;
BEGIN
     PackedDosDateTime2SquishDateTime:=(SquishDT SHR 16) OR ((SquishDT AND $FFFF) SHL 16);
END;


{--------------------------------------------------------------------------}
{ SquishDateTime2PackedDosDateTime                                         }
{                                                                          }
FUNCTION SquishDateTime2PackedDosDateTime (SquishDT : LONGINT) : LONGINT;
BEGIN
     SquishDateTime2PackedDosDateTime:=(SquishDT SHR 16) OR ((SquishDT AND $FFFF) SHL 16);
END;


{--------------------------------------------------------------------------}
{ SquishNameToHash                                                         }
{                                                                          }
{ Geeft een HASH value van de gegeven naam terug.                          }
{                                                                          }
FUNCTION SquishNameToHash (Name : STRING) : LONGINT;

VAR G,Hash : LONGINT;
    P      : BYTE;

BEGIN
     Hash:=0;
     FOR P:=1 TO Length (Name) DO
     BEGIN
          Hash:=(Hash SHL 4)+Ord (LoCase (Name[p]));
          G:=Hash AND $F0000000;
          IF (G <> 0) THEN
          BEGIN
               Hash:=Hash OR (G SHR 24);
               Hash:=Hash OR G;
          END;
     END; { for }

     SquishNameToHash:=Hash AND $7FFFFFFF;
END;


{-------------------------------------------------------------------------}
{ SquishUpdateHeader                                                      }
{                                                                         }
{ Schrijft de Squish header naar disk.                                    }
{                                                                         }
FUNCTION SquishUpdateHeader : BOOLEAN;

VAR Pos : LONGINT;

BEGIN
     SquishUpdateHeader:=FALSE;

     Pos:=0;
     IF FBSeekWrite (SquishBaseF,Pos,SquishBase,SizeOf (SquishBase)) THEN
        SquishUpdateHeader:=TRUE
     ELSE BEGIN
          LogExtraMessage ('[Squish] Failed to update header');
          SquishUpdateHeader:=FALSE;
     END;
END;


{-------------------------------------------------------------------------}
{ CreateBase                                                              }
{                                                                         }
{ This routine creates the files for a new Squish Message base. The       }
{ CurrentBase member must contain the path to the message base, without   }
{ the extension.                                                          }
{                                                                         }
FUNCTION CreateBase : BOOLEAN;

VAR IORes   : BYTE;
    NewFile : FILE;
    Size    : WORD;

BEGIN
     CreateBase:=FALSE;

     { Probeer de SQUISAREA.SQD file te creeren }
     Assign (NewFile,CurrentBase+SQUISH_D_EXT);
     {$I-} ReWrite (NewFile,1); {$I+} IORes:=IOResult;
     IF (IORes <> 0) THEN
     BEGIN
          LogDiskIOError (IORes,'[Squish] Error creating '+CurrentBase+SQUISH_D_EXT);
          Exit;
     END;

     {$IFDEF LogFileIO}PostOpenF (NewFile);{$ENDIF}

     {$IFDEF LogFileIO}PreCloseF (NewFile);{$ENDIF}
     Close (NewFile);

     CalcMaxAllowedMem (Size,1024,8192);

     IF (NOT FBufferOpen (SquishBaseF,CurrentBase+SQUISH_D_EXT,Size,0)) THEN
     BEGIN
          LogExtraMessage ('[Squish] Failed to open just created file '+CurrentBase+SQUISH_D_EXT);
          FBufferClose (SquishBaseF);
          Exit;
     END;

     { Vul de SquishMessageAreaHeader }
     WITH SquishBase DO
     BEGIN
          Len:=SizeOf (_SQBASETYPE);
          rsvd1:=0;            { Reserved }
          Num_Msg:=0;          { 1 bericht in de base }
          High_Msg:=0;         { High_Msg == Num_Msg }
          Skip_Msg:=0;         { Laat altijd 1 bericht staan }
          High_Water:=0;       { UMSGID_TYPE }
          uid:=1;              { UMSGID_TYPE }
          Move (CurrentBase[1],Base,Length (CurrentBase));
          Base[Length (CurrentBase)+1]:=#0;
          {StrPCopy( Base , DeleteBackSpaces( AreaRecord.AreaName );}
          Begin_frame:=0;      { eerste frame komt achter }
          Last_frame:=0;       { de Base header  }
          First_free:=0;
          Last_free:=0;
          End_frame:=SizeOf (SquishBase);   { EOF positie, nog niet aanwezig }

          { not used by my Purge anyway }
          Max_Msg:=0; {AreaRecord.FidoMsgLimit}
          Keep_Days:=0; {AreaRecord.FidoMsgAge}

          sz_sqhdr:=SizeOf (_SQFHDRTYPE);
     END;

     { Reserveer ruimte voor het maximaal aantal berichten }
     { *Index*                                             }
     SquishIndexNumb:=0;

     { Schrijf de header naar disk }
     SquishUpdateHeader;
     FBufferClose (SquishBaseF);

     { Creer een NULL index file }
     Assign (SquishIndexF,CurrentBase+SQUISH_I_EXT);
     {$I-} ReWrite (SquishIndexF,1); {$I+} IORes:=IOResult;
     IF (IORes = 0) THEN
     BEGIN
          {$IFDEF LogFileIO}PostOpenF (SquishIndexF);{$ENDIF}

          {$IFDEF LogFileIO}PreCloseF (SquishIndexF);{$ENDIF}
          {$I-} Close (SquishIndexF); {$I+} IORes:=IOResult;
     END;

     IF (IORes <> 0) THEN
     BEGIN
          LogDiskIOError (IORes,'[Squish] Error creating index '+CurrentBase+SQUISH_I_EXT);
          Exit;
     END;

     PeekFiles;

     CreateBase:=TRUE;
END;

(********************************** SQI (Index) *****************************)
CONST
     SquishMaxLoadedIndexEntries = 500;                     { About 4kb }

TYPE
     SquishIndexArrayType = ARRAY [1..SquishMaxLoadedIndexEntries] OF
                                                                 _SqIdxType;

VAR
     SquishIndex: SquishIndexArrayType;
     SquishIndexLoadedStart, SquishIndexLoadedEnd: LONGINT;

{--------------------------------------------------------------------------}
{ SquishIndexCacheEntries                                                  }
{                                                                          }
{ Loads (N+SquishMaxLoadedIndexEntries) entries into SquishIndex[] for     }
{ speedy retrieval later.  Updates SquishIndexLoadedStart and SquishIndex- }
{ LoadedEnd.  Expects that SquishIndexCountEntries has been called.        }
{                                                                          }
{ If this fails for any reason, we simply won't cache it.                  }
PROCEDURE SquishIndexCacheEntries (StartPos: LONGINT);
VAR
     X, Start, Last: LONGINT;
     IORes: BYTE;

BEGIN
     SquishIndexLoadedStart := -1;

     IF (NOT SquishIndexIsOpen) THEN
          Exit;

     Start := StartPos;
     IF (Start > 0) THEN
          Dec (Start);

     { Use a max of SquishMaxLoadedIndexEntries.  If that is more than is }
     { in the index, use the number of entries in the index.              }
     Last := Start + SquishMaxLoadedIndexEntries;
     IF (Last > (FileSize (SquishIndexF) DIV SizeOf (_SqIdxType)) - 1) THEN 
          Last := (FileSize (SquishIndexF) DIV SizeOf (_SqIdxType)) - 1;

     { No index }
     IF (Last <= 0) THEN
          Exit;

     {$I-}
     Seek (SquishIndexF, Start * SizeOf (_SqIdxType));
     IORes := IOResult;
     {$I+}

     IF (IORes <> 0) THEN
     BEGIN
          LogMessage (liFatal, '[SquishIndexCacheEntries] Seek error '+
                         Byte2String (IORes)+' caching index@' +
                              Longint2String (FilePos (SquishIndexF)));

          Exit;
     END;

     FOR X := Start TO Last DO BEGIN
          {$I-}
          BlockRead (SquishIndexF, SquishIndex [X-Start+1], SizeOf (_SqIdxType));
          IORes := IOResult;
          {$I+}
          IF (IORes <> 0) THEN
          BEGIN
               LogMessage (liFatal, '[SquishIndexCacheEntries] Read error '+
                              Byte2String (IORes)+' caching index@' +
                                   Longint2String (FilePos (SquishIndexF)));

               Exit;
          END;
     END;

     { Just say we don't have a cache }
     IF (Start <= 0) AND (Last <= 0) THEN
          Exit;

     SquishIndexLoadedStart := Start;
     SquishIndexLoadedEnd := Last;
     
     {$IFDEF INDEXDEBUG}
     LogMessage (liDebug, '[SquishCacheIndex] Entries in memory now: '+
          Longint2String (SquishIndexLoadedStart) + '..' +
          Longint2String (SquishIndexLoadedEnd));
     {$ENDIF}

END;


     


{--------------------------------------------------------------------------}
{ SquishCloseIndex                                                         }
{                                                                          }
{ Closes the .SQI file, if it is open.                                     }
{                                                                          }
PROCEDURE SquishCloseIndex;
BEGIN
     IF (NOT SquishIndexIsOpen) THEN
        Exit;

     Close (SquishIndexF);
     {$IFDEF LogFileIO}PostCloseF (SquishIndexF);{$ENDIF}

     {LogMessage (liDebug,'[Squish] Closed index "'+CurrentBase+'", '+Longint2String (SquishIndexNumb)+' entries');}

     SquishIndexIsOpen:=FALSE; { Index is not open }
END;


{--------------------------------------------------------------------------}
{ SquishOpenIndex                                                          }
{                                                                          }
{ Opens the .SQI file for updating. Returns TRUE if successful or FALSE    }
{ when it failed.                                                          }
{                                                                          }
PROCEDURE SquishIndexCountEntries; FORWARD;

FUNCTION SquishOpenIndex : BOOLEAN;

VAR IORes : BYTE;

BEGIN
     SquishOpenIndex:=TRUE; { assume success }

     IF (SquishIndexIsOpen) THEN
        Exit;

     Assign (SquishIndexF,CurrentBase+SQUISH_I_EXT);
     {$I-} Reset (SquishIndexF,1); {$I+} IORes:=IOResult;
     IF (IORes <> 0) THEN
     BEGIN
          LogDiskIOError (IORes,'[Squish] Unable to open Squish Index file '+CurrentBase+SQUISH_I_EXT);
          SquishOpenIndex:=FALSE; { failed }
          Exit;
     END;

     {$IFDEF LogFileIO}PostOpenF (SquishIndexF);{$ENDIF}

     SquishIndexLoadedStart := -1;

     { Count number of record sin file }
     SquishIndexCountEntries;
     {LogMessage (liDebug,'[Squish] Opened index "'+CurrentBase+'", '+Longint2String (SquishIndexNumb)+' entries');}

     { index is now open }
     SquishIndexIsOpen:=TRUE;

     { Cache the first 500 entries, but don't do it if we are just importing }
     { a message!                                                            }
     SquishIndexCacheEntries (1);
end;


{--------------------------------------------------------------------------}
{ SquishSaveIndex                                                          }
{                                                                          }
{ Herbouwdt de index op schijf, door de oude waardes terug te schrijven en }
{ de nieuwe eraan vast te plakken.                                         }
{                                                                          }
FUNCTION SquishSaveIndex : BOOLEAN;
BEGIN
     SquishSaveIndex:=TRUE;
     SquishCloseIndex;
END;


{--------------------------------------------------------------------------}
{ SquishLoadIndex                                                          }
{                                                                          }
{ Maakt geheugen vrij voor de Squish Index file, en laadt deze in.         }
{                                                                          }
FUNCTION SquishLoadIndex : BOOLEAN;
BEGIN
     SquishLoadIndex:=SquishOpenIndex;
END;


{--------------------------------------------------------------------------}
{ SquishReadIndex                                                          }
{                                                                          }
{ This routine reads the requested index entry from the index file.        }
{ Returns FALSE on error and TRUE on success. Entry 1 is the first         }
{ position in the index file.                                              }
{                                                                          }
FUNCTION SquishReadIndex (Entry : LONGINT; VAR Idx : _SqIdxType) : BOOLEAN;

VAR IORes : BYTE;

BEGIN
     SquishReadIndex:=FALSE; { assume failure }

     {## catch if called with 0?}
     IF (Entry > 0) THEN
        Dec (Entry);

     {$IFDEF INDEXDEBUG}
     LogMessage (liDebug, '[SquishReadIndex] Request entry ' + longint2string (entry));
     {$ENDIF}

     { Check to see if this entry is in memory }
     IF (SquishIndexLoadedStart <> -1) THEN
     BEGIN
          {$IFDEF INDEXDEBUG}
          LogMessage (liDebug, '[SquishReadIndex] Cached '+
               Longint2String (SquishIndexLoadedStart) + '..' +
               Longint2String (SquishIndexLoadedEnd));
          {$ENDIF}

          IF (Entry >= SquishIndexLoadedStart) AND (Entry < SquishIndexLoadedEnd) THEN
          BEGIN
               {$IFDEF INDEXDEBUG}
               LogMessage (liDebug, '[SquishReadIndex] Returned entry from cache');
               {$ENDIF}
               Idx := SquishIndex [Entry - SquishIndexLoadedStart+1];
               SquishReadIndex := True;
               Exit;
          END;
     END;

     IF (NOT SquishOpenIndex) THEN
     BEGIN
          LogMessage (liFatal,'[SquishReadIdx] Failed to open index');
          Exit;
     END;

     Seek (SquishIndexF,Entry*SizeOf (_SqIdxType));
     {$I-} BlockRead (SquishIndexF,Idx,SizeOf (_SqIdxType)); {$I+}
     IORes:=IOResult;

     {$IFDEF INDEXDEBUG}
     LogMessage (liDebug,'[SquishReadIndex] Entry #'+Longint2String (Entry)+
                         '@'+Longint2String (Entry*SizeOf(_SqIdxType))+
                         ', ofs='+Long2HexString (Idx.Ofs)+
                         ', uid='+Long2HexString (Idx.umsgid));
     {$ENDIF}

     IF (IORes <> 0) THEN
     BEGIN
          LogDiskIOError (IOres,'[Squish] Error reading index entry #'+Longint2String (Entry));
          Exit;
     End;

     { Re-cache the index if we've moved beyond the last block }
     IF (Entry >= SquishIndexLoadedEnd) THEN
          SquishIndexCacheEntries (Entry);

     {$IFDEF INDEXDEBUG}
     LogMessage (liDebug, '[SquishReadIndex] Returned entry from disk');
     {$ENDIF}

     SquishReadIndex:=TRUE; { success }
END;


{--------------------------------------------------------------------------}
{ SquishIndexCountEntries                                                  }
{                                                                          }
{ Counts the number of entries in the SQI file, ignoring blank entries at  }
{ the end of the file.                                                     }
{                                                                          }
{ (Either way, a function would have to be prototyped.  I chose to move    }
{ SquishReadIndex up here.)                                                }
procedure SquishIndexCountEntries;
var
   CurRec: longint;
   MaxRec: longint;
   x: _SqIdxType;
   IORes: integer;
begin

   MaxRec := FileSize (SquishIndexF) Div sizeof (_SQIDXType);
   {$IFDEF INDEXDEBUG}
   LogMessage (liDebug, '[SquishIndexCountEntries] Physical size '+longint2string(MaxRec));
   {$ENDIF}
   IF (MaxRec = 0) THEN
      SquishIndexNumb := 0
   ELSE BEGIN
   { Work backwards until we get a valid index entry }
      CurRec := MaxRec - 1;
      
      REPEAT
         {$I-} Seek (SquishIndexF, CurRec*sizeof(_SqIdxType)); IORes := IOResult; {$I+}
         IF IORes <> 0 THEN BEGIN
            LogMessage (liFatal, '[SquishIndexCountEntries] Seek error on record '+
                  longint2string (CurRec));
   
            SquishIndexNumb := 0;
            Exit;
         END;
   
         {$I-} BlockRead (SquishIndexF, X, Sizeof (X)); IORes := IOResult; {$I+}
         IF IORes <> 0 THEN BEGIN
            LogMessage (liFatal, '[SquishIndexCountEntries] Read error on record '+
                  longint2string (CurRec) + ' #'+integer2string(iores));
   
            SquishIndexNumb := 0;
            Exit;
         END;
   
         {$IFDEF INDEXDEBUG}
         LogMessage (liDebug, '[SquishIndexCountEntries] COUNT@'
               +longint2string (CurRec*Sizeof (_SqIdxType))+'//OFS='+
               longint2string (X.Ofs));
         {$ENDIF}
         
         IF (X.Ofs <> 0) THEN
            Break;
   
         {$IFDEF INDEXDEBUG}
         LogMessage (liDebug, '[SquishIndexCountEntries] Excluding blank entry at '
               +long2hexstring (CurRec*Sizeof (_SqIdxType)));
         {$ENDIF}
   
         DEC (CurRec);
      UNTIL CurRec < 0;

      SquishIndexNumb := CurRec+1;
   END;

   {$IFDEF INDEXDEBUG}
   LogMessage (liDebug, '[SquishIndexCountEntries] Logical size '+longint2string(SquishIndexNumb));
   {$ENDIF}
end;


{--------------------------------------------------------------------------}
{ SquishWriteIndex                                                         }
{                                                                          }
{ This routine writes the index entry to the requested position in the     }
{ index file. Position 1 is the first entry in the index file.             }
{                                                                          }
FUNCTION SquishWriteIndex (Entry: LONGINT; Idx : _SqIdxType) : BOOLEAN;

VAR IORes : BYTE;

    debug_IDX: _SQIDXType;

BEGIN
     SquishWriteIndex:=FALSE; { assume failure }

     {$IFDEF INDEXDEBUG}
     LogMessage (liDebug,'[SquishWriteIndex] Request entry '+Longint2String (Entry)+', Ofs='+Long2HexString (Idx.ofs));
     {$ENDIF}

     IF (Entry < 0) THEN
        Entry := 0;

     IF (Entry > 0) THEN
        Dec (Entry);

     {$IFDEF INDEXDEBUG}
     LogMessage (liDebug, '[SquishWriteIndex] Entry: '+longint2string(Entry)+', SIN: '+
            longint2string(SquishIndexNumb));
     {$ENDIF}

     IF (NOT SquishOpenIndex) THEN
     BEGIN
          LogMessage (liFatal,'[SquishWriteIndex] Unable to open index file');
          Exit;
     END;

     {$IFDEF INDEXDEBUG}
     LogMessage (liDebug, '[SquishWriteIndex] Seeking to entry #'+
         longint2string(Entry));

     LogMessage (liDebug, '[SquishWriteIndex] Pre-seek filesize is ' +
            longint2string (FileSize (SquishIndexF)) + '{'+
            longint2string (FileSize (SquishIndexF) div 12) +'}');
     {$ENDIF}

     Seek (SquishIndexF,Entry*SizeOf (_SqIdxType));

     {$I-} Blockwrite (SquishIndexF,Idx,SizeOf (_SqIdxType)); {$I+}

     {$IFDEF INDEXDEBUG}
     LogMessage (liDebug, '[SquishWriteIndex] PostWrte filesize is ' +
            longint2string (FileSize (SquishIndexF)));
     {$ENDIF}

     IORes:=IOResult;

     {$IFDEF INDEXDEBUG}
     LogMessage (liDebug,'[SquishWriteIndex] Entry #'+Longint2String (Entry)+
                         '@'+longint2string (Entry*SizeOf(_SqIdxType))+
                         ', ofs='+Long2HexString (Idx.ofs)+
                         ', uid='+Long2HexString (Idx.umsgid));
     {$ENDIF}

     IF (IORes <> 0) THEN
     BEGIN
          LogDiskIOError (IORes,'[Squish] Error writing index entry #'+Longint2String (Entry));
          Exit;
     END;

     inc (SquishIndexNumb);

     { If this entry is in memory, update it directly }
     IF (Entry >= SquishIndexLoadedStart) AND (Entry < SquishIndexLoadedEnd) THEN
          SquishIndex [Entry - SquishIndexLoadedStart+1] := Idx;

     { Don't bother reloading from disk .. we probably won't read this }
     { message again for quite some time (and can always reload then)  }

     SquishWriteIndex:=TRUE; { success }
END;


{--------------------------------------------------------------------------}
{ SquishDeleteFromIndex                                                    }
{                                                                          }
{ Deletes the message where CurrentFrame points to from the index.         }
{ Returns TRUE on success, FALSE on failure.                               }
{ Strategy: create a new index file and copy all entries from the old file }
{ except for the one where Idx.Ofs == CurrentFrame.                        }
{                                                                          }
FUNCTION SquishDeleteFromIndex : BOOLEAN;

{## could optimise this by reading and writing an array of index }
{   entries at a time based on the amount of memory available.   }

VAR Lp       : LONGINT;
    Idx      : _SqIdxType;
    NewIndex : FILE;
    IORes    : BYTE;

BEGIN
     SquishDeleteFromIndex:=FALSE;

     IF (NOT SquishOpenIndex) THEN
     BEGIN
          LogMessage (liFatal,'[SquishDelFromIdx] Failed to open index file');
          Exit;
     END;

     Assign (NewIndex,CurrentBase+'.S$I');
     {$I-} Rewrite (NewIndex,1); {$I+} IORes:=IOResult;
     IF (IORes <> 0) THEN
     BEGIN
          LogDiskIOError (IORes,'[Squish] Unable to open index file; aborting');
          Exit;
     END;

     {$IFDEF LogFileIO}PostOpenF (NewIndex);{$ENDIF}

     {$IFDEF INDEXDEBUG}
     LogExtraMessage ('[DELETE] Have entries: ' + longint2string (SquishIndexNumb));
     {$ENDIF}

     FOR Lp:=1 TO SquishIndexNumb DO
     BEGIN
          IF (NOT SquishReadIndex (Lp,Idx)) THEN
          BEGIN
               LogMessage (liFatal,'[SquishDelFromIdx] Error reading entry '+Longint2String (Lp)+'; aborting');
               Close (NewIndex);
               Erase (NewIndex);
               Exit;
          END;

          {$IFDEF INDEXDEBUG}
          LogMessage (liDebug,'Delete OFS='+Long2HexString (Idx.ofs));
          {$ENDIF}

          IF (Idx.ofs <> CurrentFrame) THEN
          BEGIN
               { not the one we are looking for - write it to the }
               { new index file.                                  }

               {$I-} BlockWrite (NewIndex,Idx,SizeOf (Idx)); {$I+}
               IORes:=IOResult;
               IF (IORes <> 0) THEN
               BEGIN
                    LogMessage (liFatal,'[SquishDelFromIdx] Error writing to new index');
                    Close (NewIndex);
                    Erase (NewIndex);

                    Exit; { ## EXIT ## }
               END;
          END;
     END; { for }

     { close the new and old index files }
     Close (NewIndex);
     SquishCloseIndex;

     { remove the old index file }
     Erase (SquishIndexF);

     {$I-} Rename (NewIndex,CurrentBase+'.SQI'); {$I+}
     IORes:=IOResult;
     IF (IORes <> 0) THEN
     BEGIN
          LogMessage (liFatal,'Error renaming new index to '+CurrentBase+'.SQI');
          Exit;
     END;

     {## why do this?}
     IF (NOT SquishOpenIndex) THEN
     BEGIN
          LogMessage (liFatal,'[SquishDelFromIdx] Fail to to re-load index');
          Exit;
     END;

     SquishDeleteFromIndex:=TRUE;
END;


{--------------------------------------------------------------------------}
{ SquishAddToIndex                                                         }
{                                                                          }
{ This routine adds a new entry to the index.                              }
{                                                                          }
PROCEDURE SquishAddToIndex (HashValue : LONGINT; MsgId : LONGINT);

VAR Idx : _SqIdxType;

BEGIN
     IF (NOT SquishOpenIndex) THEN
     BEGIN
          LogMessage (liFatal,'[SquishAddToIdx] Failed to open index');
          Exit;
     END;

     WITH Idx DO
     BEGIN
          Ofs:=CurrentFrame;
          UMsgId:=MsgId;
          Hash:=HashValue;
     END; { with }

     {$IFDEF INDEXDEBUG}
     LogMessage (liDebug, '[SquishAddToIndex] OFS='+long2hexstring(idx.ofs)+
               ', SIN='+longint2string(squishindexnumb)+', IFS='+
                     longint2string(squishindexnumb*sizeof(_sqidxtype)));
     {$ENDIF}

     IF (NOT SquishWriteIndex (SquishIndexNumb+1,Idx)) THEN
        LogMessage (liFatal,'[Squish] Failed to write new index entry');
END;


{--------------------------------------------------------------------------}
{ LoadSquishHeaders                                                        }
{                                                                          }
{ Laadt de Base header van een Squish area in het geheugen.                }
{                                                                          }
FUNCTION SquishLoadHeader : BOOLEAN;

VAR Size : WORD;

BEGIN
     SquishLoadHeader:=FALSE;

     CalcMaxAllowedMem (Size,1024,8192);

     IF (NOT FBufferOpen (SquishBaseF,CurrentBase+SQUISH_D_EXT,Size,0)) THEN
     BEGIN
          LogExtraMessage ('[LoadSquishHeader] Unable to open header for '+CurrentBase);
          FBufferClose (SquishBaseF);
          Exit;
     END;

     IF (NOT FBBlockRead (SquishBaseF,SquishBase,SizeOf (SquishBase))) THEN
     BEGIN
          LogExtraMessage ('[LoadSquishHeader] Unable to read header for '+CurrentBase);
          FBufferClose (SquishBaseF);
          Exit;
     END;

     SquishLoadHeader:=TRUE;
END;


{--------------------------------------------------------------------------}
{ SquishLockBase                                                           }
{                                                                          }
{ Probeert een lock af te dwingen van de Squish base file.                 }
{                                                                          }
FUNCTION SquishLockBase : BOOLEAN;

VAR LockTry : WORD;

BEGIN
     { simpel, no fuss }
     SquishLockBase:=TRUE; { assume it worked }

     IF LockFile (SquishBaseF.Bestand) THEN
        Exit;

     { Problem! }
     Message ('Squish! Found '+CurrentBase+' locked, retrying');

     FOR LockTry:=1 TO SquishBaseMaximumLockTrys DO
     BEGIN
          IF LockFile (SquishBaseF.Bestand) THEN
             Break;

          Slice_Now;
          DelayOneSecond;
     END;

     WindowPop; { Haal bericht weg }

     { Als het niet gelukt is , geef dat dan ff door }
     IF (LockTry >= SquishBaseMaximumLockTrys) THEN
        SquishLockBase:=FALSE;
END;


{--------------------------------------------------------------------------}
{ UnlockBase                                                               }
{                                                                          }
{ Geeft de Squish Base weer vrij voor andere programma's.                  }
{                                                                          }
FUNCTION SquishUnlockBase : BOOLEAN;
BEGIN
     SquishUnlockBase:=UnlockFile (SquishBaseF.Bestand);
END;


{--------------------------------------------------------------------------}
{ CloseBase                                                                }
{                                                                          }
{ This routine closes the base opened by this object by saving the index,  }
{ updating the header and closing the files in use.                        }
{                                                                          }
PROCEDURE CloseBase;
BEGIN
     IF (CurrentBase = '') THEN
        Exit;

     SquishSaveIndex;

     { Update de header }
     SquishUpdateHeader;

     { sluit de files }
     FBufferClose (SquishBaseF);

     CurrentBase:='';
END;


{--------------------------------------------------------------------------}
{ OpenBase                                                                 }
{                                                                          }
{ This routine opens the Squish Message base pointed to by Path. If it     }
{ does not exist, then an attempt is made to create it. If this fails, the }
{ function returns FALSE, otherwise TRUE.                                  }
{                                                                          }
FUNCTION OpenBase (Path,AreaName_F : STRING; AllowCreate : BOOLEAN) : BOOLEAN;

VAR ZoekFile : SearchRec;
    DR       : INTEGER;

BEGIN
     OpenBase:=FALSE; { assume failure }

     IF (Path = '') THEN
     BEGIN
          LogMessage (liConfig,'[Squish] Path missing for '+AreaName_F);
          Exit;
     END;

     { Kijk of de area al geladen is, dan kunnen we gewoon doorstarten }
     IF (CurrentBase <> Path) THEN
     BEGIN
          SquishCloseIndex;
     
          { keep track of changes during operations }
          Inc (TouchCounter);

          CloseBase;

          { controleer of het bestand wel bestaat }
          FindFirst (Path+SQUISH_D_EXT,$3C,ZoekFile);
          DR:=DosError;
          FindClose (ZoekFile);

          IF (DR = 3) THEN
          BEGIN
               LogMessage (liFatal,'[Squish] Path not found: '+Path);
               LogExtraMessage ('Area '+AreaName_F);
               Exit;
          END;

          IF (DR IN [2,18]) THEN
          BEGIN
               IF (NOT AllowCreate) THEN
               BEGIN
                    LogMessage (liTrivial,'Squish base does not exist; skipping');
                    Exit;
               END;

               CurrentBase:=Path;

               LogMessage (liGeneral,'Creating Squish base '+CurrentBase);

               IF (NOT CreateBase) THEN
               BEGIN
                    CurrentBase:='';
                    Exit;
               END;

               DR:=0; { avoid triggering on the next statement }
          END;

          IF (DR <> 0) THEN
          BEGIN
               LogDiskIOError (DR,'[Squish] Failed to open '+Path);
               Exit;
          END;

          { De file bestaat dus wel; probeer hem maar gewoon te openen }
          CurrentBase:=Path;

          IF (NOT SquishLoadHeader) THEN
          BEGIN
               CurrentBase:='';
               Exit;
          END;

          IF (NOT SquishOpenIndex) THEN
          BEGIN
               FBufferClose (SquishBaseF); { RAWI980521: was left open! }
               CurrentBase:='';
               Exit;
          END;
     END;

     FBSeek (SquishBaseF,0);
     CurrentFrame:=NULLFRAME; { SquishBase.Begin_Frame }

     OpenBase:=TRUE;
END;


{--------------------------------------------------------------------------}
{ SquishLoadFrame                                                          }
{                                                                          }
{ Loads a frame from the .SQD file and returns it in the first argument.   }
{ The frame to load is indicated in the second argument. After loading,    }
{ the frame ID is checked. If the frame number was valid, it was loaded    }
{ properly and the ID is correct, then TRUE is returned, otherwise FALSE.  }
{                                                                          }
FUNCTION SquishLoadFrame (VAR Frame : _SqfHdrType; FrameNr : LONGINT) : BOOLEAN;
BEGIN
     SquishLoadFrame:=FALSE; { assume failure }

     IF (FrameNr = NULLFRAME) THEN
        Exit;

     IF (NOT FBSeek (SquishBaseF,FrameNr)) OR
        (NOT FBBlockRead (SquishBaseF,Frame,SizeOf (Frame))) THEN
     BEGIN
          LogExtraMessage ('[Squish] Error loading frame from '+CurrentBase+SQUISH_D_EXT);
          Exit;
     END;

     { Controleer de integriteit van het frame             }
     { Dit is belangrijk, als het frame niet klopt moet de }
     { areabase opnieuw opgebouwd worden.                  }
     IF (Frame.ID <> SQHDRID) THEN
     BEGIN
          LogMessage (liFatal,'[Squish] Corrupted frame found! Please rebuild '+CurrentBase);
          Exit;
     END;

     SquishLoadFrame:=TRUE; { success }
END;


{--------------------------------------------------------------------------}
{ SquishSaveFrame                                                          }
{                                                                          }
{ Bewaard het huidige frame op de positie aangegeven door CurrentFrame.    }
{                                                                          }
FUNCTION SquishSaveFrame (VAR Frame : _SqfHdrType; FrameNr : LONGINT) : BOOLEAN;
BEGIN
     SquishSaveFrame:=FALSE;

     IF (Frame.Id <> SQHDRID) THEN
     BEGIN
          LogMessage (liFatal,'[Squish] Not saving corrupted frame!');
          Exit;
     END;

     IF FBSeekWrite (SquishBaseF,FrameNr,Frame,SizeOf (_SqfHdrType)) THEN
        SquishSaveFrame:=TRUE
     ELSE
         LogExtraMessage ('[Squish] Error saving frame');
END;


{--------------------------------------------------------------------------}
{ SquishLoadFrameType                                                      }
{                                                                          }
{ Deze routine kan een Squish frame naar keuze inladen:                    }
{                                                                          }
{ SQ_FIRST: Eerste gebruikte frame                                         }
{ SQ_LAST: Laatste gebruikte frame                                         }
{ SQ_PREV: Vorige frame in chain                                           }
{ SQ_NEXT: Volgende frame in chain                                         }
{                                                                          }
{ Returns TRUE on success, FALSE on error or no more frames.               }
{                                                                          }
FUNCTION SquishLoadFrameType (Frame : FrameType) : BOOLEAN;
BEGIN
     CASE Frame OF
          SQ_NEXT  : CurrentFrame:=SquishFrameHdr.Next_Frame;
          SQ_FIRST : CurrentFrame:=SquishBase.Begin_Frame;
          SQ_PREV  : CurrentFrame:=SquishFrameHdr.Prev_Frame;
          SQ_LAST  : CurrentFrame:=SquishBase.Last_Frame;
     END;

     SquishLoadFrameType:=SquishLoadFrame (SquishFrameHdr,CurrentFrame);
END;


{--------------------------------------------------------------------------}
{ SquishLoadMsgHdr                                                         }
{                                                                          }
{ This routine loads the header for the given frame from the base.         }
{                                                                          }
FUNCTION SquishLoadMsgHdr (BelongingFrame : LONGINT) : BOOLEAN;
BEGIN
     IF FBSeek (SquishBaseF,BelongingFrame+SizeOf (_SQFHDRTYPE)) AND
        FBBlockRead (SquishBaseF,SquishMsgHdr,SizeOf (_SQMHDRTYPE))
     THEN
         SquishLoadMsgHdr:=TRUE
     ELSE BEGIN
          LogExtraMessage ('[Squish] Error loading msg header (1)');
          SquishLoadMsgHdr:=FALSE;
     END;
END;


{ -------------------------------------------------------------------------}
{ SquishSaveMsgHeader                                                      }
{                                                                          }
{ Update/Creert de huidige bericht informatie                              }
{                                                                          }
FUNCTION SquishSaveMsgHdr (BelongingFrame : LONGINT) : BOOLEAN;

VAR IORes : BYTE;

BEGIN
     LastWritePos:=BelongingFrame+SizeOf (_SQFHDRTYPE);

     IF FBSeekWrite (SquishBaseF,LastWritePos,SquishMsgHdr,SizeOf (_SQMHDRTYPE)) THEN
        SquishSaveMsgHdr:=TRUE
     ELSE BEGIN
          LogExtraMessage ('[Squish] Error saving msg header');
          SquishSaveMsgHdr:=FALSE;
     END;

     { FBSeekWrite has updated LastWritePos now }
END;


{--------------------------------------------------------------------------}
{ SquishUnlinkFrame                                                        }
{                                                                          }
{ Verwijder een frame uit de link door de voorgaande en volgende frames    }
{ aan elkaar te linken.                                                    }
{                                                                          }
FUNCTION SquishUnlinkFrame : BOOLEAN;

VAR PrevFrame,
    NextFrame : _SqfHdrType;

BEGIN
     SquishUnlinkFrame:=TRUE;

     IF (SquishFrameHdr.Prev_Frame <> NULLFRAME) THEN
        IF SquishLoadFrame (PrevFrame,SquishFrameHdr.Prev_Frame) THEN
        BEGIN
             PrevFrame.Next_Frame:=SquishFrameHdr.Next_Frame;
             SquishUnlinkFrame:=SquishSaveFrame (PrevFrame,SquishFrameHdr.Prev_Frame);
        END;

     IF (SquishFrameHdr.Next_Frame <> NULLFRAME) THEN
        IF SquishLoadFrame (NextFrame,SquishFrameHdr.Next_Frame) THEN
        BEGIN
             NextFrame.Prev_Frame:=SquishFrameHdr.Prev_Frame;
             SquishUnlinkFrame:=SquishSaveFrame (NextFrame,SquishFrameHdr.Next_Frame);
        END;
END;


{--------------------------------------------------------------------------}
{ SquishFreeFrame                                                          }
{                                                                          }
{ Probeert het huidige frame op non-actief te stellen.                     }
{ Dit komt dus neer op het deleten van een bericht.                        }
{ Let erop dat ook de index bijgewerkt moet worden.                        }
{                                                                          }
FUNCTION SquishFreeFrame : BOOLEAN;

VAR LastFrame : _SqfHdrType;

BEGIN
     { Verwijder het frame uit de lijst }
     IF (NOT SquishUnlinkFrame) THEN
     BEGIN
          LogMessage (liFatal,'[SquishFreeFrame] Error unlinking frame');
          Exit;
     END;

     { kijk of de header geupdate moet worden }
     IF (SquishBase.Begin_Frame = CurrentFrame) THEN
        SquishBase.Begin_Frame:=SquishFrameHdr.Next_Frame;

     IF (SquishBase.Last_Frame = CurrentFrame) THEN
        SquishBase.Last_Frame:=SquishFrameHdr.Prev_Frame;

     { Ok , en nu gebeurd het dus ..... }
     SquishFrameHdr.Frame_Type:=FRAME_FREE;

     { Als er nog geen gedelete berichten zijn kunnen we 'm direct aan }
     { het begin toevoegen.                                            }
     IF (SquishBase.First_Free = NULLFRAME) THEN
     BEGIN
          SquishBase.First_Free:=CurrentFrame;
          SquishBase.Last_Free:=CurrentFrame;
          SquishFrameHdr.Prev_Frame:=NULLFRAME;
          SquishFrameHdr.Next_Frame:=NULLFRAME;
     END ELSE
     BEGIN
          { Lees anders het laatste frame in en plak ons daaraan }
          IF SquishLoadFrame (LastFrame,SquishBase.Last_Free) THEN
          BEGIN
               { link het voormalig laatste frame door naar het huidige }
               LastFrame.Next_Frame:=CurrentFrame;
               SquishSaveFrame (LastFrame,SquishBase.Last_Free);

               { en update het huidige frame }
               SquishFrameHdr.Prev_Frame:=SquishBase.Last_Free;
               SquishFrameHdr.Next_Frame:=NULLFRAME;
               SquishBase.Last_Free:=CurrentFrame;
          END;
     END;

     { en bewaar het huidige frame met nieuwe links op disk }
     SquishSaveFrame (SquishFrameHdr,CurrentFrame);
END;

(*
{--------------------------------------------------------------------------}
{ SquishFindFreeFrame                                                      }
{                                                                          }
{ Zoekt een frame dat niet meer in gebruik is van geschikte lengte, of als }
{ dat niet meer mogenlijk is , wijst naar het einde van het veld.          }
{                                                                          }
FUNCTION SquishMBase.SquishFindFreeFrame (NeededSize : LONGINT) : BOOLEAN;

VAR FreeEntry : LONGINT;

BEGIN
     { Init }
     SquishFindFreeFrame:=TRUE;

     { doorloopt de gelinkte lijst met alle vrije records }
     CurrentFrame:=SquishBase.First_Free;

     WHILE (CurrentFrame <> NULLFRAME) DO
     BEGIN
          { Een leeg frame gevonden, laadt het }
          IF (NOT SquishLoadFrame (SquishFrameHdr,CurrentFrame)) THEN
          BEGIN
               LogMessage (liFatal,'[Squish] Error loading free frame');
               Exit;
          END;

          { Kijk of het gevonden frame groot genoeg is }
          IF (NeededSize < SquishFrameHdr.Frame_Length) THEN
             Break
          ELSE
              CurrentFrame:=SquishFrameHdr.Next_Frame;
     END; { while }

     { Niet gevonden, dan maar aan het einde toevoegen }
     IF (CurrentFrame = NULLFRAME) THEN
     BEGIN
          CurrentFrame:=SquishBase.End_Frame;
          Exit;
     END;

     { wel gevonden }
     SquishUnlinkFrame;

     { update Base header als dat nodig is }
     IF (SquishFrameHdr.Prev_Frame = NULLFRAME) THEN
        SquishBase.First_Free:=SquishFrameHdr.Next_Frame;

     IF (SquishFrameHdr.Next_Frame = NULLFRAME) THEN
        SquishBase.Last_Free:=SquishFrameHdr.Prev_Frame;

     SquishFindFreeFrame:=TRUE;
END;


{--------------------------------------------------------------------------}
{ SquishNewFrame                                                           }
{                                                                          }
{ Zoekt een leeg frame van de benodigde grootte , en plakt daar een nieuw  }
{ frame aan vast, of plak een nieuwe frame aan het einde van de de base    }
{                                                                          }
{ Let op! SquishBase.End_Frame moet evt na het schrijven van het bericht   }
{ worden geupdate !                                                        }
{                                                                          }
FUNCTION SquishMBase.SquishNewFrame (NeededSize : LONGINT) : BOOLEAN;

VAR TempFrame : _SQFHdrType;

BEGIN
     SquishNewFrame:=FALSE;

     IF (NOT SquishFindFreeFrame (NeededSize)) THEN
     BEGIN
          LogMessage ('[SquishNewFrame] Error while searching for a free frame');
          Exit;
     END;

     { CurrentFrame staat nu op de plaats waar we een nieuw record kunnen }
     { gaan schrijven.                                                    }

     IF (SquishBase.Last_Frame <> NULLFRAME) THEN
     BEGIN
          IF SquishLoadFrame (TempFrame,SquishBase.Last_Frame) THEN
          BEGIN
               TempFrame.Next_Frame:=CurrentFrame;
               SquishNewFrame:=SquishSaveFrame (TempFrame,SquishBase.Last_Frame);
          END;
     END ELSE
         SquishBase.Begin_Frame:=CurrentFrame;

     { zorg dat het huidige frame aan het einde van de lijst wordt toegevoegd }
     SquishFrameHdr.Id:=SQHDRID;
     SquishFrameHdr.Frame_Type:=FRAME_msg;
     SquishFrameHdr.Prev_Frame:=SquishBase.Last_Frame;
     SquishFrameHdr.Next_Frame:=NULLFRAME;

     SquishBase.Last_Frame:=CurrentFrame;

     { als dit een nieuwe frame is }
     IF (CurrentFrame = SquishBase.End_Frame) THEN
        SquishFrameHdr.Frame_Length:=NeededSize;

     SquishNewFrame:=SquishSaveFrame (SquishFrameHdr,CurrentFrame);
END;
*)


{--------------------------------------------------------------------------}
{ AddNewFrame                                                              }
{                                                                          }
{ This routine starts a new frame at the end of the message base. After    }
{ this call, CurrentFrame points to the location where this new frame      }
{ starts. The frame header has already been written to disk, but not all   }
{ fields are filled in yet.                                                }
{                                                                          }
PROCEDURE AddNewFrame;

VAR TempFrame : _SQFHdrType;

BEGIN
     { point CurrentFrame to where we want to add a new frame }
     CurrentFrame:=SquishBase.End_Frame;

     { link the new frame to the last frame in the base }
     IF (SquishBase.Last_Frame <> NULLFRAME) THEN
     BEGIN
          IF SquishLoadFrame (TempFrame,SquishBase.Last_Frame) THEN
          BEGIN
               TempFrame.Next_Frame:=CurrentFrame;
               SquishSaveFrame (TempFrame,SquishBase.Last_Frame);
          END;
     END ELSE
         SquishBase.Begin_Frame:=CurrentFrame;

     { zorg dat het huidige frame aan het einde van de lijst wordt toegevoegd }
     SquishFrameHdr.Id:=SQHDRID;
     SquishFrameHdr.Frame_Type:=FRAME_msg;
     SquishFrameHdr.Prev_Frame:=SquishBase.Last_Frame;
     SquishFrameHdr.Next_Frame:=NULLFRAME;

     SquishBase.Last_Frame:=CurrentFrame;

     SquishFrameHdr.Frame_Length:=0; { needs to be filled in later!! }

     SquishSaveFrame (SquishFrameHdr,CurrentFrame);
END;


{--------------------------------------------------------------------------}
{ Index Routines                                                           }
{--------------------------------------------------------------------------}


{--------------------------------------------------------------------------}
{ SquishIDXSearchByTOName                                                  }
{                                                                          }
{ Searches the index for the given to-name. Can start searching from       }
{ CurrentFrame (Search_Entry is NEXT_ENTRY) or the start (SearchEntry is   }
{ FIRST_ENTRY) of the index. Returns TRUE if found or FALSE if found not.  }
{ If found the related frame header is loaded and CurrentFrame will hold   }
{ its offset.                                                              }
{                                                                          }
FUNCTION SquishIDXSearchByTOName (Name : STRING; Search_Entry : SearchType) : BOOLEAN;

VAR Hash,
    Start,
    Lp    : LONGINT;
    Idx   : _SqIdxType;

BEGIN
     { Init }
     SquishIDXSearchByTOName:=FALSE;

     IF (NOT SquishOpenIndex) THEN
     BEGIN
          LogMessage (liFatal,'[SquishIdxSearchByToName] Failed to open index; search failed');
          Exit;
     END;

     { Converteer de Naam naar de gewenste HASH waarde }
     Hash:=SquishNameToHash (Name);

     IF (Search_Entry = FIRST_ENTRY) THEN
        Start:=1
     ELSE
         Start:=CurrentFrame;

     {## load blocks from the index to speed things up?}
     FOR Lp:=Start TO SquishIndexNumb DO
     BEGIN
          IF (NOT SquishReadIndex (Lp,Idx)) THEN
          BEGIN
               LogMessage (liFatal,'[SquishIdxSearchByToName] Error reading from index; aborting');
               Exit;
          END;

          IF (Idx.Hash = Hash) THEN
          BEGIN
               { found! Load the frame }
               CurrentFrame:=Idx.Ofs ;
               SquishIDXSearchByTOName:=SquishLoadFrame (SquishFrameHdr,CurrentFrame);
               Exit;
          END;
     END;
END;


{--------------------------------------------------------------------------}
{ SquishIDXSearchByMSGID                                                   }
{                                                                          }
{ Zoekt naar berichten via de MSGID sleutel in de Index.                   }
{                                                                          }
FUNCTION SquishIDXSearchByMSGID (MSGID : UMSGID_Type) : BOOLEAN;

VAR Lp  : LONGINT;
    Idx : _SqIdxType;

BEGIN
     SquishIDXSearchByMSGID:=FALSE;

     IF (NOT SquishOpenIndex) THEN
     BEGIN
          LogMessage (liFatal,'[SquishIdxSearchByMsgId] Failed to open index file');
          Exit;
     END;

     PurgeLR_IndexTel:=0; { niet gevonden }

     {## load blocks from the index to speed things up?}
     FOR Lp:=1 TO SquishIndexNumb DO
     BEGIN
          IF (NOT SquishReadIndex (Lp,Idx)) THEN
          BEGIN
               LogMessage (liFatal,'[SquishIdxSearchByToName] Error reading from index; aborting');
               Exit;
          END;

          IF (Idx.UMsgId = MSGID) THEN
          BEGIN
               { found! Load the frame }
               CurrentFrame:=Idx.Ofs;
               PurgeLR_IndexTel:=Lp;
               SquishIDXSearchByMsgId:=SquishLoadFrame (SquishFrameHdr,CurrentFrame);

               Exit; { ## EXIT ## }
          END;
     END; { for }
END;


{--------------------------------------------------------------------------}
{ SquishIDXSearchByFrameNumber                                             }
{                                                                          }
{ This routine searches the index for the given frame number, matching     }
{ idx.ofs == FramePos. If found it returns the umsgid field from the same  }
{ index entry and the function returns the number of the index record.     }
{ Zero is return if the frame could not be found.                          }
{                                                                          }
FUNCTION SquishIDXSearchByFrameNumber (FramePos : LONGINT; VAR MsgId : UMSGID_Type) : LONGINT;

VAR Lp  : LONGINT;
    Idx : _SqIdxType;

BEGIN
     MsgID:=0;

     IF (NOT SquishOpenIndex) THEN
     BEGIN
          LogMessage (liFatal,'[SquishIdxSearchByMsgId] Failed to open index file');
          Exit;
     END;

     {## load blocks from the index to speed things up?}
     FOR Lp:=1 TO SquishIndexNumb DO
     BEGIN
          IF (NOT SquishReadIndex (Lp,Idx)) THEN
          BEGIN
               LogMessage (liFatal,'[SquishIdxSearchByFrameNr] Error reading from index; aborting');
               Break; { from the for loop }
          END;

          IF (Idx.Ofs = FramePos) THEN
          BEGIN
              { found! Return index position and umsgid field }
              SquishIDXSearchByFrameNumber:=Lp;
              MsgId:=Idx.UMsgId;

              Exit; { ## EXIT ## }
         END;
     END; { for }

     SquishIDXSearchByFrameNumber:=0; { not found }
END;


{--------------------------------------------------------------------------}
{ SecondLevel Routines                                                     }
{--------------------------------------------------------------------------}


{--------------------------------------------------------------------------}
{ DeleteMessage                                                            }
{                                                                          }
{ This routine deletes a message from the message base by removing it from }
{ the index and unlinking its frame and adding it to the free list.        }
{ CurrentFrame must point to the frame to remove.                          }
{                                                                          }
PROCEDURE DeleteMessage;
BEGIN
     { remove index entry pointing to CurrentFrame from the index }
      {$IFDEF INDEXDEBUG}
      LogMessage (liDebug, '[Squish Delete] Request delete of ' + long2hexstring(CurrentFrame));
      {$ENDIF}

     SquishDeleteFromIndex;

     { move the CurrentFrame frame out of the message chain and }
     { into the free chain.                                     }
     SquishFreeFrame;

     { update the header with the new nr of messages }
     Dec (SquishBase.Num_Msg);
     Dec (SquishBase.High_Msg);
END;


(*
{--------------------------------------------------------------------------}
{ SquishReadLn                                                             }
{                                                                          }
{ Geeft een tekstregel uit 'Source', de functie geeft False als er geen    }
{ regels meer over zijn.                                                   }
{                                                                          }
FUNCTION SquishReadLn (VAR Cache : SquishCacheBufType; VAR Regel : STRING) : BOOLEAN;

    { deze routine gaat er vanuit dat er niets meer opgeslagen is }
    PROCEDURE ReadNow;
    BEGIN
          { lees vanaf waar we de vorige keer gestopt zijn }
          Seek (SquishBaseF,Cache.Buffer,Cache.ReadPos);

          BlockRead (SquishBaseF,Cache.Buffer

          { bewaar de positie voor de volgende keer }
          Cache.ReadPos:=FilePos (SquishBaseF);
    END;


VAR Loc : LONGINT;

BEGIN
     { inladen als er niets meer over is }
     IF (Cache.InBuf = 0) THEN
     BEGIN
     END;

     Loc:=Source.GetPos;

     IF (Source.Buffer^[Loc] = #0) THEN
     BEGIN
          Regel:=#0;
          SquishReadLn:=FALSE; { einde }
          Exit;
     END;

     IF (Source.Buffer^[Loc] = #1) THEN
     BEGIN
          { header regel. Die loopt tot de volgende #1 of tot een #0 }

          REPEAT
                Inc (Loc); { eerste keer gaat ie zo over de #1 heen }
          UNTIL (Loc > Source.BufLen) OR
                ((Loc-Source.GetPos) = 254) OR
                (Source.Buffer^[Loc] IN [#0,#1]);
     END ELSE
     BEGIN
          { nu gaat het om een 'gewone' regel die beeindigd wordt door een }
          { #13 of een #0 }
          REPEAT
                Inc (Loc);
          UNTIL (Loc > Source.BufLen) OR
                ((Loc-Source.GetPos) = 254) OR
                (Source.Buffer^[Loc] IN [#0,#13]);

          IF (Source.Buffer^[Loc] = #13) THEN
             Inc (Loc); { afsluitende CR meenemen }
     END;

     Move (Source.Buffer^[Source.GetPos],Regel[1],Loc-Source.GetPos);
     Regel[0]:=Chr (Loc-Source.GetPos);
     Source.GetPos:=Loc;
     SquishReadLn:=NOT (Source.GetPos >= Source.BufLen);
END;
*)


{--------------------------------------------------------------------------}
{ Squish_ScanArea                                                          }
{                                                                          }
{ Leest een bericht uit de squish base, en kijkt of het geexporteerd kan   }
{ worden. Zoja, start de hele malle molen om berichten te kunnen           }
{ exporteren.                                                              }
{                                                                          }
{ De routine krijgt het te scannen area record meegeleverd.                }
{                                                                          }
PROCEDURE Squish_ScanArea (AreaRecNr            : AreaBaseRecordNrType;
                           AreaRec              : AreaBaseRecord;
                           IsPrimaryNetmailArea : BOOLEAN;
                           IsBadArea            : BOOLEAN);

VAR LocalFido       : FidoAddrType;
    Einde           : BOOLEAN;
    DT              : DateTime;
    UserName        : STRING[MaxLenUserName_F];
    LastRegel,
    Regel           : STRING;
    WhereTo         : WhereToType;
    SquishNextFrame : LONGINT;
    Nop             : UMSGID_Type;
    FirstExport     : BOOLEAN;
    P               : BYTE;
    Result          : ScanDeliverResultType;

    PrevTouch       : BYTE;
    OldCurrentFrame : LONGINT;

    OldFramePos     : LONGINT;
    OldFrameBU      : LONGINT;
    OldBaseName     : STRING;
    OldCurrentBase  : STRING;
    OldUID          : UMSGID_TYPE;

LABEL Verder,
      CloseIt;

BEGIN
     FirstExport:=(NOT IsBadArea); { no additional logging when exporting from BAD }

     { open de Squish message area }
     IF (NOT OpenBase (AreaRec.FidoMsgPath,AreaRec.AreaName_F,TRUE)) THEN
        Exit;

     UpdateReadFile (AreaRec.FidoMsgPath,0);

     { Als dit een nieuwe area is hoeven we 'm natuurlijk ook niet te }
     { scannen. Kijk of er uberhaupt wel berichten in de area staan.  }
     IF (SquishBase.Num_Msg = 0) THEN
     BEGIN
          IF (CurrentBase <> '') THEN
             GOTO CloseIt;
     END;

     { houdt de stats bij van de lokale gebieden }
     {## needs replacing! }
     UserDataRecNr:=NILRecordNr;

     {## what protects us from other utilities deleting messages }
     {   while we are scanning the base?                         }

     { scan the area from the high watermark and onwards }
     REPEAT
           { Laadt het juiste frame }
           IF (CurrentFrame = NULLFRAME{Set by InitSquishArea}) THEN
           BEGIN
                { Start scannen van de area op de highwater mark }
                { Dit scheelt het doorlopen van de totale area   }
                IF (NOT ForceCleanScan) AND (NOT IsBadArea) AND (SquishBase.High_Water > 0) THEN
                BEGIN
                     IF (NOT SquishIDXSearchByMsgID (SquishBase.High_Water)) THEN
                        SquishLoadFrameType (SQ_FIRST);
                END ELSE
                    { Geen geldige HighWaterMark }
                    SquishLoadFrameType (SQ_FIRST);
           END ELSE
               SquishLoadFrameType (SQ_NEXT);

           { Bewaar de frame header voor het geval dat we het bericht }
           { deleten.                                                 }
           SquishNextFrame:=SquishFrameHdr.Next_Frame;

           { laad de fidoheader }
           IF (NOT SquishLoadMsgHdr (CurrentFrame)) THEN
              GOTO CloseIt; { RWI 960417 }

           IF (NOT IsBadArea) THEN
           BEGIN
                { Controleer of het bericht al verstuurd is }
                { Of dat het niet bij ons vandaan kwam      }
                IF ((SquishMsgHdr.Attr AND MSGLOCAL) = 0) OR
                   ((SquishMsgHdr.Attr AND MSGSENT) <> 0) OR
                   ((SquishMsgHdr.Attr AND MSGHOLD) <> 0) OR
                   ((SquishMsgHdr.Attr AND MSGFRQ) <> 0) OR
                   ((SquishMsgHdr.Attr AND MSGREAD) <> 0) OR
                   ((SquishMsgHdr.Attr AND MSGORPHAN) <> 0)
                THEN
                    Continue;
           END;

           MsgsEmpty;

           { converteer de Squish header naar de standaard fido header }
           WITH Msg,SquishMsgHdr DO
           BEGIN
                Attr_F:=Attr;

                { RWI 961011: controle op #0 ivm met volledige gebruikte pchars ingevoerd }
                Move (FromWhom,FromUser_F[1],SQMSG_FROM_SIZE);
                FromUser_F[0]:=Char (SQMSG_FROM_SIZE);
                FOR P:=1 TO SQMSG_FROM_SiZE DO
                    IF (FromWhom[P] = #0) THEN
                    BEGIN
                         FromUser_F[0]:=Char (P-1);
                         Break;
                    END;

                Move (ToWhom,Stored_ToUser[1],SQMSG_TO_SIZE);
                Stored_ToUser[0]:=Char (SQMSG_TO_SIZE);
                FOR P:=1 TO SQMSG_TO_SIZE DO
                    IF (ToWhom[P] = #0) THEN
                    BEGIN
                         Stored_ToUser[0]:=Char (P-1);
                         Break;
                    END;

                Move (Subj,Subj_F[1],SQMSG_SUBJ_SIZE);
                Subj_F[0]:=Char (SQMSG_SUBJ_SIZE);
                FOR P:=1 TO SQMSG_SUBJ_SIZE DO
                    IF (Subj[P] = #0) THEN
                    BEGIN
                         Subj_F[0]:=Char (P-1);
                         Break;
                    END;

                Squish2FidoAdres (Dest,Stored_ToAddr);
                Squish2FidoAdres (Orig,FromAddr_F);

                UnpackTime (SquishDateTime2PackedDosDateTime (Date_Written),DT);
                Date_F:=DosDateTime2FidoDateTimeStr (DT);
           END;

           IF (NOT IsBadArea) THEN
           BEGIN
                CASE AreaRec.AreaType OF
                     Area_Echo :
                         BEGIN
                              Msg.Area_F:=AreaRec.AreaName_F;
                              { Stop de AREA: kludge in de eerste regel van het bericht }
                              {RAWI 971012: not anymore.. PKT export will add it again
                              MsgsAddLineTo (Header_F,'AREA:'+Msg.Area_F);
                              }
                              Msg.Ready_F:=Local_Echomail;
                         END;

                     Area_Netmail:
                         Msg.Ready_F:=Local_Netmail;

                     Area_EMail:
                         BEGIN
                              Msg.FromAddr_F:=Config.NodeNrs[AreaRec.OriginAKA];

                              IF (Msg.Stored_ToUser = '') THEN
                                 Msg.Stored_ToUser:=Config.GatewayUser
                              ELSE
                                  IF (UpCaseString (Msg.Stored_ToUser) <> Config.GatewayUser) THEN
                                  BEGIN
                                       IF (Pos ('@',Msg.Stored_ToUser) = 0) AND (Pos ('!',Msg.Stored_ToUser) = 0) THEN
                                       BEGIN
                                            IF Config.LogDebug THEN
                                               LogMessage (liFatal,'Squish['+AreaRec.AreaName_F+
                                                           '] No e-mail address in To: ("'+Msg.Stored_ToUser+'")');

                                            { make MSGORPHAN.. }

                                            Continue;  { geen e-mail! }
                                       END;

                                       MsgsAddFirstLineTo (Body,'To: '+Msg.Stored_ToUser);
                                       Msg.Stored_ToUser:=Config.GatewayUser;
                                  END;
                                  { else assume To: in body }

                              { zoek het bijpassende system node nummer voor in de To: }
                              FidoMatch (Msg.FromAddr_F,Msg.Stored_ToAddr);
                              Msg.Ready_F:=Local_Netmail;
                         END;
                END; { case }
           END;

           { Loop door de header heen en plaats die letterlijk in  }
           { de fido header                                        }
           { Dit is makkelijk: alle header kludges moeten hier al  }
           { staan... (hoop ik)                                    }

           { Baal! Ook Squish negeerd vrolijk het point veld in de   }
           { FidoHeader... dit betekend dat er alsnog naar TOPT/FMPT }
           { INTL/MSGID gezocht moet worden..                        }

           { Als dit een netmail bericht is , en we draaien in Frontdoor }
           { mode mag het bericht alleen verstuurd worden als het        }
           {   a) voor ons bestemd is en                                 }
           {   b) voor postmaster is!                                    }
           { zorg er ook voor dat lokale netmail berichten onaangeroerd  }
           { blijven.                                                    }

           { --- Inlezen van het header gedeelte van het bericht }
           PrevKludgeID:=klNone;
           REPEAT
                 FBReadSquishHdrLn (SquishBaseF,Regel);

                 {990508 AAT: If there is already a <CR> at the end of the
                              line (like TimEd does with FLAGS: KFS), we do
                              NOT want to add another.  (get PackBuf EOL
                              case error)}


                 IF (Regel <> #0) THEN
                 BEGIN
                      IF (Regel[Length (Regel)] <> #13) THEN
                         Regel:=Regel+#13;

                      FidoAddLineToMessage (Regel,LastRegel);
                 END;

           UNTIL (Regel = #0);

           { FidoAddLastLine (TRUE,LastRegel); }

           { WTRBAD_AREA kludge sets Msg.BadAreaRecNr }
           IF IsBadArea AND (Msg.BadAreaRecNr = NILRecordNr) THEN
              GOTO Verder;

           { alle kludges hebben we nu doorlopen dus we hebben nu }
           { complete adressen.                                   }
           IF (NOT IsBadArea) AND (NOT FidoCheckNetmail (IsPrimaryNetmailArea,Msg.Stored_ToUser,Msg.Stored_ToAddr)) THEN
              Continue;

           { --- Init boolean variabelen }
           Found_SeenBy:=FALSE;
           Found_Path:=FALSE;
           Found_Origin:=FALSE;
           Found_Tear:=FALSE;

           { lees het bericht regel voor regel in de buffer }
           REPEAT
                 Einde:=FBReadLnCR (SquishBaseF,Regel);
                 IF (Regel = #0) THEN
                    Break;

                 WHILE (Pos (#$8D,Regel) > 0) DO
                       Delete (Regel,Pos (#$8D,Regel),1);

                 { RWI 950916: De tear-line kwam door als #13'--- timEd' }
                 {             en werd door de #13 dus niet goed als     }
                 {             kludge geidentificeerd.                   }
                 IF (Regel[1] = #13) THEN
                 BEGIN
                      FidoAddLineToMessage (#13,LastRegel);
                      IF (Length (Regel) > 1) THEN
                      BEGIN
                           Delete (Regel,1,1);
                           FidoAddLineToMessage (Regel,LastRegel);
                      END;
                 END ELSE
                     FidoAddLineToMessage (Regel,LastRegel);

           UNTIL (NOT Einde);

           FidoAddLastLine (LastRegel);

           { ignore LOcKed messages }
           IF ((Msg.ExtAttr_F AND EXTMSGLOK) <> 0) THEN
              Continue;

           IF FirstExport THEN
           BEGIN
                FirstExport:=FALSE;
                LogMessage (liTrivial,'Exporting from '+AreaRec.AreaName_F+' (Squish)');
           END;

           IF (Msg.Ready_F = Local_Netmail) THEN
           BEGIN
                IF Config.LogExportedMsgs AND (AreaRec.AreaType <> Area_Email) THEN
                   LogMessage (liTrivial,'  Exporting netmail for "'+Msg.Stored_ToUser+'"%'+Fido2Str (Msg.Stored_ToAddr));
           END ELSE
           BEGIN
               {### stats}
{
                UpdateAreaStats (GetAreaBaseRecordNrByAreaName_F (AreaRec.AreaName_F),Msg.MsgSize);
                UpdateUserStats (NILRecordNr=Local,EchoFrom,Msg.MsgSize);
}

                IF IsBadArea THEN
                   LogMessage (liGeneral,'  Re-tossing BAD message to '+Msg.Area_F)
                ELSE
                    IF Config.LogExportedMsgs THEN
                       LogMessage (liTrivial,'  Exporting echomail for "'+Msg.Stored_ToUser+'"');
           END;

           { Zorg dat er een tearline wordt toegevoegd, een origin line }
           { zodat we een 'echt' fido bericht krijgen.                  }
           IF (Msg.Ready_F = Local_Echomail) THEN
              FidoFinishEchomailExport (AreaRec);

           UpdateInfoNr (INFO_SquishScan_Msgs,1);

           IF (Msg.Ready_F IN [Netmail,Local_Netmail]) THEN
              UpdateInfoNr (INFO_SquishScan_Net,1)
           ELSE
               UpdateInfoNr (INFO_SquishScan_Echo,1);

           UpdateInfoNr (INFO_SquishScan_Bytes,MsgsCalcMessageSize);

           { exporteer the message }

           { keep track of the global structures }
           { if the export results into an import into this base  }
           { then another base might be open after the export and }
           { must then recover.                                   }
           PrevTouch:=TouchCounter;
           OldCurrentFrame:=CurrentFrame;
           Result:=Scan_DeliverMessage (AreaRecNr,IsBadArea);

           IF (TouchCounter <> PrevTouch) THEN
           BEGIN
               { re-open the correct base }
               IF (NOT OpenBase (AreaRec.FidoMsgPath,AreaRec.AreaName_F,{AllowCreate:}FALSE)) THEN
               BEGIN
                    LogMessage (liFatal,'[Squish] Failed to re-open '+AreaRec.AreaName_F);
                    GOTO CloseIt;
               END;
               CurrentFrame:=OldCurrentFrame;

                { load message header again }
               IF (NOT SquishLoadFrame (SquishFrameHdr, CurrentFrame)) THEN
               BEGIN
                    LogMessage (liFatal, '[Squish] Unable to re-load frame!');
                    goto CloseIt;
               END;
               SquishNextFrame := SquishFrameHdr.Next_Frame;

               IF (NOT SquishLoadMsgHdr (CurrentFrame)) THEN
               BEGIN
                    LogMessage (liFatal, '[Squish] Unable to load header for frame');
                    GOTO CloseIt;
               END;
           END;

           IF (Result IN [sdSent,sdReceived,sdOrphan]) THEN
           BEGIN
                {## must remove UNS flag from FLAGS kludge as well }
                {   maybe even re-write the entire FLAGS kludge?   }

                IF (Result = sdSent) THEN
                   SquishMsgHdr.Attr:=SquishMsgHdr.Attr OR MSGSENT;

                IF (Result = sdReceived) THEN
                   SquishMsgHdr.Attr:=SquishMsgHdr.Attr OR MSGREAD;

                IF (Result = sdOrphan) THEN
                   SquishMsgHdr.Attr:=SquishMsgHdr.Attr OR MSGORPHAN;

                { lock the base before we try to write to it }
                IF (NOT SquishLockBase) THEN
                BEGIN
                     LogMessage (liFatal,'[Squish] Unable to lock '+AreaRec.AreaName_F);
                     GOTO CloseIt;
                END;

                { write the updated message header }

                SquishSaveMsgHdr (CurrentFrame);
                SquishUnlockBase;
           END ELSE
               IF (Result = sdKill) THEN
               BEGIN
                    { delete the message - CurrentFrame points to the msg }

                    DeleteMessage;

                    { Advance to the next frame }
                    CurrentFrame := SquishNextFrame;
                    IF (CurrentFrame <> NULLFRAME) THEN
                    BEGIN
                         IF (NOT SquishLoadFrame (SquishFrameHdr, CurrentFrame)) THEN
                         BEGIN
                              LogMessage (liFatal, '[Squish] Unable to load frame!');
                              goto CloseIt;
                         END;
                         SquishNextFrame:=SquishFrameHdr.Next_Frame;
                    END ELSE
                         SquishNextFrame := NULLFRAME;
               END;
          
Verder:
     UNTIL (SquishNextFrame = NULLFRAME);

     { Update HighWater Mark }
     SquishIDXSearchByFrameNumber (CurrentFrame, SquishBase.High_Water);

CloseIt:
     CloseBase;
     MsgsEmpty;
END;


VAR Import_OriginAka : BYTE;
    Import_AreaMsgID : STRING[8];

{--------------------------------------------------------------------------}
{ Import_Flush                                                             }
{                                                                          }
{ This routine is called by the PackBuf code to flush a block of packed    }
{ lines to disk.                                                           }
{                                                                          }
PROCEDURE Import_Flush (VAR Buffer; Count : WORD; APtr : POINTER); FAR;
BEGIN
     FBSeekWrite (SquishBaseF,LastWritePos,Buffer,Count);
     UpdateInfoNr (INFO_SquishSave_Bytes,Count);
END;


{--------------------------------------------------------------------------}
{ Import_WriteHeaderLine                                                   }
{                                                                          }
{ This routine is called for each line in the header. The AREA: kludge is  }
{ remove, the MSGID, REPLY, etc. kludges are completed (*FTN* replacement) }
{ and the kludge lines are then written to disk at onc (no buffering),     }
{ without the #13 at the end.                                              }
{                                                                          }
FUNCTION Import_WriteHeaderLine (VAR OrigRegel : STRING) : BOOLEAN; FAR;

VAR Regel : STRING;
    L     : BYTE;

BEGIN
     Import_WriteHeaderLine:=FALSE; { do not abort }

     IF (Copy (OrigRegel,1,5) = 'AREA:') THEN
     BEGIN
          LogMessage (liFatal,'[Squish] He! Where did that AREA: kludge come from?? ** PLEASE REPORT **');
          Exit;
     END;

     Regel:=TransFix_HeaderLine (OrigRegel);

     {## use Import_ReplaceMsgID}

     { find the CR's and remove them }
     L:=Length (Regel);
     WHILE (L > 0) AND (Regel[L] = #13) DO
           Dec (L);

     { write this line to disk, if something was left }
     IF (L > 0{not empty}) THEN
        Import_Flush (Regel[1],L,NIL);
END;


{--------------------------------------------------------------------------}
{ Import_WriteFooterLine                                                   }
{                                                                          }
{ This routine is called for each line in the footer. SEEN-BY lines are    }
{ stripped as required and the rest is written to disk as-is, including    }
{ the CR.                                                                  }
{                                                                          }
FUNCTION Import_WriteFooterLine (VAR OrigRegel : STRING) : BOOLEAN; FAR;

VAR Regel : STRING;

BEGIN
     Import_WriteFooterLine:=FALSE; { do not abort }

     { SEEN-BY stripping }
     IF Config.StripSeenBy AND (Copy (OrigRegel,1,7) = 'SEEN-BY') THEN
        Exit; { drop it }

     Regel:=TransFix_FooterLine (OrigRegel);

     { write this line to disk }
     Import_Flush (Regel[1],Length (Regel),NIL);
END;


{--------------------------------------------------------------------------}
{ SquishImport_AttachFile                                                  }
{                                                                          }
{ This routine is called for each file that has been decoded. The path     }
{ points to the file, in the directory that was set for decoded files.     }
{ This function attaches the file to the current message by
{                                                                          }
PROCEDURE SquishImport_AttachFile (Path,OriginalName : STRING); FAR;
BEGIN
     LogMessage (liTrivial,'Squish: attaching file');
     {$IFDEF Pre}
     LogExtraMessage ('  Path: "'+Path+'"');
     LogExtraMessage ('  OriginalName: "'+OriginalName+'" (cannot store this)');
     {$ENDIF}

     IF (AttachedFiles <> '') THEN
        AttachedFiles:=AttachedFiles+' ';

     AttachedFiles:=AttachedFiles+Path;
END;


{--------------------------------------------------------------------------}
{ Squish_ImportMessage                                                     }
{                                                                          }
{ This routine imports a netmail or echomail message into a Squish Message }
{ base. The arguments contain the name of the area, path to the message    }
{ base (without extension) and the origin aka set for this area.           }
{ TransFix_Load must have been called before this routine is called.       }
{                                                                          }
PROCEDURE Squish_ImportMessage (AreaName,
                                Path,
                                DecodePath : STRING;
                                DecodeFiles : BOOLEAN);

VAR SplitParts   : WORD;
    SplitBodyLen : LONGINT;
    SplitCurrent : WORD;

    {----------------------------------------------------------------------}
    { CalcSplitParts                                                       }
    {                                                                      }
    PROCEDURE CalcSplitParts;

    VAR SplitParts_R : REAL;
        FidoBodyLen  : LONGINT;

    BEGIN
         SplitParts:=0;
         SplitBodyLen:=MAXLONGINT;

         IF (Config.MaxSquishMsgLen = 0) THEN
            Exit;

         SplitBodyLen:=Config.MaxSquishMsgLen;

         { count the total size of all parts, exclusive the attachments  }
         { (only when DecodeFiles is TRUE) and excluding the MIME multi- }
         { part header lines.                                            }

         FidoBodyLen:=MsgsCalcBodyLen ({IncludeAttachments}NOT DecodeFiles);

         {## verify that we have to add the header and footer lines}
         IF (Msg.HeaderTop_F <> NIL) THEN
            Dec (SplitBodyLen,Msg.HeaderTop_F^.TotalRegelLength);

         IF (Msg.CopiedHeadersTop_F <> NIL) THEN
            Dec (SplitBodyLen,Msg.CopiedHeadersTop_F^.TotalRegelLength);

         IF (Msg.FooterTop_F <> NIL) THEN
            Dec (SplitBodyLen,Msg.FooterTop_F^.TotalRegelLength);

         SplitParts_R:=FidoBodyLen / SplitBodyLen;
         SplitParts:=Trunc (SplitParts_R);
         IF (SplitParts < SplitParts_R) THEN
            Inc (SplitParts);
    END;


    {----------------------------------------------------------------------}
    { CreateMessage                                                        }
    {                                                                      }
    { This routine is called to initiate a new message. The message is     }
    { added to the structure of the base and the header is written.        }
    {                                                                      }
    { Een Squish bericht heeft een eigen type header een zonder CR/LF's,   }
    { regels gescheiden door #1 (CTRL-A) tekens.                           }
    {                                                                      }
    PROCEDURE CreateMessage;

    VAR Regel : STRING;
        L     : BYTE;
        DT    : DateTime;
        T     : LONGINT;

    BEGIN
         { --- start a new message at the end of the base }

         WITH SquishBase DO
         BEGIN
              (* RAWI 971109: removed possibility
              IF (MsgLimit > 0) AND ((Num_Msg+1) > MsgLimit) THEN
              BEGIN
                   SquishLoadFrameType (SQ_FIRST);
                   SquishDeleteMessage;
              END;
              *)

              { we can now safely add a message }
              Inc (Num_Msg);
              Inc (High_Msg);
         END; { with }

         AddNewFrame;

         { CurrentFrame now points to the position on disk where to }
         { write this frame. The SquishFrameHdr has been written to }
         { disk already.                                            }

         { Frame_length must be updated afterwards!! }

         { --- build and write the binary message header to disk }

         { build the subject line }
         IF (AttachedFiles <> '') THEN
            {## for all split parts?}
            Regel:=AttachedFiles
         ELSE
             Regel:=Msg.Subj_F;

         { if this is a split part message, then add the (n/m) }
         { indicator at the start of the message.              }
         {## this should be moved to the end}
         IF (SplitParts > 1) THEN
            Regel:='('+Word2String (SplitCurrent)+
                   '/'+Word2String (SplitParts)+
                   ') '+Regel;

         { fill in the binary message header }

         FillChar (SquishMsgHdr,SizeOf (_SQMHDRTYPE),0);

         WITH SquishMsgHdr DO
         BEGIN
              Attr:=Msg.Attr_F;

              {## only if subject same for all parts }
              IF (AttachedFiles <> '') THEN
                 Attr:=Attr OR MSGFILE; { does not modify Msg.Attr_F }

              L:=Length (Msg.FromUser_F);
              IF (L > 35) THEN
                 L:=35;
              Move (Msg.FromUser_F[1],FromWhom,L);

              L:=Length (Msg.Stored_ToUser);
              IF (L > 35) THEN
                 L:=35;
              Move (Msg.Stored_ToUser[1],ToWhom,L);

              L:=Length (Regel);
              IF (L > 71) THEN
                 L:=71;
              Move (Regel[1],Subj,L);

              SquishFido2SquishAdres (Msg.FromAddr_F,Orig);
              SquishFido2SquishAdres (Msg.Stored_ToAddr,Dest);

              FidoDateTimeStr2DosDateTime (Msg.Date_F,DT);
              PackTime (DT,T);
              Date_Written:=PackedDosDateTime2SquishDateTime (T);

              Date_Arrived:=PackedDosDateTime2SquishDateTime (UnixDateTime2PackedDosDateTime (GetCurrentUnixTime));

              Utc_ofs:=0;
              Replyto:=0;
              Replies[1]:=0;

              Move (Msg.Date_F[1],AzDate,Length (Msg.Date_F){maxlen=19});
         END; { with }

         { write this binary header to disk }
         SquishSaveMsgHdr (CurrentFrame);

         { --- now write the control lines }

         { LastWritePos now points to the location where to continue }
         { writing on disk.                                          }

         { add the rest of the kludges }
         Import_ReplaceMsgID:=(SplitCurrent > 1) OR
                              (Msg.AreaRecNrs[2] <> NILRecordNr); { crossposted }

         MsgsForEach (Msg.HeaderTop_F,Import_WriteHeaderLine);
         MsgsForEach (Msg.CopiedHeadersTop_F,Import_WriteHeaderLine);

         IF (SplitParts > 1) THEN
         BEGIN
              Regel:=FidoCreateSplitLine (SplitCurrent,SplitParts);
              Import_WriteHeaderLine (Regel);
         END;

         {## XPOST kludge? }


         { write a #0 to terminate the header block }
         Regel:=#0;
         Import_WriteHeaderLine (Regel);

         { update the header with the size of the control information }
         SquishFrameHdr.CLen:=LastWritePos-CurrentFrame-SizeOf (_SQMHDRTYPE)-SizeOf (_SQFHDRTYPE);
    END;


    {----------------------------------------------------------------------}
    { CompleteMessage                                                      }
    {                                                                      }
    { This routine is called to finialise a message. The administration of }
    { the base is finished and the message is added to the index.          }
    {                                                                      }
    PROCEDURE CompleteMessage;

    VAR Regel : STRING;

    BEGIN
         { verify #13#13 before tear-line }

         { write footer }
         MsgsForEach (Msg.FooterTop_F,Import_WriteFooterLine);

         {..write footer..

         { Schrijf de footer weg naar disk
         FBSeekWrite (SquishBaseF,LastWritePos,SM_Header^[RealHeaderSize],RealFooterSize);
         }

         { write a #0 to terminate the footer }
         Regel:=#0;
         Import_WriteFooterLine (Regel);

         { complete the frame and write it to disk }
         WITH SquishFrameHdr DO
         BEGIN
              {RAWI980511: size of SQFHDRTYPE niet meerekenen!}
              Frame_Length:=LastWritePos-CurrentFrame-SquishBase.sz_sqhdr;
              Msg_Length:=frame_length;
         END;

         SquishSaveFrame (SquishFrameHdr,CurrentFrame);

         { update header pointer }
         SquishBase.End_Frame:=LastWritePos;

         { add the message to the index }
         
         SquishAddToIndex (SquishNameToHash (Msg.Stored_ToUser),SquishBase.Uid);
         Inc (SquishBase.Uid);

         UpdateInfoNr (INFO_SquishSave_Msgs,1);

         IF (Msg.Ready_F IN [Netmail,Local_Netmail]) THEN
            UpdateInfoNr (INFO_SquishSave_Net,1)
         ELSE
             UpdateInfoNr (INFO_SquishSave_Echo,1);
    END;

{ Squish_ImportMessage }

VAR PosRec  : ForEach_PosRecord;
    AllDone : BOOLEAN;

BEGIN
     { --- the Init part }

     IF (NOT OpenBase (Path,AreaName,TRUE)) THEN
        Exit;

     IF (NOT SquishLockBase) THEN
     BEGIN
          LogMessage (liFatal,'[SquishImport] Unable to lock '+AreaName);
          Exit;
     END;

     UpdateWriteFile (Path,0);

     { --- the Import part }

     AttachedFiles:='';

     IF DecodeFiles THEN
        DecodeAttachedFiles (DecodePath,SquishImport_AttachFile);

     CalcSplitParts;

     MsgsLimited_Init (PosRec,{IncludeAttachments}(NOT DecodeFiles));

     SplitCurrent:=0;
     REPEAT
           Inc (SplitCurrent);

           IF PackBuf_Init (Import_Flush,lttCR,NIL) THEN
           BEGIN
                CreateMessage;

                { write body }
                PackBuf_ReplaceNul ('!');
                AllDone:=MsgsLimited_ForEach (PosRec,SplitBodyLen,PackBuf_AddLine);

                PackBuf_Done;

                CompleteMessage;

           END ELSE
               AllDone:=TRUE;

     UNTIL AllDone;

     { --- the Complete part }

     SquishUnlockBase;
END;


(*
{--------------------------------------------------------------------------}
{ SquishMBase.SquishReIndex                                                }
{                                                                          }
{ Standaard functie die probeert een Squish file van een nieuwe index te   }
{ voorzien, door deze op te bouwen uit informatie in de msgbase.           }
{                                                                          }
PROCEDURE SquishMBase.SquishReIndex (AreaRec : AreaBaseRecord);

VAR NewIndex        : FILE;
    SquishNewIndex  : _sqidxtype;
    SquishNextFrame : LONGINT;
    IORes           : BYTE;

LABEL Einde;

BEGIN
     CurrentBase:=AreaRec.FidoMsgPath;

     { als area file niet bestaat, exit }
     IF NOT TestIfExist (CurrentBase+SQUISH_D_EXT) THEN
        Exit;

     IF (NOT SquishLoadHeader) THEN
        Exit;

     { probeer of we de index file kunnen openen voor output }
     Assign (NewIndex,CurrentBase+SQUISH_I_EXT);
     {$I-} ReWrite (NewIndex,1); {$I+} IORes:=IOResult;
     IF (IORes <> 0) THEN
     BEGIN
          LogDiskIOError (IORes,'[Squish] Error creating new index file for '+CurrentBase);
          Exit;
     END;

     PeekFiles;

     { Laten we bij het begin beginnen }
     CurrentFrame:=NULLFRAME;

     IF (NOT SquishLoadFrameType (SQ_FIRST)) THEN
        GOTO Einde;

     { bewaar de frame header, voor het geval dat we het bericht deleten }
     REPEAT
           SquishNextFrame:=SquishFrameHdr.Next_Frame;

           { laad de fidoheader }
           IF (NOT SquishLoadMsgHdr (CurrentFrame)) THEN
              GOTO Einde; { zorg dat lege gebieden geen file handles opslurpen }

           WITH SquishNewIndex DO
           BEGIN
                Ofs:=CurrentFrame;
                UMsgId:=SquishBase.uid;  { Nieuwe unieke nummers }
                Hash:=SquishNameToHash (SquishMsgHdr.towhom);
           END;

           Inc (SquishBase.uid);

           { Probeer de index naar disk te schrijven }
           {$I-} BlockWrite (NewIndex,SquishNewIndex,SizeOf (SquishNewIndex)); {$I+}
           IORes:=IOResult;
           IF (IORes <> 0) THEN
           BEGIN
                LogDiskIOError (IORes,'[Squish] Error while adding to index file of '+CurrentBase);
                Exit;
           END;

           SquishLoadFrameType (SQ_NEXT);
           Inc (Status.DezeArea);  { Aantal berichten gereindexd }

           { doorgaan tot aan het einde van de lijst }
     UNTIL (SquishNextFrame = NULLFRAME);

     { zorg dat de nieuwe header op disk staat }
     SquishUpdateHeader;

Einde:
     Close (NewIndex);
     FBufferClose (SquishBaseF);
     PeekFiles;

     CurrentBase:=''; { RWI 960521: stond vOOr Einde: label }
END;
*)


{--------------------------------------------------------------------------}
{ Squish_PurgeArea                                                         }
{                                                                          }
{ Deze routine ruimte de rommel op in een area.                            }
{                                                                          }
PROCEDURE Squish_PurgeArea (AreaRec : AreaBaseRecord);

VAR MsgCount : LONGINT;

    {----------------------------------------------------------------------}
    { KillByAge                                                            }
    {                                                                      }
    { In: Age=0..65535 days.                                               }
    { Out: FALSE=Error, TRUE=OK                                            }
    {                                                                      }
    { Kills any messages that are older than the given age relative to the }
    { current date/time and at the same time counts the number of messages }
    { in the base. This information is then used by KillByLimit.           }
    {                                                                      }
    FUNCTION KillByAge (Age : LONGINT) : BOOLEAN;

    VAR KillUnixTime : LONGINT;
        NextFrame    : LONGINT;
        MsgUnixTime : LONGINT;

    BEGIN
         KillByAge:=FALSE; { error }

         KillUnixTime:=GetCurrentUnixTime-Age*SEC_Dag;

         IF (NOT (StayQuiet OR NoFullScreen)) THEN
            WriteXY (SXb2,SYb+6,'Purge by age      ');

         MsgCount:=0; { aantal berichten in de base }

         { avoid failing & aborting on a base with JUST deleted messages }
         IF (SquishBase.begin_frame = 0) THEN
         BEGIN
              KillByAge:=TRUE; { no error }
              Exit; { ## EXIT ## }
         END;
         
         IF (NOT SquishLoadFrameType (SQ_FIRST)) THEN
         BEGIN
              LogMessage (liFatal,'[Squish-AgeKill] Error loading first frame (0x'+
               long2hexstring(SquishBase.begin_frame) + ')');
              Exit;
         END;


         REPEAT
               NextFrame:=SquishFrameHdr.Next_Frame;

               IF (SquishFrameHdr.Frame_Type = FRAME_msg) THEN
               BEGIN
                    Inc (MsgCount);

                    IF (Age <> 0) THEN
                    BEGIN
                         IF (NOT SquishLoadMsgHdr (CurrentFrame)) THEN
                            Exit;

                         MsgUnixTime:=PackedDosDateTime2UnixDateTime (
                                      SquishDateTime2PackedDosDateTime (SquishMsgHdr.Date_Written));

                         IF (MsgUnixTime <> 0) AND (MsgUnixTime < KillUnixTime) THEN
                         BEGIN
                              { BOOM, you're dead! }

                              { mark this frame as "free", but don't unlink it }
                              { nor link it into the free chain yet.           }
                              SquishFrameHdr.Frame_type:=FRAME_free;

                              { update these fields in a "relative" way because we don't }
                              { know if these are offset-based or always 0-based.        }
                              Dec (SquishBase.Num_msg);
                              Dec (SquishBase.High_msg);
                              Dec (MsgCount);

                              { weer naar disk schrijven }
                              IF (NOT SquishSaveFrame (SquishFrameHdr,CurrentFrame)) THEN
                                 Exit;
                         END;
                    END;
               END;

               IF (NextFrame <> 0) THEN
                  IF (NOT SquishLoadFrameType (SQ_NEXT)) THEN
                     Exit;

         UNTIL (NextFrame = 0);

         { update header in case of newly deleted messages }
         SquishUpdateHeader;

         KillByAge:=TRUE; { OK }
    END;

    {----------------------------------------------------------------------}
    { KillByLimit                                                          }
    {                                                                      }
    { Als er nog meer berichten verwijderd moeten worden, dan zorgt deze   }
    { routine daarvoor. De eerste frames worden verwijderd, want misschien }
    { niet een goed idee is omdat daar ook de jongste berichten kunnen     }
    { staan. We moeten eigenlijk (net als JAM) een lijst bijhouden van de  }
    { oudste berichten en die killen.                                      }
    { Nog eens over nagedacht: als een frame hergebruikte wordt, dan wordt }
    { ie uit de "vrije" chain gehaald en aan het EINDE van de "gebruikte"  }
    { chain toegevoegd. Verwijderen vanaf het begin is dus juist.          }
    {                                                                      }
    FUNCTION KillByLimit (Limit : LONGINT) : BOOLEAN;

    VAR NextFrame : LONGINT;

    BEGIN
         KillByLimit:=FALSE; { abort }

         IF (Limit <> 0) AND (MsgCount > Limit) THEN
         BEGIN
               IF (NOT (StayQuiet OR NoFullScreen)) THEN
                 WriteXY (SXb2,SYb+6,'Purge by limit    ');

              IF (NOT SquishLoadFrameType (SQ_FIRST)) THEN
                 Exit;

              REPEAT
                    NextFrame:=SquishFrameHdr.Next_Frame;

                    IF (SquishFrameHdr.Frame_Type = FRAME_msg) THEN
                    BEGIN
                         { BOOM, you're dead! }

                         { mark this frame as "free", but don't unlink it }
                         { nor link it into the free chain yet.           }
                         SquishFrameHdr.Frame_type:=FRAME_free;

                         { update these fields in a "relative" way because we don't }
                         { know if these are offset-based or always 0-based.        }
                         Dec (SquishBase.Num_msg);
                         Dec (SquishBase.High_msg);
                         Dec (MsgCount);

                         { weer naar disk schrijven }
                         IF (NOT SquishSaveFrame (SquishFrameHdr,CurrentFrame)) THEN
                            Exit;
                    END;

                    IF (NextFrame <> 0) THEN
                       IF (NOT SquishLoadFrameType (SQ_NEXT)) THEN
                          Exit;

              UNTIL (NextFrame = 0) OR (MsgCount <= Limit);

              { update header in case of newly deleted messages }
              SquishUpdateHeader;
         END;

         KillByLimit:=TRUE; { OK }
    END;

    {----------------------------------------------------------------------}
    { CheckLastReads                                                       }
    {                                                                      }
    { Controleren of de .SQL umsgids bevat die in de .SQI file staan die   }
    { naar een frame wijzen die verwijderd moet worden. Zoja, dan verlagen }
    { naar het vorige "valid" bericht nummer. Rekening houden dat ALLE     }
    { berichten verwijderen kunnen zijn.                                   }
    {                                                                      }
    PROCEDURE CheckLastReads (LRFile : STRING);

    VAR SQLFile   : FILE;
        IORes     : BYTE;
        LRRec     : LONGINT;
        BytesRead : WordLong;
        Idx       : _SqIdxType;

    BEGIN
         IF (NOT (StayQuiet OR NoFullScreen)) THEN
            WriteXY (SXb2,SYb+6,'Purge check LR    ');

         IF (NOT SquishOpenIndex) THEN
         BEGIN
              LogMessage (liFatal,'[Squish-PurgeLR] Error opening index');
              Exit;
         END;

         Assign (SQLFile,LRFile);
         {$I-} Reset (SQLFile,1); {$I+} IORes:=IOResult;
         IF (IORes <> 0) THEN
         BEGIN
              { SQL hoeft niet in gebruik te zijn }
              IF (IORes <> 2{file not found}) THEN
                 LogDiskIOError (IORes,'[SquishPurge] Error opening last-read file '+LRFile);
              Exit;
         END;

         {$IFDEF LogFileIO}PostOpenF (SQLFile);{$ENDIF}

         WHILE (FilePos (SQLFile) < FileSize (SQLFile)) DO
         BEGIN
              {$I-} BlockRead (SQLFile,LRRec,4,BytesRead); {$I+} IORes:=IOResult;
              IF (IORes <> 0) THEN
              BEGIN
                   LogDiskIOError (IORes,'[SquishPurge] Error reading from last-read file '+LRFile);

                   {$IFDEF LogFileIO}PreCloseF (SQLFile);{$ENDIF}
                   Close (SQLFile);
                   Exit;
              END;

              IF (LRRec = 0{niet in gebruik}) THEN
                 Continue;

              { LRRec bevat nu een umsgid dat valid moet zijn }

              {## this search will take a long time..}
              {   might want to build a temporary index in memory..}
              IF (NOT SquishIDXSearchByMSGID (LRRec)) OR
                 (SquishFrameHdr.Frame_Type <> FRAME_msg) THEN
              BEGIN
                   { we moeten deze entry aanpassen }
                   { PurgeLR_IndexTel bevat de positie (1..n) in het }
                   { index array. We gaan nu gewoon steeds 1 positie }
                   { terug in de index totdat we er een vinden die   }
                   { niet gemarkeerd is om verwijderd te worden.     }

                   IF (PurgeLR_IndexTel = 0) THEN
                      LogMessage (liGeneral,'Squish LR['+Longint2String (FilePos (SQLFile)-4)+'] not found in index')
                   ELSE
                       WHILE (PurgeLR_IndexTel > 1) DO
                       BEGIN
                            Dec (PurgeLR_IndexTel);

                            IF (NOT SquishReadIndex (PurgeLR_IndexTel,Idx)) THEN
                            BEGIN
                                 LogMessage (liFatal,'[Squish-PurgeLR] Error reading index record '+
                                                     Longint2String (PurgeLR_IndexTel));
                                 Break; { from the inner while - continue with next msg }
                            END;

                            CurrentFrame:=Idx.Ofs;

                            IF SquishLoadFrame (SquishFrameHdr,CurrentFrame) AND
                               (SquishFrameHdr.Frame_Type = FRAME_msg) THEN
                            BEGIN
                                 { deze wijst naar een bericht. Zet de LR }
                                 { op dit bericht.                        }
                                 LRRec:=Idx.UMsgID;

                                 { write gebeurt buiten deze loop }
                                 Break; { from the inner while - continue with next msg }
                            END;
                       END; { while }

                   { als we de LR niet konden updaten, dan op 0 zetten }
                   IF (PurgeLR_IndexTel = 0) THEN
                      LRRec:=0;

                   LogMessage (liGeneral,'Squish LR['+Longint2String (FilePos (SQLFile)-4)+'] adjusted to '+
                                         Longint2String (LRRec));

                   { (always) update LR record on disk }
                   Seek (SQLFile,FilePos (SQLFile)-4);
                   BlockWrite (SQLFile,LRRec,4);
              END;
         END; { while }

         {$IFDEF LogFileIO}PreCloseF (SQLFile);{$ENDIF}
         Close (SQLFile);
    END;

VAR NewSQI : FILE;
    OldSQI : FILE;
    OldSQD : FILE;

    {----------------------------------------------------------------------}
    { CopyIndexEntry                                                       }
    {                                                                      }
    { Deze routine zoekt in de oude index OldSQI naar een index entry die  }
    { wijst naar OldPos. Die wordt aangepast zodat ie naar NewPos wijst    }
    { en daarna naar de NewSQI geschreven. Dit gebeurd op zo'n manier dat  }
    { een te groote index file ook nog verwerkt kan worden.                }
    {                                                                      }
    PROCEDURE CopyIndexEntry (OldPos,NewPos : LONGINT);

    CONST MAX_INDEXES = 25;

    VAR Indexes    : ARRAY[1..MAX_INDEXES] OF _SQIDXTYPE; { 300 bytes }
        Lp,
        IndexCount : 0..MAX_INDEXES;
        BytesRead  : WordLong;
        IORes      : BYTE;

    BEGIN
         Seek (OldSQI,0);
         REPEAT
              {$I-} BlockRead (OldSQI,Indexes,MAX_INDEXES*SizeOf (_SQIDXTYPE),BytesRead); {$I+} IORes:=IOResult;
              IF (IORes <> 0) THEN
              BEGIN
                   LogDiskIOError (IORes,'[SquishPurge] Error loading from old index');
                   Exit;
              END;

              IndexCount:=BytesRead DIV SizeOf (_SQIDXTYPE);

              FOR Lp:=1 TO IndexCount DO
                  IF (Indexes[Lp].Ofs = OldPos) THEN
                  BEGIN
                       Indexes[Lp].Ofs:=NewPos;

                       { important: keep umsgid and hash }

                       Seek (NewSQI,FileSize (NewSQI));
                       {$I-} BlockWrite (NewSQI,Indexes[Lp],SizeOf (_SQIDXTYPE)); {$I+} IORes:=IOResult;
                       IF (IORes <> 0) THEN
                          LogDiskIOError (IORes,'[SquishPurge] Error adding to new index');

                       Exit;
                  END;

         UNTIL (BytesRead = 0);

         LogMessage (liGeneral,'[SquishPurge] Frame not in old index, correcting');

         WITH Indexes[1] DO
         BEGIN
              Ofs:=NewPos;
              UMsgID:=SquishBase.UId;
              Inc (SquishBase.Uid);

              { RAWI 970704: added seek }
              Seek (OldSQD,OldPos+SizeOf (_SQFHDRTYPE));
              BlockRead (OldSQD,SquishMsgHdr,SizeOf (_SQMHDRTYPE));
              Hash:=SquishNameToHash (SquishMsgHdr.towhom);

              { restore position of OldSQD }
              Seek (OldSQD,OldPos+SizeOf (_SQIDXTYPE));
         END; { with }

         Seek (NewSQI,FileSize (NewSQI));
         {$I-} BlockWrite (NewSQI,Indexes[1],SizeOf (_SQIDXTYPE)); {$I+} IORes:=IOResult;
         IF (IORes <> 0) THEN
            LogDiskIOError (IORes,'[SquishPurge] Error adding to new index');
    END;

{Squish_PurgeArea}

VAR NewSQD    : FILE;
    IORes     : BYTE;

    OldIndex,
    OldFrame  : LONGINT;
    NewFrame  : LONGINT;
    PrevFrame : LONGINT;
    PrevFHdr  : _SQFHDRTYPE;

    CopyLen   : WORD;
    CopyPtr   : POINTER;
    CopyLeft  : LONGINT;
    CopyNow   : WORD;

    Abort     : BOOLEAN;

    OldSize,
    NewSize   : LONGINT;

    Aborted   : BOOLEAN;

LABEL EndKill;

BEGIN
     { Vul het status window }
      IF (NOT (StayQuiet OR NoFullScreen)) THEN
     WriteXY (SXb2,SYb+2,'Squish     ');
      IF (NOT (StayQuiet OR NoFullScreen)) THEN
     WriteXY (SXb2,SYb+6,'Purge             ');
      IF (StayQuiet) THEN
         Writeln ('Purging Squish base...');

     Status.DezeTodo:=0; { geen % }
     Status.DezeArea:=0;

     IF (NOT OpenBase (AreaRec.FidoMsgPath,AreaRec.AreaName_F,FALSE{do not create})) THEN
        Exit;

     Abort:=TRUE;

     IF (NOT SquishLockBase) THEN
        GOTO EndKill;

     IF (NOT KillByAge (AreaRec.FidoMsgAge)) THEN
        GOTO EndKill;

     IF (NOT KillByLimit (AreaRec.FidoMsgLimit)) THEN
        GOTO EndKill;

     CheckLastReads (AreaRec.FidoMsgPath+'.SQL');

     Abort:=FALSE;

 EndKill:

     SquishUnlockBase;
     CloseBase;

     IF Abort THEN
        Exit;

      IF (NOT (StayQuiet OR NoFullScreen)) THEN
        WriteXY (SXb2,SYb+6,'Purge deleted msgs');

     MsgCount:=-1;

     { nu de .SQD, .SQI file opnieuw opbouwen }

     Assign (OldSQD,AreaRec.FidoMsgPath+SQUISH_D_EXT);
     {$I-} Reset (OldSQD,1); {$I+} IORes:=IOResult;
     IF (IORes <> 0) THEN
     BEGIN
          LogDiskIOError (IORes,'[SquishPurge] Failed to open '+AreaRec.FidoMsgPath+SQUISH_D_EXT);
          Exit;
     END;

     {$IFDEF LogFileIO}PostOpenF (OldSQD);{$ENDIF}

     IF (NOT LockFile (OldSQD)) THEN
     BEGIN
          LogMessage (liFatal,'[SquishPurge] Failed to lock '+AreaRec.FidoMsgPath+SQUISH_D_EXT);
          {$IFDEF LogFileIO}PreCloseF (OldSQD);{$ENDIF}
          Close (OldSQD);
          Exit;
     END;

     Assign (OldSQI,AreaRec.FidoMsgPath+SQUISH_I_EXT);
     {$I-} Reset (OldSQI,1); {$I+} IORes:=IOResult;
     IF (IORes <> 0) THEN
     BEGIN
          LogDiskIOError (IORes,'[SquishPurge] Failed to open '+AreaRec.FidoMsgPath+SQUISH_I_EXT);
          UnlockFile (OldSQD);
          {$IFDEF LogFileIO}PreCloseF (OldSQD);{$ENDIF}
          Close (OldSQD);
          Exit;
     END;

     {$IFDEF LogFileIO}PostOpenF (OldSQI);{$ENDIF}

     Assign (NewSQD,AreaRec.FidoMsgPath+'.S$D');
     {$I-} ReWrite (NewSQD,1); {$I+} IORes:=IOResult;
     IF (IORes <> 0) THEN
     BEGIN
          LogDiskIOError (IORes,'[SquishPurge] Failed to create temporary .S$D file');
          UnlockFile (OldSQD);

          {$IFDEF LogFileIO}PreCloseF (OldSQD);{$ENDIF}
          Close (OldSQD);

          {$IFDEF LogFileIO}PreCloseF (OldSQI);{$ENDIF}
          Close (OldSQI);
          Exit;
     END;

     {$IFDEF LogFileIO}PostOpenF (NewSQD);{$ENDIF}

     Assign (NewSQI,AreaRec.FidoMsgPath+'.S$I');
     {$I-} ReWrite (NewSQI,1); {$I+} IORes:=IOResult;
     IF (IORes <> 0) THEN
     BEGIN
          LogDiskIOError (IORes,'[SquishPurge] Failed to create temporary .S$I file');
          UnlockFile (OldSQD);

          {$IFDEF LogFileIO}PreCloseF (OldSQD);{$ENDIF}
          Close (OldSQD);

          {$IFDEF LogFileIO}PreCloseF (OldSQI);{$ENDIF}
          Close (OldSQI);

          {$IFDEF LogFileIO}PreCloseF (NewSQD);{$ENDIF}
          Close (NewSQD);

          Erase (NewSQD);
          Exit;
     END;

     {$IFDEF LogFileIO}PostOpenF (NewSQI);{$ENDIF}

     { alle gebruikte frames kopieren }
     Seek (OldSQD,0);
     BlockRead (OldSQD,SquishBase,SizeOf (_SQBASETYPE));

     { the first frame does not have to start right after the header,   }
     { so we simply follow the chain of known frame and ignore the rest }
     OldFrame:=SquishBase.Begin_Frame;

     { als MsgCount niet uitgerekend is, neem dan de telling uit de header }
     IF (MsgCount = -1) THEN
        MsgCount:=SquishBase.Num_msg;

     { maak de lege berichten chain leeg }
     SquishBase.First_free:=0;
     SquishBase.Last_free:=0;

     { reset de andere tellers; we updaten die straks }
     SquishBase.Begin_frame:=0;
     SquishBase.Last_frame:=0;
     SquishBase.End_frame:=0;

     { RAWI 970528: veroorzaakt een hoop problemen als je deze reset!
     SquishBase.High_Water:=0;   voorkom High_Water > Num_Msg
     }

     { schrijf deze header alvast naar de nieuwe base }
     BlockWrite (NewSQD,SquishBase,SizeOf (_SQBASETYPE));

     { nu alle frames met FRAME_msg status kopieren }
     PrevFrame:=0;

     CalcMaxAllowedMem (CopyLen,1024,8192);
     GetMem (CopyPtr,CopyLen);
     {$IFDEF LogGetMem} LogGetMem (CopyPtr,CopyLen,'CopyPtr'); {$ENDIF}

     OldSize:=FileSize (OldSQD);
     Status.DezeTodo:=SquishBase.Num_msg;

     WHILE (OldFrame <> 0) DO
     BEGIN
          OldIndex:=OldFrame;

          { lees een oude frame header in }
          Seek (OldSQD,OldFrame);
          BlockRead (OldSQD,SquishFrameHdr,SizeOf (_SQFHDRTYPE));

          { prepare for next read }
          OldFrame:=SquishFrameHdr.Next_Frame;

          { keep the none-deleted frames }
          IF (SquishFrameHdr.Frame_type = FRAME_free) THEN
             Continue; { with the while }

          { tel aantal gekopieerde berichten }
          Inc (Status.DezeArea);

          { voorkom over-time-slicing en te veel screen updates }
          IF ((Status.DezeArea MOD 12) = 1) THEN
          BEGIN
               UtilUpdateProgress;
               Slice_Now;
          END;

          NewFrame:=FilePos (NewSQD);

          { link vanuit het previous frame updaten }
          IF (PrevFrame <> 0) THEN
          BEGIN
               Seek (NewSQD,PrevFrame);
               BlockRead (NewSQD,PrevFHdr,SizeOf (_SQFHDRTYPE));

               PrevFHdr.Next_Frame:=NewFrame;

               Seek (NewSQD,PrevFrame);
               BlockWrite (NewSQD,PrevFHdr,SizeOf (_SQFHDRTYPE));
          END;

          SquishFrameHdr.Prev_Frame:=PrevFrame;
          SquishFrameHdr.Next_Frame:=0; { wordt nog ingevuld }

          Seek (NewSQD,NewFrame);
          BlockWrite (NewSQD,SquishFrameHdr,SizeOf (_SQFHDRTYPE));

          PrevFrame:=NewFrame; { for next update }

          { en de inhoud van het frame kopieren }
          CopyLeft:=SquishFrameHdr.Frame_length;
          WHILE (CopyLeft > 0) DO
          BEGIN
               IF (CopyLeft > CopyLen) THEN
                  CopyNow:=CopyLen
               ELSE
                   CopyNow:=CopyLeft;

               {$I-} BlockRead (OldSQD,CopyPtr^,CopyNow); {$I+} IORes:=IOResult;
               { Ignore read errors. Simply create the new frame }

               { This can happen with new frames at the end of a .SQD, }
               { but without a complete body (aborted write, etc.).    }

               BlockWrite (NewSQD,CopyPtr^,CopyNow);

               CopyLeft:=CopyLeft-CopyNow;
          END; { while }

          { OldFrame staat al klaar }
          CopyIndexEntry (OldIndex,NewFrame);
     END; { while }

     { afsluiten }
     FreeMem (CopyPtr,CopyLen);

     NewSize:=FileSize (NewSQD);

     { update header }
     IF (PrevFrame <> 0) THEN
     BEGIN
          SquishBase.Begin_frame:=SizeOf (_SQBASETYPE);
          SquishBase.Last_frame:=PrevFrame;
     END;

     SquishBase.End_frame:=FileSize (NewSQD);

     { little prevention }
     IF (SquishBase.Num_msg < 0) THEN
        SquishBase.Num_msg:=0;

     SquishBase.High_msg:=SquishBase.Num_msg;

     Seek (NewSQD,0);
     BlockWrite (NewSQD,SquishBase,SizeOf (_SQBASETYPE));

     {$IFDEF LogFileIO}PreCloseF (NewSQD);{$ENDIF}
     Close (NewSQD);

     UnLockFile (OldSQD);

     {$IFDEF LogFileIO}PreCloseF (OldSQD);{$ENDIF}
     Close (OldSQD);

     {$IFDEF LogFileIO}PreCloseF (OldSQI);{$ENDIF}
     Close (OldSQI);

     {$IFDEF LogFileIO}PreCloseF (NewSQI);{$ENDIF}
     Close (NewSQI);

     { nu de nieuwe message base files op hun plaats zetten }

     Aborted:=FALSE;

     { delete old files }

     {$I-} Erase (OldSQD); {$I+} IORes:=IOResult;
     IF (IORes <> 0) THEN
        LogDiskIOError (IORes,'[SquishPurge] Failed to delete old '+AreaRec.FidoMsgPath+SQUISH_D_EXT);

     {$I-} Erase (OldSQI); {$I+} IORes:=IOResult;
     IF (IORes <> 0) THEN
        LogDiskIOError (IORes,'[SquishPurge] Failed to delete old '+AreaRec.FidoMsgPath+SQUISH_I_EXT);

     { rename new files }

     {$I-} Rename (NewSQD,AreaRec.FidoMsgPath+SQUISH_D_EXT); {$I+} IORes:=IOResult;
     IF (IORes <> 0) THEN
        LogDiskIOError (IORes,'[SquishPurge] Failed to rename .S$D to '+AreaRec.FidoMsgPath+SQUISH_D_EXT);

     {$I-} Rename (NewSQI,AreaRec.FidoMsgPath+SQUISH_I_EXT); {$I+} IORes:=IOResult;
     IF (IORes <> 0) THEN
        LogDiskIOError (IORes,'[SquishPurge] Failed to rename .S$I to '+AreaRec.FidoMsgPath+SQUISH_I_EXT);

     { update statistics }

     Status.SavedBytes:=Status.SavedBytes+(OldSize-NewSize);

     LogExtraMessage ('Squish Old: '+AddUpWithPreSpaces (8,Longint2String (OldSize))+
                      'b New: '+AddUpWithPreSpaces (8,Longint2String (NewSize)) +
                      'b Saves: '+AddUpWithPreSpaces (3,Byte2String (UtilPercSaved (OldSize,NewSize)))+
                      '% in '+AreaRec.AreaName_F);
END;


{--------------------------------------------------------------------------}
{ Squish_LinkArea                                                          }
{                                                                          }
{ This function performs the linking of the messages so the discussion     }
{ threads can be followed. Linking is done based on the MSGID and REPLY    }
{ kludge contents. The REPLY kludge indicates to which message (MSGID) it  }
{ is a reply.                                                              }
{ In a Squish base, each message can have 10 (MAX_REPLY) replies to it. If }
{ there are more replies, then they cannot be linked to the original       }
{ message in a forward fashion, but will still be linked backwards ("I am  }
{ a reply to this message").                                               }
{ The following info is used:                                              }
{  - reference to message by UMSGID_TYPE (=longint).                       }
{  - the .SQD file contains all the info we need.                          }
{  - we will use the .SQI file to quickly find the frames in the SQD file. }
{  - we run through the .SQI file to find each message.                    }
{  - the frame header is pointed to from the .SQI file.                    }
{  - the CLen field in the frame header indicates how many kludge bytes    }
{    there are.                                                            }
{  - the MsgHdr (_SQMHDRTYPE) follows the frame header and contains the    }
{    ReplyTo field (backward link) and Replies array (forward links).      }
{  - messages are linked based on the position in the base, not based on   }
{    the written date.                                                     }
{  - each control line (kludge) is terminated with a #0.                   }
{  - message without a REPLY kludge do not need backward linking.          }
{  - do not store the MSGID or REPLY kludge contents, but the CRC32 over   }
{    its contents, added up with spaces up to 255 chars, instead.          }
{ The link consists of the following steps:                                }
{  1 - follow the index (.SQI) to scan all messages and store the umsgid,  }
{      frame position, crc32 over the msgid and crc32 over the reply       }
{      kludge.                                                             }
{  2 - build all replies arrays in one run.                                }
{  3 - write everything back to disk.                                      }
{                                                                          }
FUNCTION Squish_LinkArea (AreaRec : AreaBaseRecord) : BOOLEAN;

TYPE MsgInfoRecord = RECORD
                           FramePos : LONGINT;
                           Umsgid   : UMSGID_TYPE;
                           CrcReply : LONGINT;
                           Reply    : UMSGID_TYPE;
                           Replies  : ARRAY[1..MAX_REPLY] OF UMSGID_TYPE;
                     END;

     MsgInfoRecordPtr = ^MsgInfoRecord;

CONST MAX_MSGS = 65535 DIV SizeOf (MsgInfoRecordPtr);

TYPE MsgInfoArray = ARRAY[1..MAX_MSGS] OF MsgInfoRecordPtr;
     MsgIdArray   = ARRAY[1..MAX_MSGS] OF LONGINT;

VAR MsgInfo  : ^MsgInfoArray;
    MsgIds   : ^MsgIdArray;
    MsgCount : 0..MAX_MSGS;

    {----------------------------------------------------------------------}
    { AddToReplies                                                         }
    {                                                                      }
    { This routine adds the umsgid to the Replies array of the message     }
    { indicated by InfoNr, which is <> 0. If the array is full then the    }
    { umsgid is silently discarded.                                        }
    {                                                                      }
    PROCEDURE AddToReplies (InfoNr : WORD; Umsgid : UMSGID_TYPE);

    VAR PutPos : 0..MAX_REPLY;

    BEGIN
         PutPos:=0;
         REPEAT
               Inc (PutPos);
               IF (MsgInfo^[InfoNr]^.Replies[PutPos] = 0) THEN
               BEGIN
                    MsgInfo^[InfoNr]^.Replies[PutPos]:=Umsgid;
                    Exit;
               END;
         UNTIL (PutPos = MAX_REPLY);
    END;

    {----------------------------------------------------------------------}
    { FindMsgId                                                            }
    {                                                                      }
    { This routine searches the MsgIds array for the given value. If found }
    { it returns the offset into the array, otherwise 0.                   }
    {                                                                      }
    FUNCTION FindMsgId (Value : LONGINT; OwnNr : WORD) : WORD;

    VAR Lp : 0..MAX_MSGS;

    BEGIN
         {## speed up with assembly }
         FOR Lp:=1 TO MsgCount DO
             IF (MsgIds^[Lp] = Value) AND (Lp <> OwnNr) THEN
             BEGIN
                  FindMsgId:=Lp;
                  Exit;
             END;

         FindMsgId:=0; { not found }
    END;

VAR Lp       : 0..MAX_MSGS;
    Aborted  : BOOLEAN;
    Regel    : STRING;
    InfoNr   : 0..MAX_MSGS;
    Lp2      : 0..MAX_REPLY;
    Idx      : _SqIdxType;

LABEL Abort,
      Normal;

BEGIN
     Squish_LinkArea:=FALSE; { not aborted }

     { Vul het status window }
      IF (NOT (StayQuiet OR NoFullScreen)) THEN
        WriteXY (SXb2,SYb+2,'Squish     ');

     MsgInfo:=NIL;
     Aborted:=FALSE;

     { try to open the base }
     IF (NOT OpenBase (AreaRec.FidoMsgPath,AreaRec.AreaName_F,FALSE)) THEN
        GOTO Abort;

     IF (SquishIndexNumb = 0) THEN
        GOTO Normal; { nothing to link }

     IF (SquishIndexNumb > MAX_MSGS) THEN
     BEGIN
          LogMessage (liFatal,'[SquishLink] Too many message for link operation');
          GOTO Abort;
     END;

     IF (NOT SquishOpenIndex) THEN
     BEGIN
          LogMessage (liFatal,'[SquishLink] Error opening index');
          GOTO Abort;
     END;

     IF (NOT SquishLockBase) THEN
        GOTO Abort;

     { work out how many messages there are and allocate the array of }
     { pointers and initialise it with NIL.                           }
     IF (_MaxAvail < SquishIndexNumb*SizeOf (MsgInfoRecordPtr)) THEN
     BEGIN
          LogMessage (liFatal,'[SquishLink] Not enough memory (1)');
          GOTO Abort;
     END;

     { allocate memory for the array }
     GetMem (MsgInfo,SquishIndexNumb*SizeOf (MsgInfoRecordPtr));

     IF (_MaxAvail < SquishIndexNumb*SizeOf (LONGINT)) THEN
     BEGIN
          LogMessage (liFatal,'[SquishLink] Not enough memory (2)');
          FreeMem (MsgInfo,SquishIndexNumb*SizeOf (MsgInfoRecordPtr));
          MsgInfo:=NIL;
          GOTO Abort;
     END;

     GetMem (MsgIds,SquishIndexNumb*SizeOf (LONGINT));
     FillChar (MsgIds^,SquishIndexNumb*SizeOf (LONGINT),0);

     MsgCount:=0;

     { === 1 - Read from disk === }

      IF (NOT (StayQuiet OR NoFullScreen)) THEN
        WriteXY (SXb2,SYb+6,'Scanning');
     Status.DezeToDo:=SquishIndexNumb;

     { read each SQI record, then read the frame from the .SQD file to }
     { get the rest of the info. The index has been read into memory   }
     { so we can use it right away.                                    }

     Status.DezeArea:=0;
     UtilUpdateProgress;

     FOR Lp:=1 TO SquishIndexNumb DO
     BEGIN
          IF (_MaxAvail < SizeOf (MsgInfoRecord)+1000) THEN
          BEGIN
               LogMessage (liFatal,'Not enough memory; not all messages might be linked');
               Break; { from the for }
          END;

          IF (NOT SquishReadIndex (Lp,Idx)) THEN
          BEGIN
               LogMessage (liFatal,'[SquishLink] Error reading index entry '+Longint2String (Lp));
               GOTO Abort;
          END;

          { follow the index and read the frame }
          CurrentFrame:=Idx.Ofs;

          IF (NOT SquishLoadFrame (SquishFrameHdr,CurrentFrame)) THEN
          BEGIN
               LogMessage (liFatal,'[SquishLink] Error loading frame');
               GOTO Abort;
          END;

          { check for an OK frame, then copy the needed info }
          IF (SquishFrameHdr.Frame_type = FRAME_msg) THEN
          BEGIN
               { not-deleted and recognised message type }
               Inc (MsgCount);

               { store the message info }
               GetMem (MsgInfo^[MsgCount],SizeOf (MsgInfoRecord));

               WITH MsgInfo^[MsgCount]^ DO
               BEGIN
                    FramePos:=CurrentFrame;
                    Umsgid:=Idx.Umsgid;
                    CrcReply:=0;
                    Reply:=0;
                    FillChar (Replies,MAX_REPLY*SizeOf (UMSGID_TYPE),0);
               END; { with }

               { read the kludges to find the MSGID and REPLY lines }
               { before we can do that, we have to pass the message header }
               FBSeek (SquishBaseF,CurrentFrame+SizeOf (_SQFHDRTYPE)+SizeOf (_SQMHDRTYPE));

               REPEAT
                     FBReadSquishHdrLn (SquishBaseF,Regel);

                     IF (Copy (Regel,1,8) = #1'MSGID: ') THEN
                     BEGIN
                          Delete (Regel,1,8);
                          Regel:=AddUpWithSpaces (255,Regel);
                          MsgIds^[MsgCount]:=UpdateCrc32 (0,Regel[1],255);
                          Continue;
                     END;

                     IF (Copy (Regel,1,8) = #1'REPLY: ') THEN
                     BEGIN
                          Delete (Regel,1,8);
                          Regel:=AddUpWithSpaces (255,Regel);
                          MsgInfo^[MsgCount]^.CrcReply:=UpdateCrc32 (0,Regel[1],255);
                          Continue;
                     END;

               UNTIL (Regel = #0);

          END; { if non-deleted message }

          { time slicing and abort check }
          IF ((Lp MOD 10) = 0) THEN
          BEGIN
               Status.DezeArea:=Lp;
               UtilUpdateProgress;

               Slice_Now;

               IF KeyPressed AND (ReadKey = kEsc) THEN
               BEGIN
                    Aborted:=TRUE;
                    GOTO Abort;
               END;
          END;

     END; { for }

     { === 2 - Link === }

      IF (NOT (StayQuiet OR NoFullScreen)) THEN
        WriteXY (SXb2,SYb+6,'Linking ');
     Status.DezeToDo:=MsgCount;
     Status.DezeArea:=0;
     UtilUpdateProgress;

     FOR Lp:=1 TO MsgCount DO
         IF (MsgInfo^[Lp] <> NIL) THEN
         BEGIN
              WITH MsgInfo^[Lp]^ DO
              BEGIN
                   IF (CrcReply <> 0) THEN
                   BEGIN
                        InfoNr:=FindMsgId (CrcReply,Lp);
                        IF (InfoNr <> 0) THEN
                        BEGIN
                             { copy the umsgid from the message replied to }
                             Reply:=MsgInfo^[InfoNr]^.Umsgid;

                             { add our umsgid to the forward list of replies }
                             { of the message this is a reply to }
                             AddToReplies (InfoNr,Umsgid);
                        END;
                   END;
              END; { with }

              { time slicing and abort check }
              IF ((Lp MOD 10) = 0) THEN
              BEGIN
                   Status.DezeArea:=Lp;
                   UtilUpdateProgress;

                   Slice_Now;

                   IF KeyPressed AND (ReadKey = kEsc) THEN
                   BEGIN
                        Aborted:=TRUE;
                        GOTO Abort;
                   END;
              END;

         END; { for }

     { === 3 - Write to disk === }

      IF (NOT (StayQuiet OR NoFullScreen)) THEN
        WriteXY (SXb2,SYb+6,'Updating');
     Status.DezeArea:=0;
     UtilUpdateProgress;

     FOR Lp:=1 TO MsgCount DO
     BEGIN
          { read the original frame header, update the fields, and }
          { write it back.                                         }

          WITH MsgInfo^[Lp]^ DO
          BEGIN
               {## change into a dirty blockwrite to avoid reading the }
               {   header from disk first.                             }
               { load the complete message header }
               IF (NOT SquishLoadMsgHdr (FramePos)) THEN
               BEGIN
                    LogMessage (liFatal,'[SquishLink] Error updating frame (1)');
                    GOTO Abort;
               END;

               { update the fields }
               SquishMsgHdr.Replyto:=Reply;
               FOR Lp2:=1 TO 10 DO
                   SquishMsgHdr.Replies[Lp2]:=Replies[Lp2];

               { write the updated message header to disk }
               IF (NOT SquishSaveMsgHdr (FramePos)) THEN
               BEGIN
                    LogMessage (liFatal,'[SquishLink] Error updating frame (2)');
                    GOTO Abort;
               END;

          END; { with }

          { time slicing and abort check }
          IF ((Lp MOD 10) = 0) THEN
          BEGIN
               Status.DezeArea:=Lp;
               UtilUpdateProgress;

               Slice_Now;

               IF KeyPressed AND (ReadKey = kEsc) THEN
               BEGIN
                    Aborted:=TRUE;
                    GOTO Abort;
               END;
          END;

     END; { for }

     Status.DezeArea:=MsgCount; { get to 100% }

     GOTO Normal;

Abort:
     LogMessage (liGeneral,'Aborting link of '+AreaRec.AreaName_F);

Normal:

     { free all allocated memory }
     IF (MsgInfo <> NIL) THEN
     BEGIN
          WHILE (MsgCount > 0) DO
          BEGIN
               FreeMem (MsgInfo^[MsgCount],SizeOf (MsgInfoRecord));
               Dec (MsgCount);
          END; { while }

          FreeMem (MsgInfo,SquishIndexNumb*SizeOf (MsgInfoRecordPtr));
          FreeMem (MsgIds,SquishIndexNumb*SizeOf (LONGINT));
     END;

     { close the base and free the memory; if allocated }
     SquishUnlockBase;
     CloseBase;

     Squish_LinkArea:=Aborted;
END;


{--------------------------------------------------------------------------}
{ Squish_Init                                                              }
{                                                                          }
PROCEDURE Squish_Init;
BEGIN
     CurrentBase:=''; { base is closed }
     TouchCounter:=0;
     SquishIndexIsOpen:=FALSE;
END;


{---------------------------------------------------------------------------}
{ Squish_Done                                                               }
{                                                                           }
PROCEDURE Squish_Done;
BEGIN
     CloseBase;
END;


{--------------------------------------------------------------------------}
{ Squish_Rescan                                                            }
{                                                                          }
{ This routine scans the given message base for the RESCAN procedure.      }
{                                                                          }
PROCEDURE Squish_Rescan (VAR AreaRec : AreaBaseRecord);

VAR LocalFido       : FidoAddrType;
    Einde           : BOOLEAN;
    DT              : DateTime;
    UserName        : STRING[MaxLenUserName_F];
    LastRegel,
    Regel           : STRING;
    WhereTo         : WhereToType;
    SquishNextFrame : LONGINT;
    Nop             : UMSGID_Type;
    P               : BYTE;
    Result          : RescanResultType;

    PrevTouch       : BYTE;
    OldCurrentFrame : LONGINT;

    OldFramePos     : LONGINT;
    OldFrameBU      : LONGINT;
    OldBaseName     : STRING;
    OldCurrentBase  : STRING;
    OldUID          : UMSGID_TYPE;

LABEL Verder,
      CloseIt;

BEGIN
     { open de Squish message area }
     IF (NOT OpenBase (AreaRec.FidoMsgPath,AreaRec.AreaName_F,TRUE)) THEN
        Exit;

     UpdateReadFile (AreaRec.FidoMsgPath,0);

     { Als dit een nieuwe area is hoeven we 'm natuurlijk ook niet te }
     { scannen. Kijk of er uberhaupt wel berichten in de area staan.  }
     IF (SquishBase.Num_Msg = 0) THEN
     BEGIN
          { no messages in the base }
          IF (CurrentBase <> '') THEN
             GOTO CloseIt;
     END;

     { houdt de stats bij van de lokale gebieden }
     {## needs replacing! }
     UserDataRecNr:=NILRecordNr;

     {## what protects us from other utilities deleting messages }
     {   while we are scanning the base?                         }

     Result:=rstNoExport;

     REPEAT
           { Laadt het juiste frame }
           IF (CurrentFrame = NULLFRAME) THEN
           BEGIN
                { ignore the high water mark }
                SquishLoadFrameType (SQ_FIRST);
           END ELSE
               SquishLoadFrameType (SQ_NEXT);

           { Bewaar de frame header voor het geval dat we het bericht }
           { deleten.                                                 }
           SquishNextFrame:=SquishFrameHdr.Next_Frame;

           { laad de fidoheader }
           IF (NOT SquishLoadMsgHdr (CurrentFrame)) THEN
              GOTO CloseIt; { RWI 960417 }

           { do not export messages with a Hold flag }
           IF ((SquishMsgHdr.Attr AND MSGHOLD) <> 0) THEN
              Continue;

           Result:=Rescan_ExportCheck (
                           PackedDosDateTime2UnixDateTime (
                           SquishDateTime2PackedDosDateTime (SquishMsgHdr.Date_Written)));

           IF (Result <> rstExport) THEN
              GOTO Verder;

           MsgsEmpty;

           { converteer de Squish header naar de standaard fido header }
           WITH Msg,SquishMsgHdr DO
           BEGIN
                Attr_F:=Attr;

                { RWI 961011: controle op #0 ivm met volledige gebruikte pchars ingevoerd }
                Move (FromWhom,FromUser_F[1],SQMSG_FROM_SIZE);
                FromUser_F[0]:=Char (SQMSG_FROM_SIZE);
                FOR P:=1 TO SQMSG_FROM_SiZE DO
                    IF (FromWhom[P] = #0) THEN
                    BEGIN
                         FromUser_F[0]:=Char (P-1);
                         Break;
                    END;

                Move (ToWhom,Stored_ToUser[1],SQMSG_TO_SIZE);
                Stored_ToUser[0]:=Char (SQMSG_TO_SIZE);
                FOR P:=1 TO SQMSG_TO_SIZE DO
                    IF (ToWhom[P] = #0) THEN
                    BEGIN
                         Stored_ToUser[0]:=Char (P-1);
                         Break;
                    END;

                Move (Subj,Subj_F[1],SQMSG_SUBJ_SIZE);
                Subj_F[0]:=Char (SQMSG_SUBJ_SIZE);
                FOR P:=1 TO SQMSG_SUBJ_SIZE DO
                    IF (Subj[P] = #0) THEN
                    BEGIN
                         Subj_F[0]:=Char (P-1);
                         Break;
                    END;

                Squish2FidoAdres (Dest,Stored_ToAddr);
                Squish2FidoAdres (Orig,FromAddr_F);

                UnpackTime (SquishDateTime2PackedDosDateTime (Date_Written),DT);
                Date_F:=DosDateTime2FidoDateTimeStr (DT);
           END;

           Msg.Area_F:=AreaRec.AreaName_F;
           Msg.Ready_F:=Local_Echomail;

           { --- Inlezen van het header gedeelte van het bericht }
           PrevKludgeID:=klNone;
           REPEAT
                 FBReadSquishHdrLn (SquishBaseF,Regel);

                 IF (Regel <> #0) THEN
                    FidoAddLineToMessage (Regel+#13,LastRegel);

           UNTIL (Regel = #0);

           { --- Init boolean variabelen }
           Found_SeenBy:=FALSE;
           Found_Path:=FALSE;
           Found_Origin:=FALSE;
           Found_Tear:=FALSE;

           { lees het bericht regel voor regel in de buffer }
           REPEAT
                 Einde:=FBReadLnCR (SquishBaseF,Regel);
                 IF (Regel = #0) THEN
                    Break;

                 WHILE (Pos (#$8D,Regel) > 0) DO
                       Delete (Regel,Pos (#$8D,Regel),1);

                 { RWI 950916: De tear-line kwam door als #13'--- timEd' }
                 {             en werd door de #13 dus niet goed als     }
                 {             kludge geidentificeerd.                   }
                 IF (Regel[1] = #13) THEN
                 BEGIN
                      FidoAddLineToMessage (#13,LastRegel);
                      IF (Length (Regel) > 1) THEN
                      BEGIN
                           Delete (Regel,1,1);
                           FidoAddLineToMessage (Regel,LastRegel);
                      END;
                 END ELSE
                     FidoAddLineToMessage (Regel,LastRegel);

           UNTIL (NOT Einde);

           FidoAddLastLine (LastRegel);

           { ignore LOCKed messages }
           IF ((Msg.ExtAttr_F AND EXTMSGLOK) <> 0) THEN
              Continue;

           FidoFinishEchomailExport (AreaRec);

           { exporteer the message }

           { keep track of the global structures }
           { if the export results into an import into this base  }
           { then another base might be open after the export and }
           { must then recover.                                   }
           PrevTouch:=TouchCounter;
           OldCurrentFrame:=CurrentFrame;

           Rescan_DeliverMessage;

           IF (TouchCounter <> PrevTouch) THEN
           BEGIN
                { re-open the correct base }
                IF (NOT OpenBase (AreaRec.FidoMsgPath,AreaRec.AreaName_F,{AllowCreate:}FALSE)) THEN
                BEGIN
                     LogMessage (liFatal,'[Squish] Failed to re-open '+AreaRec.AreaName_F);
                     GOTO CloseIt;
                END;

                CurrentFrame:=OldCurrentFrame;

                { load message header again }
               if (NOT SquishLoadFrame (SquishFrameHdr, CurrentFrame)) then begin
                  LogMessage (liFatal, '[Squish] Unable to re-load frame!');
                  goto CloseIt;
                end;

                IF (NOT SquishLoadMsgHdr (CurrentFrame)) THEN begin
                     LogMessage (liFatal, '[Squish] Unable to load header for frame');
                     GOTO CloseIt;
                end;

           END;

Verder:
     UNTIL (Result = rstNoExport_Stop) OR (SquishNextFrame = NULLFRAME);

CloseIt:
     CloseBase;
     MsgsEmpty;
END;


{---------------------------------------------------------------------------}
{ Unit Initialization                                                       }
{                                                                           }
BEGIN
     Squish_Init;
END.

