{$IFDEF WtrGate}{$IFDEF UseOvr}{$O+,F+}{$ENDIF}{$ENDIF}
UNIT WildCat;

{ support for WildCat message bases }

INTERFACE

USES Database;

{
 There are two files: MSGnnnnn.IX and MSGnnnnn.DAT.

 The .IX file contains the message number index.
 The .DAT file contains the message headers and text.

 The .IX file starts with a six byte header (wc_MsgIndexHeader),
 followed by wc_MsgIndexEntry records for each message with the
 message number and an offset in the .DAT file where the message
 starts.

 We search through the index, reading each entry and following
 the link to the .DAT file for scanning out.

 When adding a new message, we increase the appropriate fields
 in the header, write it back, add the message to the bottom of
 the .DAT file and add an entry to the .IX file with the offset
 information and message number.
}


TYPE wc_MsgIndexHeader = RECORD
                               { must be same size as TMsgIndexEntry }
                               RecordSize    : WORD;
                               ActiveRecords : WORD;
                               NextMsgNumber : WORD;
                         END;

     wc_MsgIndexEntry = RECORD
                              { must be same size as TMsgIndexHeader }
                              MsgNumber    : WORD;
                              HeaderOffset : LONGINT;
                        END;


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

     wc_DateTimeRec = RECORD
                            Date : WORD;      { days since 1/1/1900 }
                            Time : LONGINT;   { secs since 00:00:00 }
                      END;

     wc_MsgHeader = RECORD
                          MagicNumber    : LONGINT;
                          MsgNumber      : WORD;
                          Orig           : STRING[70];
                          OrigTitle      : STRING[10];
                          OrigUserID     : LONGINT;
                          Dest           : STRING[70];
                          DestTitle      : STRING[10];
                          DestUserID     : LONGINT;
                          Subject        : STRING[70];
                          Network        : STRING[8];
                          MsgTime        : wc_DateTimeRec;
                          ReadTime       : wc_DateTimeRec;
                          mFlags         : WORD;
                          Reference      : WORD;
                          FidoFrom       : wc_FidoAddress;
                          FidoTo         : wc_FidoAddress;
                          MsgBytes       : WORD;
                          InternalAttach : STRING[12];
                          ExternalAttach : STRING[12];
                          PrevUnread     : WORD;
                          NextUnread     : WORD;
                          FidoFlags      : WORD;
                          Cost           : LONGINT;
                          Area           : WORD;
                          Reserved       : ARRAY[1..18] OF BYTE;
                    END;


TYPE WildCatBase = OBJECT
                         IsOpen : BOOLEAN;

                         { message base files }
                         IxFile  : FILE;
                         DatFile : FILE;

                         { voor loggen }
                         BaseDescr : STRING[80];

                         { voor GetFirstMessage / GetNextMessage }
                         IxOffset : LONGINT;
                         IxEntry  : wc_MsgIndexEntry;

                         DatHdr   : wc_MsgHeader;

                         TouchCounter : WORD;

                         CONSTRUCTOR InitBase;
                         DESTRUCTOR  DeInitBase;

                         FUNCTION  CreateBase : BOOLEAN;
                         FUNCTION  OpenBase (Area_Name, Area_Path : STRING) : BOOLEAN;
                         PROCEDURE CloseBase;

                         FUNCTION  LockBase : BOOLEAN;
                         PROCEDURE UnLockBase;

                         FUNCTION  GetFirstMessage : BOOLEAN;
                         FUNCTION  GetNextMessage : BOOLEAN;
                         FUNCTION  ReadHeaderEntry : BOOLEAN;

                         PROCEDURE ScanArea (VAR AreaData : AreaBaseRecord; IsPrimaryNetmailArea,IsBadArea : BOOLEAN);

                         FUNCTION  AllocateMsgNumber (HeaderPos : LONGINT) : WORD;
                         PROCEDURE WriteMessage (Area_Name,Area_Path : STRING);
                   END;

VAR WildCatMsgBase : WildCatBase;


IMPLEMENTATION

USES Ramon,
     Dos,
     Globals,
     Logs,
     Msgs,
     UserBase,
     Fido,
     Cfg,
     Start,
     Stats,
     SwapMem,
     UnixTime,
     Decode,
     BBSUsers,
     Scan;

CONST mfPrivate     = $0001;
      mfReceiveable = $0002;
      mfReceived    = $0004;
      mfReceipt     = $0008;
      mfCarboned    = $0010;
      mfForwarded   = $0020;
      mfEchoFlag    = $0040;
      mfHasReplies  = $0100;
      mfDeleted     = $0200;
      mfTagged      = $0400;
      mfSent        = $0800;
      mfChgAttach   = $1000;
      mfForwarding  = $2000;
      mfNoDelete    = $4000;
      mfNDAttach    = $8000;


{--------------------------------------------------------------------------}
{ WildCatBase.InitBase                                                     }
{                                                                          }
CONSTRUCTOR WildCatBase.InitBase;
BEGIN
     IsOpen:=FALSE;
     TouchCounter:=0;
END;


{--------------------------------------------------------------------------}
{ WildCatBase.DeInitBase                                                   }
{                                                                          }
DESTRUCTOR WildCatBase.DeInitBase;
BEGIN
     CloseBase;
END;


{--------------------------------------------------------------------------}
{ WildCatBase.CreateBase                                                   }
{                                                                          }
{ Deze routine maakt een nieuwe WildCat message base aan. Geeft TRUE terug }
{ als het gelukt is.                                                       }
{                                                                          }
{ Deze IxFile en DatFile zijn al assigned. Als het aanmaken gelukt is, dan }
{ mogen de files open gehouden worden.                                     }
{                                                                          }
FUNCTION WildCatBase.CreateBase : BOOLEAN;

VAR IORes : BYTE;
    IxHdr : wc_MsgIndexHeader;

BEGIN
     CreateBase:=FALSE; { assume it failed }

     Inc (TouchCounter);

     {$I-} ReWrite (IxFile,1); {$I+} IORes:=IOResult;
     IF (IORes <> 0) THEN
     BEGIN
          LogDiskIOError (IORes,'[WC] Error creating .IX file '+BaseDescr);
          Exit;
     END;

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

     {$I-} ReWrite (DatFile,1); {$I+} IORes:=IOResult;
     IF (IORes <> 0) THEN
     BEGIN
          LogDiskIOError (IORes,'[WC] Error creating .DAT file '+BaseDescr);
          {$IFDEF LogFileIO}PreCloseF (IxFile);{$ENDIF}
          Close (IxFile);
          Exit;
     END;

     LogMessage (liGeneral,'Created WildCat message base '+BaseDescr);

     { default header aanmaken }
     IxHdr.RecordSize:=SizeOf (wc_MsgIndexEntry); { 6 }
     IxHdr.ActiveRecords:=0;
     IxHdr.NextMsgNumber:=1;

     { schrijf de nieuwe header naar disk }
     Seek (IxFile,0);
     {$I-} BlockWrite (IxFile,IxHdr,SizeOf (wc_MsgIndexHeader));  {$I+} IORes:=IOResult;
     IF (IORes <> 0) THEN
     BEGIN
          LogDiskIOError (IORes,'Error writing header for new .IX file');

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

          {$IFDEF LogFileIO}PreCloseF (DatFile);{$ENDIF}
          Close (DatFile);
          CreateBase:=FALSE;
     END;

     CreateBase:=TRUE; { succesful }
END;


{--------------------------------------------------------------------------}
{ WildCatBase.OpenBase                                                     }
{                                                                          }
{ Deze routine opent een WildCat message base. Als ie niet bestaat, dan    }
{ wordt geprobeerd deze aan te maken via CreateBase. Geeft TRUE terug en   }
{ zet IsOpen op TRUE als alles lukt.                                       }
{                                                                          }
FUNCTION WildCatBase.OpenBase (Area_Name, Area_Path : STRING) : BOOLEAN;

VAR IORes : BYTE;

LABEL Done;

BEGIN
     OpenBase:=FALSE; { assume it failed }

     IF IsOpen THEN
        CloseBase;

     Inc (TouchCounter);

     BaseDescr:=Area_Path; { for logging }

     { ADD: check for .LCK files in the MSGLOCK directory! }

     Assign (IxFile,Area_Path+'.IX');
     Assign (DatFile,Area_Path+'.DAT');

     {$I-} Reset (IxFile,1); {$I+} IORes:=IOResult;
     IF (IORes = 2) THEN
     BEGIN
          IF CreateBase THEN
             GOTO Done;

          { probeer nog eens te openen }
          {$I-} Reset (IxFile,1); {$I+} IORes:=IOResult;
     END;

     IF (IORes <> 0) THEN
     BEGIN
          LogDiskIOError (IORes,'[WC] Error opening .IX file '+BaseDescr);
          Exit; { IsOpen = FALSE }
     END;

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

     {$I-} Reset (DatFile,1); {$I+} IORes:=IOResult;
     IF (IORes <> 0) THEN
     BEGIN
          LogDiskIOError (IORes,'[WC] Error opening .DAT file '+BaseDescr);

          {$IFDEF LogFileIO}PreCloseF (IxFile);{$ENDIF}
          Close (IxFile);
          Exit; { IsOpen = FALSE }
     END;

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

Done:

     { message base sanity checking can be added here }

     IsOpen:=TRUE; { needs to be closed }

     OpenBase:=TRUE; { succesful }
END;


{--------------------------------------------------------------------------}
{ WildCatBase.CloseBase                                                    }
{                                                                          }
{ Deze routine sluit de message base die nu misschien open is.             }
{                                                                          }
PROCEDURE WildCatBase.CloseBase;
BEGIN
     IF IsOpen THEN
     BEGIN
          { unlock? (just in case) }

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

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

          IsOpen:=FALSE;

          Inc (TouchCounter);
     END;
END;


{--------------------------------------------------------------------------}
{ WildCatBase.LockBase                                                     }
{                                                                          }
{ Needs to lock the first byte of the .IX file.                            }
{                                                                          }
FUNCTION WildCatBase.LockBase : BOOLEAN;
BEGIN
     LockBase:=TRUE; { successful }
END;


{--------------------------------------------------------------------------}
{ WildCatBase.UnlockBase                                                   }
{                                                                          }
PROCEDURE WildCatBase.UnlockBase;
BEGIN
END;


{--------------------------------------------------------------------------}
{ WildCatBase.GetFirstMessage                                              }
{                                                                          }
{ Deze routine zoekt het eerste bericht op en geeft deze terug.            }
{                                                                          }
FUNCTION WildCatBase.GetFirstMessage : BOOLEAN;

VAR IxHdr : wc_MsgIndexHeader;
    IORes : BYTE;

BEGIN
     GetFirstMessage:=FALSE; { assume failure }

     { zoekt in de index en geeft de pointer naar het eerste bericht }
     Seek (IxFile,0);
     {$I-} BlockRead (IxFile,IxHdr,SizeOf (wc_MsgIndexHeader)); {$I+} IORes:=IOResult;
     IF (IORes <> 0) THEN
     BEGIN
          LogDiskIOError (IORes,'[WC] Error reading header from .IX file '+BaseDescr);
          Exit; { false }
     END;

     IxOffset:=SizeOf (wc_MsgIndexHeader)-SizeOf (wc_MsgIndexEntry);

     GetFirstMessage:=GetNextMessage;
END;


{--------------------------------------------------------------------------}
{ WildCatBase.GetNextMessage                                               }
{                                                                          }
{ Deze routine zoekt het volgende actieve bericht. De laatste gebruikte    }
{ index offset is opgeslagen in Search_LastOffset. We zoeken daar vandaan  }
{ plus de grote van een index record verder.                               }
{                                                                          }
FUNCTION WildCatBase.GetNextMessage : BOOLEAN;

VAR IORes : BYTE;

BEGIN
     GetNextMessage:=FALSE; { assume the search failed }

     Inc (IxOffset,SizeOf (wc_MsgIndexEntry));

     IF (IxOffset >= FileSize (IxFile)) THEN
        Exit; { false }

     Seek (IxFile,IxOffset);
     {$I-} BlockRead (IxFile,IxEntry,SizeOf (wc_MsgIndexEntry)); {$I+} IORes:=IOResult;
     IF (IORes <> 0) THEN
     BEGIN
          LogDiskIOError (IORes,'[WC] Error reading entry from .IX file '+BaseDescr);
          Exit; { false }
     END;

     { controle of het bericht verwijderd is gebeurd in de scan loop }
     GetNextMessage:=TRUE; { success }
END;


{--------------------------------------------------------------------------}
{ WildCatBase.ReadHeaderEntry                                              }
{                                                                          }
{ Deze routine leest een message header in aan de hand van de info in de   }
{ IxEntry variabele. Als dit lukt, dan wordt TRUE terug gegeven.           }
{                                                                          }
FUNCTION WildCatBase.ReadHeaderEntry : BOOLEAN;

VAR IORes          : BYTE;
    Day,Month,Year,
    Hour,Min,Sec   : WORD;

BEGIN
     ReadHeaderEntry:=FALSE; { assume failure }

     {$I-} Seek (DatFile,IxEntry.HeaderOffset); {$I+} IORes:=IOResult;
     IF (IORes = 0) THEN
     BEGIN
          {$I-} BlockRead (DatFile,DatHdr,SizeOf (wc_MsgHeader)); {$I+} IORes:=IOResult;
     END;

     IF (IORes <> 0) THEN
     BEGIN
          LogDiskIOError (IORes,'[WC] Error reading header from .DAT file '+BaseDescr);
          Exit;
     END;

     { extract info -> Msg record }
     Msg.FromUser_F:=DatHdr.Orig;
     Msg.Stored_ToUser:=DatHdr.Dest;
     Msg.Subj_F:=DatHdr.Subject;

     Msg.FromAddr_F.Zone:=DatHdr.FidoFrom.Zone;
     Msg.FromAddr_F.Net:=DatHdr.FidoFrom.Net;
     Msg.FromAddr_F.Node:=DatHdr.FidoFrom.Node;
     Msg.FromAddr_F.Point:=DatHdr.FidoFrom.Point;
     Msg.FromAddr_F.Domain:='';

     Msg.Stored_ToAddr.Zone:=DatHdr.FidoTo.Zone;
     Msg.Stored_ToAddr.Net:=DatHdr.FidoTo.Net;
     Msg.Stored_ToAddr.Node:=DatHdr.FidoTo.Node;
     Msg.Stored_ToAddr.Point:=DatHdr.FidoTo.Point;
     Msg.Stored_ToAddr.Domain:='';

     Msg.Date_F:=FidoCurrTime2Str;

     {
     OrigTitle      : STRING[10];
     OrigUserID     : LONGINT;
     DestTitle      : STRING[10];
     DestUserID     : LONGINT;
     Network        : STRING[8];
     MsgTime        : wc_DateTimeRec;
     ReadTime       : wc_DateTimeRec;
     Reference      : WORD;
     InternalAttach : STRING[12];
     ExternalAttach : STRING[12];
     PrevUnread     : WORD;
     NextUnread     : WORD;
     FidoFlags      : WORD;
     Cost           : LONGINT;
     Area           : WORD;
     Reserved       : ARRAY[1..18] OF BYTE;
     }

     ReadHeaderEntry:=TRUE; { successful }
END;


{--------------------------------------------------------------------------}
{ WildCatBase.ScanArea                                                     }
{                                                                          }
{ Deze routine doorzoekt een WildCat area op nieuwe berichten en           }
{ exporteert die daarna. Zowel netmail, echomail als e-mail areas zijn     }
{ ondersteund.                                                             }
{                                                                          }
PROCEDURE WildCatBase.ScanArea (VAR AreaData : AreaBaseRecord; IsPrimaryNetmailArea,IsBadArea : BOOLEAN);

VAR BytesRead    : WordLong;
    BytesToRead  : WORD;
    Regel        : STRING;
    LastRegel    : STRING;
    Lp           : BYTE;
    IORes        : BYTE;
    FirstExport  : BOOLEAN;
    P            : BYTE;
    PrevCounter  : WORD;
    PrevIXOffset : LONGINT;

LABEL NextMsg;

BEGIN
     IF IsBadArea THEN
     BEGIN
          LogMessage (liDebug,'SCANBAD on WildCat base not implemented yet.');
          Exit;
     END;

     { at export: this message is not from a user, but from a msgbase }
     UserDataRecNr:=NILRecordNr;

     IF (NOT OpenBase (AreaData.AreaName_F,AreaData.FidoMsgPath)) THEN
        Exit;

     IF (NOT GetFirstMessage) THEN
     BEGIN
          { er zijn geen berichten aanwezig }
          CloseBase;
          Exit;
     END;

     UpdateReadFile (AreaData.FidoMsgPath,0);

     FirstExport:=TRUE;

     REPEAT
           { Lees de bericht header en subfields in het geheugen }
           IF (NOT ReadHeaderEntry) THEN
           BEGIN
                { abort }
                CloseBase;
                Exit;
           END;

           { sla vrije blokken over }
           IF (DatHdr.MagicNumber <> $001A1A1B) THEN
              GOTO NextMsg;

           { sla sent/deleted berichten over }
           IF ((DatHdr.mFlags AND mfSent) <> 0) OR
              ((DatHdr.mFlags AND mfDeleted) <> 0)
           THEN
               GOTO NextMsg;

           MsgsEmpty;  { RAWI 970818: moved here }

           CASE AreaData.AreaType OF
                Area_Netmail:
                    BEGIN
                         { this is not gonna work with 0:0/0.0 addresses.. }
                         Msg.Ready_F:=Local_Netmail;

                         IF FidoCompare (Msg.FromAddr_F,NullAdres) THEN
                            Msg.FromAddr_F:=Config.NodeNrs[AreaData.OriginAKA];
                    END;

                Area_EMail:
                    BEGIN
                         { RWI 970223: now using AreaData Origin AKA for From }
                         Msg.FromAddr_F:=Config.NodeNrs[AreaData.OriginAKA];
                         Msg.Ready_F:=Local_Netmail;
                    END;

                ELSE BEGIN
                     Msg.Ready_F:=Local_Echomail;
                     { Stop de AREA: kludge in de eerste regel van het bericht }
                     Msg.Area_F:=AreaData.AreaName_F;
                     { RAWI 971012: handled by PKT export..
                     MsgsAddLineTo (Header_F,'AREA:'+Msg.Area_F);
                     }

                     IF FidoCompare (Msg.FromAddr_F,NullAdres) THEN
                        Msg.FromAddr_F:=Config.NodeNrs[AreaData.OriginAKA];
                END;
           END; { case }

           { lees het bericht regel voor regel in }
           BytesToRead:=DatHdr.MsgBytes;

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

           WHILE (BytesToRead > 0) DO
           BEGIN
                {$I-} BlockRead (DatFile,Regel[1],255,BytesRead); {$I+} IORes:=IOResult;
                IF (IORes <> 0) THEN
                BEGIN
                     LogDiskIOError (IORes,'Error reading WildDat message from '+BaseDescr);
                     MsgsEmpty;
                     GOTO NextMsg; { abort }
                END;

                Regel[0]:=Char (BytesRead);

                P:=Pos (#13,Regel);
                IF (P > 0) THEN
                   Regel[0]:=Char (P);

                { replace all #0's }
                REPEAT
                      P:=Pos (#0,Regel);
                      IF (P > 0) THEN
                         Regel[P]:=#1;
                UNTIL (P = 0);

                { terug naar het begin van de volgende regel }
                { dat moet een cache maar sneller maken }
                Seek (DatFile,FilePos (DatFile)-(BytesRead-Length (Regel)));

                { verminder het aantal bytes dat we gelezen hebben }
                Dec (BytesToRead,Length (Regel));

                FidoAddLineToMessage (Regel,LastRegel);
           END; { while }

           FidoAddLastLine (LastRegel);

           { fix het bericht door ontbrekende delen bij te vullen }
           IF (NOT Found_Tear) AND (Msg.Ready_F <> Local_Netmail) THEN
              MsgsAddLineTo (Footer_F,FidoTear);

           { Zorg dat er een tearline wordt toegevoegd, een origin line }
           { zodat we een 'echt' fido bericht krijgen.                  }
           IF (AreaData.AreaType = Area_Echo) THEN
              FidoFinishEchomailExport (AreaData);

           { Voeg INTL, TOPT en FMPT regels toe }
           IF (AreaData.AreaType = Area_EMail) THEN
           BEGIN
                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 (liGeneral,'WildCat msg '+Longint2String (DatHdr.MsgNumber)+
                                             ': No e-mail address in To: ("'+Msg.Stored_ToUser+'")');
                              GOTO NextMsg;  { 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;

           Msg.Attr_F:=MSGLOCAL; { meer hebben we niet, eventueel Private }


           { 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 !                         }

           IF (Msg.Ready_F = Local_Netmail) AND { RWI 941102: toegevoegd, anders krijg echomail geen sent flag }
              (NOT FidoCheckNetmail (IsPrimaryNetmailArea,Msg.Stored_ToUser,Msg.Stored_ToAddr))
           THEN
               GOTO NextMsg; { netmail voor FD. Bye! }

           { update de header met een SENT vlag }
           DatHdr.mFlags:=DatHdr.mFlags OR mfSent;

           { schrijf de header naar disk }
           IF LockBase THEN
           BEGIN
                {$I-} Seek (DatFile,IxEntry.HeaderOffset); {$I+} IORes:=IOResult;
                IF (IORes = 0) THEN
                BEGIN
                     {$I-} BlockWrite (DatFile,DatHdr,SizeOf (wc_MsgHeader)); {$I+} IORes:=IOResult;
                END;

                IF (IORes <> 0) THEN
                BEGIN
                     LogDiskIOError (IORes,'[WC] Error writing message header for '+BaseDescr);
                     GOTO NextMsg;
                END;

                UnlockBase;
           END;

           { -- Exporteer het bericht    }

           UpdateInfoNr (INFO_WildCatScan_Msgs,1);
           UpdateInfoNr (INFO_WildCatScan_Bytes,DatHdr.MsgBytes);

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

           IF (Msg.Ready_F = Local_Netmail) THEN
           BEGIN
                UpdateInfoNr (INFO_WildCatScan_Net,1);

                IF Config.LogExportedMsgs THEN
                   LogMessage (liTrivial,'  Exporting msg nr '+Word2String (DatHdr.MsgNumber)+
                               ' for "'+Msg.Stored_ToUser+'"%'+Fido2Str (Msg.Stored_ToAddr));
           END ELSE
           BEGIN
                UpdateInfoNr (INFO_WildCatScan_Echo,1);

                UpdateAreaStats (GetAreaBaseRecordNrByAreaName_F (AreaData.AreaName_F),Msg.MsgSize);
                UpdateUserStats (NILRecordNr{=Local},EchoFrom,Msg.MsgSize);

                IF Config.LogExportedMsgs THEN
                   LogMessage (liTrivial,'  Exporting msg nr '+Word2String (DatHdr.MsgNumber)+
                               ' for "'+Msg.Stored_ToUser+'"');
           END;

           PrevCounter:=TouchCounter;

           {PostAttrs:=}Scan_DeliverMessage (IsBadArea);

           IF (TouchCounter <> PrevCounter) THEN
           BEGIN
                UserDataRecNr:=NILRecordNr;

                IF (NOT OpenBase (AreaData.AreaName_F,AreaData.FidoMsgPath)) THEN
                   Exit;

                UpdateReadFile (AreaData.FidoMsgPath,0);

                { restore the getfirst/next offset }
                IxOffset:=PrevIxOffset;
           END;

           MsgsEmpty;

        NextMsg:

     UNTIL (NOT GetNextMessage);

     { einde area }
     CloseBase;
END;


{--------------------------------------------------------------------------}
{ GuessSplitParts                                                          }
{                                                                          }
{ Deze routine berekent hoeveel split parts het bericht moet worden.       }
{                                                                          }
FUNCTION GuessSplitParts (VAR MaxLenBodyBlock : LONGINT) : WORD;

VAR FidoHeaderLen,
    FidoBodyLen,
    FidoFooterLen : LONGINT;
    SplitParts_R  : REAL;
    Parts         : BYTE;

BEGIN
     IF (Config.MaxWildCatMsgLen = 0) THEN
     BEGIN
          MaxLenBodyBlock:=MaxLongint;
          GuessSplitParts:=1;
          Exit;
     END;

     { kijk of we de limiet gaan overschrijven }
     IF (Msg.HeaderTop_F <> NIL) THEN
        FidoHeaderLen:=Msg.HeaderTop_F^.TotalRegelLength
     ELSE
         FidoHeaderLen:=0;

     (* use other function..
     IF (Msg.BodyTop <> NIL) THEN
        FidoBodyLen:=Msg.BodyTop^.TotalRegelLength
     ELSE
         FidoBodyLen:=0;
     *)

     IF (Msg.FooterTop_F <> NIL) THEN
        FidoFooterLen:= Msg.FooterTop_F^.TotalRegelLength
     ELSE
         FidoFooterLen:=0;

     { bepaal de maximale ruimte voor een body blok }
     MaxLenBodyBlock:=Config.MaxWildCatMsgLen-80{split header}-
                      FidoHeaderLen-FidoFooterLen;

     { bereken het aantal delen waarin het bericht gesplitst gaat worden }
     SplitParts_R:=FidoBodyLen / MaxLenBodyBlock;

     Parts:=Trunc (SplitParts_R);

     IF (Parts < SplitParts_R) THEN
        Inc (Parts);

     GuessSplitParts:=Parts;
END;


{--------------------------------------------------------------------------}
{ WildCatBase.AllocateMsgNumber                                            }
{                                                                          }
{ Deze routine bepaald het volgende message nummer en geeft deze terug.    }
{ 0 on error.                                                              }
{                                                                          }
FUNCTION WildCatBase.AllocateMsgNumber (HeaderPos : LONGINT) : WORD;

VAR IORes : BYTE;
    IxHdr : wc_MsgIndexHeader;

BEGIN
     { nieuw message nummer nemen, index header updaten, }
     { index record toevoegen.                           }

     { read the header from disk }
     {$I-} Seek (IxFile,0); {$I+} IORes:=IOResult;
     IF (IORes = 0) THEN
     BEGIN
          {$I-} BlockRead (IxFile,IxHdr,SizeOf (wc_MsgIndexHeader)); {$I+} IORes:=IOResult;
     END;

     IF (IORes <> 0) THEN
     BEGIN
          LogDiskIOError (IORes,'[WC] Error reading header from .IX file '+BaseDescr);
          AllocateMsgNumber:=0;
          Exit;
     END;

     Inc (IxHdr.ActiveRecords);
     Inc (IxHdr.NextMsgNumber);

     { write the updated header back to disk }
     {$I-} Seek (IxFile,0); {$I+} IORes:=IOResult;
     IF (IORes = 0) THEN
     BEGIN
          {$I-} BlockWrite (IxFile,IxHdr,SizeOf (wc_MsgIndexHeader)); {$I+} IORes:=IOResult;
     END;

     IF (IORes <> 0) THEN
     BEGIN
          LogDiskIOError (IORes,'[WC] Error updating header to .IX file '+BaseDescr);
          AllocateMsgNumber:=0;
          Exit;
     END;

     { voeg nu een entry to aan het einde van de index file }

     { header is al geupdate, dus we nemen min 1 }
     IxEntry.MsgNumber:=IxHdr.NextMsgNumber-1;
     IxEntry.HeaderOffset:=HeaderPos;

     {$I-} Seek (IxFile,FileSize (IxFile)); {$I+} IORes:=IOResult;
     IF (IORes = 0) THEN
     BEGIN
          {$I-} BlockWrite (IxFile,IxEntry,SizeOf (wc_MsgIndexEntry)); {$I+} IORes:=IOResult;
     END;

     IF (IORes <> 0) THEN
     BEGIN
          LogDiskIOError (IORes,'[WC] Error adding entry to .IX file '+BaseDescr);
          AllocateMsgNumber:=0;
          Exit;
     END;

     AllocateMsgNumber:=IxEntry.MsgNumber;
END;


{--------------------------------------------------------------------------}
{ FidoDateToWildCatDate                                                    }
{                                                                          }
{ Deze routine vertaald een fidonet formaat datum "12 Jan 96  12:13:14"    }
{ in een WildCat datum.                                                    }
{                                                                          }
PROCEDURE FidoDateToWildCatDate (FidoDate : STRING; VAR WCDate : wc_DateTimeRec);

VAR DT  : DateTime;
    Lp  : BYTE;
    Nop : ValNop;

BEGIN
     Val (Copy (FidoDate,1,2),DT.Day,Nop);
     Val (Copy (FidoDate,8,2),DT.Year,Nop);
     Val (Copy (FidoDate,12,2),DT.Hour,Nop);
     Val (Copy (FidoDate,15,2),DT.Min,Nop);
     Val (Copy (FidoDate,18,2),DT.Sec,Nop);

     DT.Month:=1; { just in case }

     FOR Lp:=1 TO 12 DO
         IF (Month[Lp] = Copy (FidoDate,4,3)) THEN
         BEGIN
              DT.Month:=Lp;
              Break;
         END;

     IF (DT.Year > 79) THEN
        Inc (DT.Year,1900)
     ELSE
         Inc (DT.Year,2000);


     { nu de getallen met een formule omzetten in het WildCat formaat }
     WCDate.Time:=(Longint (DT.Hour)*SEC_Uur)+
                  (Longint (DT.Min)*SEC_Minuut)+
                  DT.Sec;

     IF (DT.Year = 1900) AND (DT.Month < 3) THEN
     BEGIN
          { past niet in de formule hieronder }
          IF (DT.Month = 1) THEN
             WCDate.Date:=DT.Day-1
          ELSE
              WCDate.Date:=DT.Day+30
     END ELSE
     BEGIN
          { verschuif 29 februari naar ... }
          IF (DT.Month > 2) THEN
             Dec (DT.Month,3)
          ELSE BEGIN
               { verschuif jan+feb dit jaar naar vorig jaar }
               Inc (DT.Month,9);
               Dec (DT.Year);
          END;

          Dec (DT.Year,1900);

          { 1461 = aantal dagen per vier jaar }
          WCDate.Date:=((Longint (DT.Year)*1461) DIV 4)+
                       (((153*DT.Month) + 2) DIV 5)+
                       DT.Day+
                       58;   { first two months in 1900 }
     END;
END;


{--------------------------------------------------------------------------}
{ WildCatBase.WriteMessage                                                 }
{                                                                          }
{ Deze routine slaat een bericht op in de WildCat message base. Zowel      }
{ netmail als echomail zijn ondersteund.                                   }
{                                                                          }
PROCEDURE WildCatBase.WriteMessage (Area_Name,Area_Path : STRING);

TYPE WriteBuf = ARRAY[0..65000] OF BYTE;

VAR WriteBufPtr  : ^WriteBuf;
    WriteBufSize : WORD;
    WriteBufLen  : WORD;

    PROCEDURE EmptyWriteBuffer;

    VAR IORes : BYTE;

    BEGIN
         {$I-} BlockWrite (DatFile,WriteBufPtr^,WriteBufLen); {$I+} IORes:=IOResult;
         Inc (DatHdr.MsgBytes,WriteBufLen);
         UpdateInfoNr (INFO_WildCatSave_Bytes,WriteBufLen);

         WriteBufLen:=0;

         IF (IORes <> 0) THEN
            LogDiskIOError (IORes,'[WC] Error writing message part to '+BaseDescr);
    END;

    {----------------------------------------------------------------------}
    { WriteBlock                                                           }
    {                                                                      }
    { Deze routine schrijft regels naar disk vanaf het opgegeven punt,     }
    { todat het maximum opgegeven aantal bytes.                            }
    { Ivm geswapte regels en split parts moet MsgsNewSeek() al uitgevoerd  }
    { zijn voor de header en footer en moet de swappos bewaard worden en   }
    { hersteld worden (bij volgende split blok) voor de body.              }
    {                                                                      }
    { Deze routine wordt alleen gebruikt voor Header_F and Footer_F die    }
    { dus kludges kunnen bevatten. Daarbij zetten we de #1 (^A) om in #0.  }
    {                                                                      }
    PROCEDURE WriteBlock (EenRegelPtr : EenRegelRecordPtr; MaxLen : WORD; IsHeader : BOOLEAN);

    VAR RegelLength : BYTE;
        Lp          : BYTE;
        Hulp        : STRING[7];

    BEGIN
         WHILE (EenRegelPtr <> NIL) AND (MaxLen > 255) DO
         BEGIN
              CASE EenRegelPtr^.Waar OF
                   wMem :
                       BEGIN
                            RegelLength:=Length (EenRegelPtr^.RegelPtr^);

                            IF (RegelLength >= (WriteBufSize-WriteBufLen)) THEN
                               EmptyWriteBuffer;

                            IF (Copy (EenRegelPtr^.RegelPtr^,1,7) = 'SEEN-BY') THEN
                            BEGIN
                                 { voeg een #0 in om de SEEN-BY te verstoppen }
                                 WriteBufPtr^[WriteBufLen]:=0;
                                 Inc (WriteBufLen);
                            END;

                            IF (NOT IsHeader) OR (Copy (EenRegelPtr^.RegelPtr^,1,5) <> 'AREA:') THEN
                            BEGIN
                                 Move (EenRegelPtr^.RegelPtr^[1],WriteBufPtr^[WriteBufLen],RegelLength);

                                 { change kludge prefix to #0 }
                                 IF (WriteBufPtr^[WriteBufLen] = 1) THEN
                                    WriteBufPtr^[WriteBufLen]:=0;

                                 Inc (WriteBufLen,RegelLength);
                            END;

                            EenRegelPtr:=EenRegelPtr^.NextRegelRecordPtr;
                            MsgsNewSeek (EenRegelPtr);
                       END;

                   wSwapped :
                       BEGIN
                            { lees de lengte van de regel in }
                            BlockRead (SwapFile,RegelLength,1);

                            { einde van het swapped blok? }
                            IF (RegelLength = 0) THEN
                            BEGIN
                                 { ja, ga naar de volgende regel }
                                 EenRegelPtr:=EenRegelPtr^.NextRegelRecordPtr;
                                 MsgsNewSeek (EenRegelPtr);
                                 Continue;
                            END;

                            IF (RegelLength >= (WriteBufSize-WriteBufLen)) THEN
                               EmptyWriteBuffer;

                            { lees de regel zelf in }
                            BlockRead (SwapFile,WriteBufPtr^[WriteBufLen],RegelLength);

                            IF (RegelLength > 7) THEN
                            BEGIN
                                 Move (WriteBufPtr^[WriteBufLen],Hulp[1],7);
                                 Hulp[0]:=#7;
                                 IF (Hulp = 'SEEN-BY') THEN
                                 BEGIN
                                      { voeg een #0 in om deze te "verstoppen" }

                                      { move the rest one position }
                                      FOR Lp:=RegelLength DOWNTO 1 DO
                                          WriteBufPtr^[WriteBufLen+Lp+1]:=WriteBufPtr^[WriteBufLen+Lp];

                                      WriteBufPtr^[WriteBufLen]:=0;
                                      Inc (RegelLength);
                                 END;
                            END;

                            { change kludge prefix to #0 }
                            IF (WriteBufPtr^[WriteBufLen] = 1) THEN
                               WriteBufPtr^[WriteBufLen]:=0;

                            Inc (WriteBufLen,RegelLength);
                       END;
              END; { case }
         END; { while }
    END;

{ WriteMessage }

CONST WrapLimit = 77;

VAR IORes          : BYTE;
    SplitParts     : WORD;
    SplitCurrent   : WORD;
    HeaderPos      : LONGINT;
    MaxLenBodyPart : LONGINT;
    BodyPtr        : EenRegelRecordPtr;
    SwapPos        : LONGINT;
    BodyLeft       : LONGINT;
    Regel          : STRING;
    WrapPos        : BYTE;

LABEL Einde;

BEGIN
     IF (NOT OpenBase (Area_Name,Area_Path)) THEN
        Exit;

     IF (NOT LockBase) THEN
     BEGIN
          CloseBase;
          Exit;
     END;

     UpdateWriteFile (Area_Path,0);

     WriteBufPtr:=NIL;

     IF (NOT CalcMaxAllowedMem (WriteBufSize,8192,65520)) THEN
     BEGIN
          LogMessage (liFatal,'[WC] Not enough memory for write buffer!');
          GOTO Einde;
     END;

     { en vraag het geheugen aan }
     GetMem (WriteBufPtr,WriteBufSize);
     PeekMem;

     { now write the message body itself }
     { we schrijven de header, body en footer }
     Seek (DatFile,FileSize (DatFile));

     { bereken in hoeveel delen we dit bericht moeten hakken }
     SplitParts:=GuessSplitParts (MaxLenBodyPart);
     SplitCurrent:=0;

     (* replace with multi-part handling and MsgsForEach_Limited
     IF (Msg.BodyTop <> NIL) THEN
     BEGIN
          BodyPtr:=Msg.BodyTop^.FirstRegelRecordPtr;
          MsgsNewSeek (BodyPtr);
          SwapPos:=FilePos (SwapFile);
     END ELSE
     *)
     BEGIN
          BodyPtr:=NIL;
          SwapPos:=0;
     END;

     REPEAT
           { create a header block }
           HeaderPos:=FileSize (DatFile);

           { nieuwe header opzetten }
           WITH DatHdr DO
           BEGIN
                MagicNumber:=$001A1A1B; { msg header active }

                { following call creates IndeX entry as well }
                MsgNumber:=AllocateMsgNumber (HeaderPos);

                IF (MsgNumber = 0{error}) THEN
                   GOTO Einde;

                Orig:=Msg.FromUser_F;
                OrigTitle:='';
                OrigUserID:=0;

                Dest:=Msg.Stored_ToUser;
                DestTitle:='';
                DestUserID:=GetBBSUserID (Msg.BBSUserIndex);

                Subject:=Msg.Subj_F;

                IF (SplitParts > 1) THEN
                BEGIN
                     Inc (SplitCurrent);
                     Subject:='('+Word2String (SplitCurrent)+'/'+Word2String (SplitParts)+') '+Subject;
                END;

                Network:='';

                FidoDateToWildCatDate (Msg.Date_F,MsgTime);

                ReadTime.Date:=0; { 1/1/1900 00:00:00 }
                ReadTime.Time:=0;

                mFlags:=mfSent; { to avoid exporting }

                IF (Msg.Ready_F IN [Netmail,Local_Netmail]) THEN
                   mFlags:=mFlags OR mfPrivate;

                Reference:=0;

                FidoFrom.Zone:=Msg.FromAddr_F.Zone;
                FidoFrom.Net:=Msg.FromAddr_F.Net;
                FidoFrom.Node:=Msg.FromAddr_F.Node;
                FidoFrom.Point:=Msg.FromAddr_F.Point;

                FidoTo.Zone:=Msg.Stored_ToAddr.Zone;
                FidoTo.Net:=Msg.Stored_ToAddr.Net;
                FidoTo.Node:=Msg.Stored_ToAddr.Node;
                FidoTo.Point:=Msg.Stored_ToAddr.Point;

                MsgBytes:=0; { will be updated }

                InternalAttach:='';
                ExternalAttach:='';
                PrevUnread:=0;
                NextUnread:=0;
                FidoFlags:=0;
                Cost:=0;
                Area:=0;
                FillChar (Reserved,18,0);
           END; { with }

           { schrijf header naar disk }
           {$I-} Seek (DatFile,HeaderPos); {$I+} IORes:=IOResult;
           IF (IORes = 0) THEN
           BEGIN
                {$I-} BlockWrite (DatFile,DatHdr,SizeOf (wc_MsgHeader)); {$I+} IORes:=IOResult;
           END;

           IF (IORes <> 0) THEN
           BEGIN
                LogDiskIOError (IORes,'[WC] Error writing new msg header for '+BaseDescr);
                GOTO Einde;
           END;

           { schrijf (deel) bericht naar disk }

           WriteBufLen:=0;

           { header }
           IF (Msg.HeaderTop_F <> NIL) THEN
           BEGIN
                MsgsNewSeek (Msg.HeaderTop_F^.FirstRegelRecordPtr);
                WriteBlock (Msg.HeaderTop_F^.FirstRegelRecordPtr,65535,TRUE);
           END;

           { voeg een split header toe }
           IF (SplitParts > 1) THEN
           BEGIN
                Regel:=FidoCreateSplitLine (SplitCurrent,SplitParts);

                IF (Length (Regel) > (WriteBufSize-WriteBufLen)) THEN
                   EmptyWriteBuffer;

                { change kludge prefix }
                IF (Regel[1] = #1) THEN
                   Regel[1]:=#0;

                Move (Regel[1],WriteBufPtr^[WriteBufLen],Length (Regel));
                Inc (WriteBufLen,Length (Regel));
           END;

           { body }
           IF SwapIsOpen THEN
              Seek (SwapFile,SwapPos);

           BodyLeft:=MaxLenBodyPart;

           WHILE (BodyPtr <> NIL) AND (BodyLeft > 255) DO
           BEGIN
                {ExtractFile (BodyPtr,Regel);}

                { maak ruimte }
                IF (Length (Regel) > (WriteBufSize-WriteBufLen)) THEN
                   EmptyWriteBuffer;

                REPEAT
                      IF (Length (Regel) < WrapLimit) THEN
                      BEGIN
                           Move (Regel[1],WriteBufPtr^[WriteBufLen],Length (Regel));
                           Inc (WriteBufLen,Length (Regel));
                           Dec (BodyLeft,Length (Regel));
                           { note: no check for CR at end of Regel }
                           Regel:='';
                      END ELSE
                      BEGIN
                           WrapPos:=WrapLimit;

                           WHILE (NOT (Regel[WrapPos] IN [' ',#13])) AND (WrapPos > 60) DO
                                 Dec (WrapPos);

                           IF (WrapPos = 60) THEN
                              WrapPos:=WrapLimit { hard break }
                           ELSE
                               Regel[WrapPos]:=#13; { insert CR }

                           Move (Regel[1],WriteBufPtr^[WriteBufLen],WrapPos);
                           Inc (WriteBufLen,WrapPos);
                           Dec (BodyLeft,WrapPos);

                           IF (Regel[WrapPos] <> #13) THEN
                           BEGIN
                                { Insert CR }
                                WriteBufPtr^[WriteBufLen]:=13;
                                Inc (WriteBufLen);
                                Dec (BodyLeft);
                           END;

                           Delete (Regel,1,WrapPos);
                      END;
                UNTIL (Regel = '');
           END; { while }

           IF SwapIsOpen THEN
              SwapPos:=FilePos (SwapFile);

           { footer }
           IF (Msg.FooterTop_F <> NIL) THEN
           BEGIN
                MsgsNewSeek (Msg.FooterTop_F^.FirstRegelRecordPtr);
                WriteBlock (Msg.FooterTop_F^.FirstRegelRecordPtr,65535,FALSE);
           END;

           { schrijf de laatste bytes nog even weg }
           IF (WriteBufLen > 0) THEN
              EmptyWriteBuffer;

           { update de message header met het aantal opgeslagen bytes }
           {$I-} Seek (DatFile,HeaderPos); {$I+} IORes:=IOResult;
           IF (IORes = 0) THEN
           BEGIN
                {$I-} BlockWrite (DatFile,DatHdr,SizeOf (wc_MsgHeader)); {$I+} IORes:=IOResult;
           END;

           IF (IORes <> 0) THEN
           BEGIN
                LogDiskIOError (IORes,'[WC] Error updating new msg header in '+BaseDescr);
                GOTO Einde;
           END;

     UNTIL (BodyPtr = NIL);

     UpdateInfoNr (INFO_WildCatSave_Msgs,1);

Einde:

     IF (WriteBufPtr <> NIL) THEN
        FreeMem (WriteBufPtr,WriteBufSize);

     { verwijder het slot... }
     UnlockBase;

     { einde area }
     CloseBase;
END;


END.
