UNIT Msgs;

{$i platform.inc}

{ Routines voor een standaard (intern) message formaat. Vanuit Fido en
  Usenet kunnen de berichten eerst naar dit formaat ingelezen worden en
  daarna van hieruit weer weggeschreven. Deze routines doen voornamelijk
  het vertalen tussen Fido en Usenet en het inpakken van de mail. Het
  schrijven naar de verschillende outbounds gebeurt in MAKEOUT.

  History:

  RvdW 20-02-93 Deze unit wat opgepoetst.
  <rest deleted>
}

{ _F       = FTN  }
{ _U       = UUCP }
{ _B       = BAG  }
{ _S       = SMTP }
{ _P       = POP3 }
{ _SOUP    = SOUP }
{ INETMAIL = Inet.Mail }

{ $DEFINE REGEL_LENGTH_CHECK}
{ $DEFINE MSGS_DEBUG}

INTERFACE

USES Database,
     FlexCfg,
     SeenBy;

CONST MaxLenUserName_F = 35; { ex #0 }
      MaxLenSubj_F     = 71; { ex #0 }
      MaxLenDate_F     = 19; { ex #0 }

TYPE MsgType = (NotReady,                   { Nog niet klaar voor dat type }
                Local_Netmail,Local_Echomail,                   { exported }
                Netmail,Echomail,                                    { FTN }
                Mail,News,                                           { RFC }
                Dupe,
                Bad);

TYPE WaarType = (wMem,       { per regel benaderbaar }
                 wSwapped);  { gepacked op disk }

TYPE EenRegelRecordPtr = ^EenRegelRecord;
     EenRegelRecord    = RECORD
                               NextRegelRecordPtr : EenRegelRecordPtr;

                               {## add LOCKED option to prevent it from }
                               {   begin swapped out.                   }
                               {## add DELETED option for easily        }
                               {   lifting out lines.                   }
                               Waar : WaarType;

                               CASE INTEGER OF
                        { wMem }    0 : (RegelPtr   : ^STRING;
                                         {$IFDEF REGEL_LENGTH_CHECK}
                                         Len_Check  : BYTE
                                         {$ENDIF}
                                         );

                    { wSwapped }    1 : (SwapOffset : LONGINT);
                         END;

TYPE PartStatusType = (psUnknown,
                       psText,
                       psAttachment);

TYPE TopRegelRecordPtr = ^TopRegelRecord;
     TopRegelRecord    = RECORD
                               TotalRegelLength    : LONGINT;
                               FirstRegelRecordPtr,
                               LastRegelRecordPtr  : EenRegelRecordPtr;
                               PartStatus          : PartStatusType;
                               AttachmentInfo      : STRING;
                               IsLocked            : BOOLEAN;
                               {## future: current character set for this body part?}
                         END;

TYPE ForEach_PosRecord = RECORD
                               CurrentPart        : BYTE;
                               EenRegelPtr        : EenRegelRecordPtr;
                               SwapPos            : LONGINT;
                               SkipHeader         : BOOLEAN;
                               IncludeAttachments : BOOLEAN;
                         END;

TYPE DestStatus = (destNews,      { 0: news distribution }
                   destEchomail,  { 1: echomail distribution }

                   destNewsArea,  { 2: copy to area filter, news }
                   destEchoArea,  { 3: copy to area filter, echomail }
                   destNetArea,   { 4: move/copy to area filter, netmail }

                   destRFCRaw,    { 5: before address completion + verification }
                   destRFC,       { 6: ready for processing }
                   destRFCUser,   { 7: decided to which user to write it }

                   destFTN,       { 8: ready for processing }
                   destFTNUser,   { 9: decided to which user to write it }

                   destRemoteGW,  { 10: always non-raw }
                   destNetHold,   { 11: undeliverable (local) RFC mail, write to netmail area and put on Hold }

                   { v-- not implemented yet --v }

                   destBBS        { 11: ?necessary? }
                   {destList}
                   );

CONST Status2Str : ARRAY[DestStatus] OF STRING[10] = (
                   'News',
                   'Echo',
                   'NewsArea',
                   'EchoArea',
                   'NetArea',
                   'RFCRaw',
                   'RFC',
                   'RFCUser',
                   'FTN',
                   'FTNUser',
                   'RemoteGW',
                   'NetHold',
                   'BBS');

TYPE DestTypes = (destNotSure,      { inbound RFC }
                  destTo,
                  destCc,
                  destBcc);

     DestRecordPtr = ^DestRecord;
     DestRecord    = RECORD
                           Status    : DestStatus;
                           ByFilter  : BOOLEAN; { if TRUE, ignore gateway limitation }

                           { combinations for FTN, RFC or RemoteGW }
                           ToUser_F  : STRING[MaxLenUserName];
                           ToAddr_F  : FidoAddrType;
                           To_U      : STRING[MaxLenDomain];

                           { notsure / to / cc / bcc }
                           ToType    : DestTypes;

                           { decided user record to route rfc address to }
                           UserRecNr : UserBaseRecordNrType;

                           { destArea: move/copy filter }
                           AreaRecNr : AreaBaseRecordNrType;
                           AddNote   : BOOLEAN;

                           { destList: position of flex ml record }
                           ListPos   : LONGINT;

                           { BBSUserIndex : WORD? }

                           NextDest  : DestRecordPtr;
                     END;

TYPE UsenetUserNameString = STRING;
     UsenetDomainNameString = STRING;

TYPE ExportedType = (etReady,          { 0 }
                     etHasReceivedMsg, { 1 }
                     etIsSource,       { 2 }
                     etIsPassive,      { 3 }
                     etInPathOrSB);    { 4 (temporary flag, resets to 0) }

TYPE ExportedListPtr = ^ExportedList;
     ExportedList    = ARRAY[1..65528] OF ExportedType;
     { 0 = Nothing sent yet }
                                                { 1 = Has received msg }
                                                { 2 = Source, don't return }
                                                { 3 = Passive, don't send }
                                                { 4 = Already in Path }
                                                { 5 = Already in SeenBy }

CONST MAX_AREA_CROSS_POSTS = 35;
      MAX_BODY_PARTS       = 50;

TYPE MessageRecordPtr = ^MessageRecord;
     MessageRecord = RECORD
                           { current format of this message }
                           Ready_F,
                           Ready_U         : MsgType;

                           { list of recipient addresses }
                           FirstDest       : DestRecordPtr;

                           { for MsgsPush/PopState }
                           PrevMsgPtr      : MessageRecordPtr;

                           { to prevent distributing twice }
                           AddedEcho       : BOOLEAN;
                           AddedNews       : BOOLEAN;
                           DidAreaToList   : BOOLEAN;

                           { for news->echo distribution }
                           AreaRecNrs      : ARRAY[1..MAX_AREA_CROSS_POSTS] OF AreaBaseRecordNrType;
                           AreaMsgIds      : ARRAY[1..MAX_AREA_CROSS_POSTS] OF STRING[8];

                           { set when echo/news is distributed via a list }
                           { limits to one list per incoming message      }
                           DidList         : BOOLEAN;

                           { single user destination during I/O }
                           { (for message bases and pkt) }
                           Stored_ToUser   : STRING;
                           Stored_ToAddr   : FidoAddrType;

                           {## sending system for bouncing?? }
                           { to know where to bounce the message }
                           { set to empty for internally originated }
                           { messages, to prevent bounce loops.     }
                           {##need type of address as well?
                           Bounce_User     : STRING[MaxLenUserName_F];
                           Bounce_Addr     : FidoAddrType;
                           Bounce_To       : STRING;
                           }

                           { to suppress bounce filters }
                           IsBounceMsg     : BOOLEAN;

                           { avoid import during export }
                           ExportAreaRecNr : AreaBaseRecordNrType;

                           { FTN fields }
                           FromUser_F      : STRING[MaxLenUserName_F];
                           FromAddr_F      : FidoAddrType;

                           { echomail only }
                           ToUser_F        : STRING[MaxLenUserName_F];

                           { REPLYADDR/REPLYTO kludges }
                           ReplyAKA        : FidoAddrType;
                           ReplyUser       : STRING[MaxLenUserName];
                           ReplyEmail      : STRING;

                           { other FTN fields }
                           Attr_F          : WORD;
                           ExtAttr_F       : LONGINT;
                           Subj_F          : STRING[MaxLenSubj_F];
                           Cost_F          : INTEGER;
                           Date_F          : STRING[MaxLenDate_F];
                           Chrs_F          : STRING[20];
                           MsgID_F         : STRING;
                           ReplyID_F       : STRING;

                           { RFC fields }
                           FromUser_U      : STRING; { needed by SMTP outbound }
                           ToUser_U        : STRING;
                           Subj_U          : STRING;
                           Date_U          : STRING;
                           ApparentlyTo    : STRING;
                           ApparentlyFrom  : STRING;
                           ReplyTo_U       : STRING;
                           Sender_U        : STRING;
                           Newsgroups_U    : STRING;
                           Organization_U  : STRING;
                           InReplyTo_U     : STRING;
                           MessageId_U     : STRING;
                           Approved_U      : BOOLEAN;

                           { UUCP }
                           UUCP_From_      : STRING;

                           { MIME }
                           IsMime            : BOOLEAN;
                           MultiPartBoundary : STRING[70];  { part boundary text }
                                                            { 70=Limit is RFC1521 }

                           { message parts }
                           HeaderTop_F,
                           HeaderTop_U,
                           CopiedHeadersTop_F,
                           FooterTop_F     : TopRegelRecordPtr;
                           { rules for CopiedHeaders: }
                           { first the kludges        }
                           { then the text lines      }
                           { if text lines, add one empty line at the end }

                           CurrentBodyPart : BYTE;
                           BodyParts       : ARRAY[1..MAX_BODY_PARTS] OF TopRegelRecordPtr;

                           { voor de stats }
                           MsgSize         : LONGINT; { in bytes }

                           { only one news article copy to each user }
                           Exported        : ExportedListPtr;
                           ExportedCount   : WORD;

                           { filters }
                           MappersDone     : BYTE; { as Limit }
                           MapperAction    : MapActionType;
                           MapperPos       : LONGINT; { for action }
                           FilterUsed      : MapActionType;

                           { for stats }
                           DeliveringUserRecNr : UserBaseRecordNrType;

                           { seen-by and path of original message }
                           SBP_Zone        : WORD;         { at creation time }
                           FirstSeenByPtr  : SBP_BlockPtr;
                           FirstPathPtr    : SBP_BlockPtr;

                           { if TRUE doesn't trigger mailing lists, tunnels, }
                           { etc. and performs special translations.         }
                           IsListDist      : BOOLEAN;
                           ListPos         : LONGINT;
                           ListSubj        : STRING;

                           ListPosterEmail : STRING[MaxLenDomain];
                           ListPosterName  : STRING[MaxLenUserName_F];
                           ListPosterAKA   : FidoAddrType;

                           BounceReason    : STRING; { for route.tdb }

                           { v--- old ---v }

                           BadReason   : STRING;

                           {ListServer  : BOOLEAN; { TRUE als msg distributie van mailing list }
                           WasGated    : BOOLEAN; { to usenet, ivm KillGatedNetmail & BBS-EMAILAREA }
                           { other for Areafix ivm Received ipv Sent vlag }

                           Area_F      : STRING[MaxLenAreaName];

                           { RFC fields }
                           Control        : STRING;
                           References_U   : STRING;
                           BBSUserIndex   : WORD;

                           BadAreaRecNr : AreaBaseRecordNrType;
                     END;

     WhereToType = (Header_F,
                    Header_U,
                    Body,
                    Footer_F,
                    CopiedHeaders_F,
                    Unknown,
                    Bittenbak);

     SystemModeType = (smNORMAL,
                       smDISTRIBUTE,     { list server }
                       smFDSCAN);        { file attach scan in FD mode }

     MsgsCallProcType = FUNCTION (VAR Regel : STRING) : BOOLEAN;

      { let op! Mag niet lager als MINFREE (10000) in CalcMaxAllowedMem }
      {         plus een beetje voor de buffers die ze daar aanvragen.  }
CONST MSGS_LOWMEM_GOSWAP  = 25000; { als MemAvail hier onder duikt, dan de swapfile gaan gebruiken }
      MSGS_LOWMEM_GOTRASH = 5000;  { als MemAvail hier onder duikt, dan gaan trashen }
      MSGS_LOWMEM_PRESWAP = 50000; { als MemAvail hier onder zit voor MsgsForEach(Kill) dan swappen }

VAR Msg                 : MessageRecord;
    MsgTrashAllNewLines : BOOLEAN;  {## make instance-related??}


PROCEDURE MsgsEmpty;
PROCEDURE MsgsEmptyKeepDeliveringUser;
PROCEDURE MsgsFreeAllDestRecords (Silent : BOOLEAN);
PROCEDURE MsgsPushState;
PROCEDURE MsgsPopState;
PROCEDURE MsgsTrySwap;
FUNCTION  MsgsCreateTopRegelRecord : TopRegelRecordPtr;
PROCEDURE MsgsAddLineToNoEOL (WhereTo : WhereToType; Line : STRING);
PROCEDURE MsgsAddLineTo (WhereTo : WhereToType; Line : STRING);
PROCEDURE MsgsAddFirstLineToNoEOL (WhereTo : WhereToType; Line : STRING);
PROCEDURE MsgsAddFirstLineTo (WhereTo : WhereToType; Line : STRING);
PROCEDURE MsgsReleaseLines (VAR EersteRegelRecordPtr : TopRegelRecordPtr);
PROCEDURE MsgsNewSeek (RegelPtr : EenRegelRecordPtr);
FUNCTION  MsgsForEach (TopRegelPtr : TopRegelRecordPtr; CallProc : MsgsCallProcType) : BOOLEAN;
PROCEDURE MsgsForEachKill (VAR TopRegelPtr : TopRegelRecordPtr; CallProc : MsgsCallProcType);
FUNCTION  MsgsCopyNLines (TopRegelPtr : TopRegelRecordPtr; N : WORD) : WORD;
FUNCTION  MsgsGetFirstRowInBody : STRING;
PROCEDURE MsgsDeleteFirstRowFromBody;
PROCEDURE MsgsLimited_Init (VAR PosRec : ForEach_PosRecord; IncludeAttachments : BOOLEAN);
FUNCTION  MsgsLimited_ForEach (VAR PosRec : ForEach_PosRecord; Limit : LONGINT; CallProc : MsgsCallProcType) : BOOLEAN;
FUNCTION  MsgsCalcBodyLen (IncludeAttachments : BOOLEAN) : LONGINT;
FUNCTION  MsgsCalcMessageSize : LONGINT;
FUNCTION  MsgsCalcBodyLines : LONGINT;
PROCEDURE MsgsAddEmptyLineIfNotPresentAlready;
PROCEDURE MsgsCopyBodyFromPrevMsg;
FUNCTION  MsgsInsertBodyPartAtTop : BOOLEAN;
FUNCTION  MsgsGetLastBodyPart: TopRegelRecordPtr;
PROCEDURE MsgsRemoveBodyPart (BodyPartNr : BYTE);
PROCEDURE MsgsSeekToLastBodyPart;
PROCEDURE MsgsMergeFirstAndSecondBodyPart;
{$IFDEF MSGS_DEBUG}
PROCEDURE MsgsDumpDebugCopy (MomentDescr : STRING);
{$ENDIF}
{$IFDEF Pre}
PROCEDURE Msgs_SanityCheck;
{$ENDIF}
PROCEDURE InitExportedList;
PROCEDURE JunkExportedList;


IMPLEMENTATION

USES Ramon,
     SwapMem,
     Globals,
     Logs,
     Fido,
     Cfg,
     FlexTdb;

VAR MsgTrashFile : TEXT;

{---------------------------------------------------------------------------}
{ MsgsGoSwap                                                                }
{                                                                           }
{ Deze routine schrijft regels naar de swapfile, als daar nog ruimte is     }
{ ten minste. Het doel hiervan is weer intern geheugen vrij te maken om     }
{ meer regels te kunnen verwerken.                                          }
{                                                                           }
{ Eerst was er een structuur waarbij alleen de data van de regel naar disk  }
{ werd geschreven, maar er nog wel _per regel_ een administratie record     }
{ aanwezig was om de lengte van de regel en de offset van de data in de     }
{ swapfile bij te houden.                                                   }
{                                                                           }
{ Als een pointer naar een EenRegelRecord record wijst met een Waar type    }
{ van wSwapped, dan moet vanaf de swapfile offset in dat record alle regels }
{ verwerkt worden. Eerst moet de lengte van disk gelezen worden en daarna   }
{ kan de hele regel ingelezen worden. Als de lengte 0 is, dan is het einde  }
{ van dit swap blok bereikt.                                                }
{                                                                           }
{ Deze routine schrijft het nieuwe swap blok altijd aan het einde van de    }
{ swapfile bij. Er is geen gap administratie dus. Dit is niet zo erg, want  }
{ aan het begin van het volgende bericht wordt de swapfile eerste weer leeg }
{ gemaakt.                                                                  }
{                                                                           }
PROCEDURE MsgsGoSwap (VAR TopPtr : TopRegelRecordPtr);

TYPE BufArray    = ARRAY[0..65520] OF BYTE;
     BufArrayPtr = ^BufArray;

VAR OldPos,
    NewPos  : LONGINT;
    NewPtr,
    OldPtr  : EenRegelRecordPtr;
    Keep    : BOOLEAN;
    Len     : WORD;  { RAWI 000226: was BYTE and used as Length(Line)+1.. }
    BufLen  : WORD;
    BufOfs  : WORD;
    BufPtr  : BufArrayPtr;
    {$IFDEF Pre}
    First   : BOOLEAN;
    {$ENDIF}

BEGIN
     IF (TopPtr = NIL) OR (NOT SwapIsOpen) OR (TopPtr^.IsLocked) THEN
        Exit;

     PeekMem; { nu zit het geheugen propje vol }

     IF (NOT (StayQuiet OR NoFullScreen)) THEN
     BEGIN
          WindowPush (62,3,15,1);
          WriteXY (62,3,' SWAPPING... ');
     END;

     {$IFDEF Pre}
     First:=TRUE;
     {$ENDIF}

     { Om fragmentatie te voorkomen, zetten we de hele chain opnieuw op.  }
     { Anders zou het geheugen steeds meer uit kleine stukjes vrijgegeven }
     { regels gaan bestaan, waar bijna niets meer te beginnen is (ik heb  }
     { die fragmentatie teller gezien!)                                   }

     WITH TopPtr^ DO
     BEGIN
          OldPtr:=FirstRegelRecordPtr;
          FirstRegelRecordPtr:=NIL;
          LastRegelRecordPtr:=NIL;
     END;

     OldPos:=FilePos (SwapFile);

     { doorloop alle regel record }
     WHILE (OldPtr <> NIL) DO
     BEGIN
          {LogExtraMessage ('Admin block at '+Long2HexString (Longint (OldPtr))+' Waar='+Byte2String (Byte (OldPtr^.Waar)));}

          IF (OldPtr^.Waar = wMem) THEN
          BEGIN
               { begin van een blok wMem regels (1 of meer) die naar }
               { disk kunnen.                                        }

               NewPos:=FileSize (SwapFile);

               IF (NewPos > MaxSwapLen) THEN
               BEGIN
                    { swap file zit vol. Nog niets veranderd, dus we }
                    { kunnen nog terug.                              }
                    LogMessage (liFatal,'Swap file is full!');
                    Break; { uit de while }
               END;

               { breng de swapfile in positie }
               Seek (SwapFile,NewPos);

               {$IFDEF Pre}
               IF First THEN
               BEGIN
                    First:=FALSE;
                    IF Config.LogDebug THEN
                       LogMessage (liDebug,'Swapping ('+Longint2String (NewPos)+')');
               END;
               {$ENDIF}

               {LogExtraMessage ('  Writing wMem block to '+Longint2String (NewPos));}

               { maak een buffer aan om de regels in te bufferen voordat }
               { ze naar disk geschreven worden.                         }
               BufLen:=65520;
               WHILE (_MaxAvail < BufLen) DO
                     BufLen:=BufLen DIV 2;

               GetMem (BufPtr,BufLen);
               {$IFDEF LogGetMem} LogGetMem (BufPtr,BufLen,'MsgsGoSwap (1)'); {$ENDIF}
               BufOfs:=0;

               { nu alle volgende wMem regels naar de swapfile schrijven }
               { en hun geheugen vrijgeven.                              }
               WHILE (OldPtr <> NIL) AND (OldPtr^.Waar = wMem) DO
                     WITH OldPtr^ DO
                     BEGIN
                          Len:=Byte (RegelPtr^[0])+1;

                          IF ((BufLen-BufOfs) < Len) THEN
                          BEGIN
                               BlockWrite (SwapFile,BufPtr^[0],BufOfs);
                               BufOfs:=0;
                          END;

                          { schrijf de regel, inclusief lengte byte, naar de swapfile }
                          {BlockWrite (SwapFile,RegelPtr^[0],Len);}
                          Move (RegelPtr^[0],BufPtr^[BufOfs],Len);
                          Inc (BufOfs,Len);

                          { geef het geheugen voor de regel zelf vrij }
                          FreeMem (RegelPtr,Len);

                          { bewaar de pointer naar het volgende record even }
                          NewPtr:=NextRegelRecordPtr;

                          { geef het regel record zelf vrij }
                          FreeMem (OldPtr,SizeOf (EenRegelRecord));

                          { laat OldPtr naar het volgende record wijzigen }
                          OldPtr:=NewPtr;
                     END; { while blok met wMem regels }

               { nu meteen het buffer leegmaken }
               IF (BufOfs > 0) THEN
               BEGIN
                    BlockWrite (SwapFile,BufPtr^[0],BufOfs);
                    BufOfs:=0;
               END;

               FreeMem (BufPtr,BufLen);

               { RWI 950910: Hier naartoe verplaatst om problemen te     }
               {             voorkomen als er GEEN blok toegevoegd wordt }

               { schrijf een eind record naar de swapfile }
               Len:=0;
               BlockWrite (SwapFile,Len,1);

               { in de nieuwe keten wordt een swap record aangemaakt }
               GetMem (NewPtr,SizeOf (EenRegelRecord));
               {$IFDEF LogGetMem} LogGetMem (NewPtr,SizeOf (EenRegelRecord),'MsgsGoSwap (2)'); {$ENDIF}

               WITH NewPtr^ DO
               BEGIN
                    NextRegelRecordPtr:=NIL;
                    Waar:=wSwapped;
                    SwapOffset:=NewPos;
               END;

               {LogExtraMessage ('  New admin block at '+Long2HexString (Longint (NewPtr)));}

               { link dit record in de TopPtr chain }
               WITH TopPtr^ DO
               BEGIN
                    IF (LastRegelRecordPtr = NIL) THEN
                       FirstRegelRecordPtr:=NewPtr
                    ELSE
                        LastRegelRecordPtr^.NextRegelRecordPtr:=NewPtr;

                    LastRegelRecordPtr:=NewPtr;
               END;

          END ELSE { wMem found }
          BEGIN
               { dit is geen wMem blok, dus een wSwapped block. }
               { Die toevoegen aan de nieuwe chain en verder niet aanraken. }

               {LogExtraMessage ('  Swapped at '+Longint2String (OldPtr^.SwapOffset));}

               { bewaar de pointer naar het volgende record }
               NewPtr:=OldPtr^.NextRegelRecordPtr;

               OldPtr^.NextRegelRecordPtr:=NIL;

               WITH TopPtr^ DO
               BEGIN
                    { link dit record in de TopPtr chain }
                    IF (LastRegelRecordPtr = NIL) THEN
                       FirstRegelRecordPtr:=OldPtr
                    ELSE
                        LastRegelRecordPtr^.NextRegelRecordPtr:=OldPtr;

                    LastRegelRecordPtr:=OldPtr;
               END;

               { en wij vrolijk verder naar het volgende record }
               OldPtr:=NewPtr;
          END;
     END; { while not end of old chain }

     IF (FileSize (SwapFile) > SwapTopUse) THEN
        SwapTopUse:=FileSize (SwapFile);

     { herstel de huidige positie in de swapfile, zodat het niet mis kan }
     { gaan als we nu midden in een verwerking zitten.                   }
     Seek (SwapFile,OldPos);

     IF (NOT (StayQuiet OR NoFullScreen)) THEN
        WindowPop; { "SWAPPING" }

     PeekMem;
END;


{--------------------------------------------------------------------------}
{ MsgsCreateTopRegelRecord                                                 }
{                                                                          }
{ This routine creates a TopRegelRecord so the status can be filled in.    }
{                                                                          }
FUNCTION MsgsCreateTopRegelRecord : TopRegelRecordPtr;

VAR NewTopPtr : TopRegelRecordPtr;

BEGIN
     { er was nog geen top record. Maakt die nu aan }
     GetMem (NewTopPtr,SizeOf (TopRegelRecord));
     {$IFDEF LogGetMem} LogGetMem (NewTopPtr,SizeOf (TopRegelRecord),'CreateTop'); {$ENDIF}

     WITH NewTopPtr^ DO
     BEGIN
          TotalRegelLength:=0;
          FirstRegelRecordPtr:=NIL;
          LastRegelRecordPtr:=NIL;
          PartStatus:=psUnknown;
          AttachmentInfo:='';
          IsLocked:=FALSE;
     END;

     MsgsCreateTopRegelRecord:=NewTopPtr;
END;


{--------------------------------------------------------------------------}
{ CreateLine                                                               }
{                                                                          }
{ Met deze routine kan een nieuwe regel aangemaakt worden. Als het TopRec  }
{ nog niet bestaat, dan wordt deze aangemaakt en gevuld. Anders wordt er   }
{ gewoon een nieuwe regel aangemaakt op de heap en de TopRec.LastPtr       }
{ aangepast. De pointer naar de nieuw aangemaakte regel wordt terug        }
{ gegeven.                                                                 }
{                                                                          }
{ Deze routine is vervangen op 27-02-93 omdat ie te traag was. Dit kwam    }
{ omdat voor iedere nieuw aan te sluiten regel de hele structuur opnieuw   }
{ doorzocht werd naar de laatste regel. Deze is nu direct bereikbaar       }
{ vanuit het TopRecord.                                                    }
{                                                                          }
FUNCTION CreateLine (VAR EersteRegelRecordPtr : TopRegelRecordPtr; LineLength : BYTE) : EenRegelRecordPtr;

VAR NewRegelRecordPtr : EenRegelRecordPtr;

BEGIN
     GetMem (NewRegelRecordPtr,SizeOf (EenRegelRecord));
     {$IFDEF LogGetMem} LogGetMem (NewRegelRecordPtr,SizeOf (EenRegelRecord),'CreateLine (1)'); {$ENDIF}

     WITH NewRegelRecordPtr^ DO
     BEGIN
          NextRegelRecordPtr:=NIL;
          Waar:=wMem;
          RegelPtr:=NIL;
          {$IFDEF REGEL_LENGTH_CHECK}
          Len_Check:=0;
          {$ENDIF}
     END; { with }

     CreateLine:=NewRegelRecordPtr;

     IF (EersteRegelRecordPtr = NIL) THEN
        EersteRegelRecordPtr:=MsgsCreateTopRegelRecord;

     WITH EersteRegelRecordPtr^ DO
     BEGIN
          IF (FirstRegelRecordPtr = NIL) THEN
             FirstRegelRecordPtr:=NewRegelRecordPtr
          ELSE
              LastRegelRecordPtr^.NextRegelRecordPtr:=NewRegelRecordPtr;

          LastRegelRecordPtr:=NewRegelRecordPtr;
          Inc (TotalRegelLength,LineLength);

     END; { with }
END;


{--------------------------------------------------------------------------}
{ CreateFirstLine                                                          }
{                                                                          }
{ Deze routine maakt een regel aan aan het begin van de lijst.             }
{                                                                          }
FUNCTION CreateFirstLine (VAR EersteRegelRecordPtr : TopRegelRecordPtr; LineLength : BYTE) : EenRegelRecordPtr;

VAR NewRegelRecordPtr : EenRegelRecordPtr;

BEGIN
     GetMem (NewRegelRecordPtr,SizeOf (EenRegelRecord));
     {$IFDEF LogGetMem} LogGetMem (NewRegelRecordPtr,SizeOf (EenRegelRecord),'CreateFirstLine (1)'); {$ENDIF}

     WITH NewRegelRecordPtr^ DO
     BEGIN
          {
          IF (EersteRegelRecordPtr = NIL) THEN
             Error ('[CreateFirstLine] TopRegelRecordPtr = NIL!');
          }
          { Hier ging het mis als EersteRegelRecordPtr nog NIL is... }
          { Nu wordt de toekenning verderop gedaan.  RWI 950312.     }

          NextRegelRecordPtr:=NIL; { inchainen alleen als het straks kan }
          Waar:=wMem;
          RegelPtr:=NIL;
          {$IFDEF REGEL_LENGTH_CHECK}
          Len_Check:=0;
          {$ENDIF}
     END; { with }

     CreateFirstLine:=NewRegelRecordPtr;

     IF (EersteRegelRecordPtr <> NIL) THEN
     BEGIN
          { RWI 950312: hier mag ie wel ingechained worden }
          NewRegelRecordPtr^.NextRegelRecordPtr:=EersteRegelRecordPtr^.FirstRegelRecordPtr;

          WITH EersteRegelRecordPtr^ DO
          BEGIN
               FirstRegelRecordPtr:=NewRegelRecordPtr;

               { if this is the first line (after just creating the top }
               { record or deleting the last line), then update the     }
               { LastPtr as well.                                       }
               IF (LastRegelRecordPtr = NIL) THEN
                  LastRegelRecordPtr:=NewRegelRecordPtr;

               Inc (TotalRegelLength,LineLength);
          END; { with }

          Exit;         { ## EXIT ## }
     END; { with,if }

     { top record was er nog niet. Maak die aan }
     EersteRegelRecordPtr:=MsgsCreateTopRegelRecord;

     WITH EersteRegelRecordPtr^ DO
     BEGIN
          TotalRegelLength:=LineLength;
          FirstRegelRecordPtr:=NewRegelRecordPtr;
          LastRegelRecordPtr:=NewRegelRecordPtr;
     END;
END;


{--------------------------------------------------------------------------}
{ MsgsReleaseLines                                                         }
{                                                                          }
{ Met deze routine kunnen de aangevraagde stukken geheugen waarin de lines }
{ zijn opgeslagen, weer worden vrijgegeven. Daarna wordt ook het TopRecord }
{ weer vrijgegeven.                                                        }
{                                                                          }
PROCEDURE MsgsReleaseLines (VAR EersteRegelRecordPtr : TopRegelRecordPtr);

VAR EraseRegelRecordPtr : EenRegelRecordPtr;

BEGIN
     IF (EersteRegelRecordPtr = NIL) THEN
        Exit;

     IF (EersteRegelRecordPtr^.IsLocked) THEN
        LogMessage (liReport,'Attempt to release locked block!');

     WITH EersteRegelRecordPtr^ DO
          WHILE (FirstRegelRecordPtr <> NIL) DO
          BEGIN
               EraseRegelRecordPtr:=FirstRegelRecordPtr;
               FirstRegelRecordPtr:=FirstRegelRecordPtr^.NextRegelRecordPtr;

               WITH EraseRegelRecordPtr^ DO
                    IF (Waar = wMem) THEN
                    BEGIN
                         { RWI950322: nu wordt het geheugen alleen vrij   }
                         {            gegeven als de regel in gebruik is. }
                         IF (RegelPtr <> NIL) THEN
                         BEGIN
                              {$IFDEF REGEL_LENGTH_CHECK}
                              IF (Len_Check <> Length (RegelPtr^)) THEN
                              BEGIN
                                   LogMessage (liReport,'[Msgs] Modified ('+
                                               SignedInteger2String (Length (RegelPtr^)-Len_Check)+
                                               '): '+RegelPtr^);
                                   LogClose; { voor het geval we crashen }
                              END;
                              {$ENDIF}

                              FreeMem (RegelPtr,Byte (RegelPtr^[0])+1);
                         END;
                    END; { if, with }

               {## had a crash here after MsgsPopState }
               { zou kunnen komen door kopie van footer die gedelete was! }
               FreeMem (EraseRegelRecordPtr,SizeOf (EenRegelRecord));
          END; { while, with }

     FreeMem (EersteRegelRecordPtr,SizeOf (TopRegelRecord));
     EersteRegelRecordPtr:=NIL;
END;


{--------------------------------------------------------------------------}
{ MsgsFreeAllDestRecords                                                   }
{                                                                          }
{ This routine frees all DestRecords set up for this message.              }
{                                                                          }
PROCEDURE MsgsFreeAllDestRecords (Silent : BOOLEAN);

VAR EraseDest : DestRecordPtr;

BEGIN
     WHILE (Msg.FirstDest <> NIL) DO
     BEGIN
          EraseDest:=Msg.FirstDest;

          IF (NOT Silent) THEN
             LogExtraMessage ('Not delivered to: '+
                              Status2Str[EraseDest^.Status]+
                              '/'+EraseDest^.ToUser_F+
                              '/'+Fido2Str (EraseDest^.ToAddr_F)+
                              '/'+EraseDest^.To_U);

          Msg.FirstDest:=Msg.FirstDest^.NextDest;
          FreeMem (EraseDest,SizeOf (DestRecord));
     END;
END;


{--------------------------------------------------------------------------}
{ MsgsEmptyKeepSwapfile                                                    }
{                                                                          }
{ Deze routine maakt de universele interne message leeg en vult de struc-  }
{ tuur met NIL pointers. De acties in deze routine moeten zo kort mogelijk }
{ gemaakt worden omdat voor ieder mailtje dat verwerkt moet worden dit     }
{ record leeg gemaakt wordt met deze routine.                              }
{                                                                          }
{ RWI 950910: MsgsEmptyKeepSwapfile toegevoegd, zodat bij het schrijven    }
{             van een reply waarbij de Swapfile in een linebuffer gebruikt }
{             wordt, de swapfile niet weggegooid wordt.                    }
{                                                                          }
PROCEDURE MsgsEmptyKeepSwapfile (KeepDeliveringUser : BOOLEAN);

VAR Lp : BYTE;

BEGIN
     IF MsgTrashAllNewLines THEN
     BEGIN
          {$IFDEF LogFileIO}PreCloseT (MsgTrashFile);{$ENDIF}
          Close (MsgTrashFile);
     END;

     MsgTrashAllNewLines:=FALSE;

     PrevKludgeID:=klNone;

     WITH Msg DO
     BEGIN
          MsgsReleaseLines (HeaderTop_F);
          MsgsReleaseLines (HeaderTop_U);
          MsgsReleaseLines (FooterTop_F);
          MsgsReleaseLines (CopiedHeadersTop_F);

          FOR Lp:=1 TO MAX_BODY_PARTS DO
              MsgsReleaseLines (BodyParts[Lp]);

          CurrentBodyPart:=1;

          MsgsFreeAllDestRecords ({Silent:}FALSE);

          Ready_F:=NotReady;
          Ready_U:=NotReady;

          AddedNews:=FALSE;
          AddedEcho:=FALSE;
          DidAreaToList:=FALSE;

          FOR Lp:=1 TO MAX_AREA_CROSS_POSTS DO
          BEGIN
               AreaRecNrs[Lp]:=NILRecordNr;
               AreaMsgIds[Lp]:='';
          END;

          DidList:=FALSE;

          Stored_ToUser:='';
          FidoSplit ('0',Stored_ToAddr);

          {
          Bounce_User:='';
          FidoSplit ('0',Bounce_Addr);
          Bounce_To:='';
          }
          IsBounceMsg:=FALSE;

          ExportAreaRecNr:=NILRecordNr;

          MsgSize:=0;

          { FTN fields }
          FromUser_F:='';
          FidoSplit ('0',FromAddr_F);

          Attr_F:=0;
          Subj_F:='';
          Cost_F:=0;
          Date_F:='';
          Chrs_F:='';

          MsgID_F:='';
          ReplyID_F:='';

          ReplyAKA:=FromAddr_F;
          ReplyUser:='';
          ReplyEmail:='';

          { RFC fields }
          FromUser_U:='';
          Subj_U:='';
          Date_U:='';
          ApparentlyTo:='';
          ApparentlyFrom:='';
          ReplyTo_U:='';
          Sender_U:='';
          Newsgroups_U:='';
          Organization_U:='';
          InReplyTo_U:='';
          MessageId_U:='';
          Approved_U:=FALSE;

          UUCP_From_:='';

          SBP_ReleaseSBPBlocks (FirstSeenByPtr);
          SBP_ReleaseSBPBlocks (FirstPathPtr);

          IF (NOT KeepDeliveringUser) THEN
             DeliveringUserRecNr:=NILRecordNr;

          IsMime:=FALSE;
          MultiPartBoundary:='';

          MappersDone:=0; { none }
          MapperAction:=matNone;
          MapperPos:=0;
          FilterUsed:=matNone;

          IsListDist:=FALSE;
          ListPos:=NILPos;
          ListPosterEmail:='';
          ListPosterName:='';
          ListPosterAKA:=FromAddr_F;

          { v-- old fields --v }
          BadReason:='';
          WasGated:=FALSE;

          { fido fields }
          ToUser_F:='';
          ExtAttr_F:=0;
          Area_F:='';

          { usenet fields }
          ToUser_U:='';
          References_U:='';
          Control:='';

          BBSUserIndex:=NILRecordNr;

          BadAreaRecNr:=NILRecordNr;

          BounceReason:='';
     END; { with }
END;


{--------------------------------------------------------------------------}
{ MsgsEmpty                                                                }
{                                                                          }
{ This routine empties both the message structure plus destination records }
{ list. The swapfile is only emptied when there is no message pushed on    }
{ the message stack.                                                       }
{                                                                          }
PROCEDURE MsgsEmpty;
BEGIN
     MsgsEmptyKeepSwapfile (FALSE);
     {$IFDEF WtrGate}
     IF (Msg.PrevMsgPtr = NIL) THEN
        EmptySwapfile; { ook meteen geen last meer van gaps! }
     {$ENDIF}
END;


{--------------------------------------------------------------------------}
{ MsgsEmptyKeepDeliveringUser                                              }
{                                                                          }
{ As MsgsEmpty, but doesn't set the DeliveringUserRecNr field to           }
{ NILRecordNr. This should be used by routines that just want to           }
{ initialize the internal message structure before reading the next        }
{ message from disk. Internal routines like bounce that do a push and then }
{ clean can safely have DeliveringUserRecNr reset so it reflects WaterGate }
{ as the sender (=NILRecordNr).                                            }
{                                                                          }
PROCEDURE MsgsEmptyKeepDeliveringUser;
BEGIN
     MsgsEmptyKeepSwapfile (TRUE{Keep});
     {$IFDEF WtrGate}
     IF (Msg.PrevMsgPtr = NIL) THEN
        EmptySwapfile; { ook meteen geen last meer van gaps! }
     {$ENDIF}
END;


{--------------------------------------------------------------------------}
{ MsgsPushState                                                            }
{                                                                          }
{ This routine stores the entire state of the Msg structure on the heap,   }
{ allowing for a new message to be written out. This is used to let        }
{ internal function like areafix, newsfix, sendfile, list server, etc.     }
{ write a new message and distribute it without destoying the state of the }
{ current message, which might need to be distributed to other users       }
{ afterwards!                                                              }
{                                                                          }
PROCEDURE MsgsPushState;

VAR BackupMsgPtr : MessageRecordPtr;
    Lp           : 1..MAX_BODY_PARTS;

BEGIN
     {$IFDEF Pre}
     LogMessage (liDebug,'== MsgPushState ==');
     {$ENDIF}

     GetMem (BackupMsgPtr,SizeOf (MessageRecord));
     {$IFDEF LogGetMem} LogGetMem (BackupMsgPtr,SizeOf (MessageRecord),'GetMem MessageRecord backup'); {$ENDIF}

     Move (Msg,BackupMsgPtr^,SizeOf (MessageRecord));
     Msg.PrevMsgPtr:=BackupMsgPtr;

     { prevent destruction of certain fields during MsgsEmpty below }
     Msg.HeaderTop_U:=NIL;
     Msg.HeaderTop_F:=NIL;
     Msg.FooterTop_F:=NIL;
     Msg.CopiedHeadersTop_F:=NIL;
     Msg.FirstDest:=NIL;

     FOR Lp:=1 TO MAX_BODY_PARTS DO
         Msg.BodyParts[Lp]:=NIL;

     Msg.FirstSeenByPtr:=NIL;
     Msg.FirstPathPtr:=NIL;

     InitExportedList; { new empty list, initialized by DeliverNow }

     MsgsEmptyKeepSwapfile (FALSE{do not keep DeliveringUser});
END;


{--------------------------------------------------------------------------}
{ MsgsPopState                                                             }
{                                                                          }
{ This routine restores the Msg state to what it was before MsgPushState   }
{ was called.                                                              }
{                                                                          }
PROCEDURE MsgsPopState;

VAR BackupMsgPtr : MessageRecordPtr;
    Lp           : 1..MAX_BODY_PARTS;
    Lp2          : 1..MAX_BODY_PARTS;
    Found        : BOOLEAN;

BEGIN
     IF (Msg.PrevMsgPtr = NIL) THEN
     BEGIN
          LogMessage (liReport,'Unsynchronized call to MsgPopState');
          Exit;
     END;

     {$IFDEF Pre}
     LogMessage (liDebug,'== MsgPopState ==');
     {$ENDIF}

     { make sure all message blocks are released before the pop }

     IF (Msg.HeaderTop_F <> NIL) THEN
     BEGIN
          IF (Msg.HeaderTop_F = Msg.PrevMsgPtr^.HeaderTop_F) THEN
             LogMessage (liReport,'HeaderTop_F is in use in MsgsPopState')
          ELSE
              MsgsReleaseLines (Msg.HeaderTop_F);
     END;

     IF (Msg.HeaderTop_U <> NIL) THEN
     BEGIN
          IF (Msg.HeaderTop_U = Msg.PrevMsgPtr^.HeaderTop_U) THEN
             LogMessage (liReport,'HeaderTop_U is in use in MsgsPopState')
          ELSE
              MsgsReleaseLines (Msg.HeaderTop_U);
     END;

     IF (Msg.FooterTop_F <> NIL) THEN
     BEGIN
          IF (Msg.FooterTop_F = Msg.PrevMsgPtr^.FooterTop_F) THEN
             LogMessage (liReport,'FooterTop_F is in use in MsgsPopState')
          ELSE
              MsgsReleaseLines (Msg.FooterTop_F);
     END;

     IF (Msg.CopiedHeadersTop_F <> NIL) THEN
     BEGIN
          IF (Msg.CopiedHeadersTop_F = Msg.PrevMsgPtr^.CopiedHeadersTop_F) THEN
             LogMessage (liReport,'CopiedHeadersTop_F is in use in MsgsPopState')
          ELSE
              MsgsReleaseLines (Msg.CopiedHeadersTop_F);
     END;

     FOR Lp:=1 TO MAX_BODY_PARTS DO
         IF (Msg.BodyParts[Lp] <> NIL) THEN
         BEGIN
              Found:=FALSE;

              FOR Lp2:=1 TO MAX_BODY_PARTS DO
                  IF (Msg.PrevMsgPtr^.BodyParts[Lp2] = Msg.BodyParts[Lp]) THEN
                  BEGIN
                       Found:=TRUE;
                       LogMessage (liReport,'Part '+Byte2String (Lp)+
                                   ' is in use as '+Byte2String (Lp2)+
                                   ' in MsgsPopState');
                       Break;
                  END;

              IF (NOT Found) THEN
                 MsgsReleaseLines (Msg.BodyParts[Lp]);
         END; { if, for }

     IF (Msg.FirstDest <> NIL) THEN
        IF (Msg.FirstDest = Msg.PrevMsgPtr^.FirstDest) THEN
           LogMessage (liReport,'FirstDest is in use n MsgsPopState')
        ELSE BEGIN
             LogMessage (liReport,'FirstDest is not empty in MsgsPopState');
             MsgsFreeAllDestRecords ({Silent:}FALSE);
        END;

     IF (Msg.FirstSeenByPtr <> NIL) THEN
        IF (Msg.FirstSeenByPtr = Msg.PrevMsgPtr^.FirstSeenByPtr) THEN
           LogMessage (liReport,'FirstSeenByPtr is in use in MsgsPopState')
        ELSE
            SBP_ReleaseSBPBlocks (Msg.FirstSeenByPtr);

     IF (Msg.FirstPathPtr <> NIL) THEN
        IF (Msg.FirstPathPtr = Msg.PrevMsgPtr^.FirstPathPtr) THEN
           LogMessage (liReport,'FirstPathPtr is in use in MsgsPopState')
        ELSE
            SBP_ReleaseSBPBlocks (Msg.FirstPathPtr);

     JunkExportedList;

     BackupMsgPtr:=Msg.PrevMsgPtr;
     Move (BackupMsgPtr^,Msg,SizeOf (MessageRecord));
     FreeMem (BackupMsgPtr,SizeOf (MessageRecord));
END;


{--------------------------------------------------------------------------}
{ MsgsTrashDumpLines                                                       }
{                                                                          }
PROCEDURE MsgTrashDumpLines (Source : TopRegelRecordPtr);

VAR EenRegelPtr : EenRegelRecordPtr;
    Line        : STRING;
    IORes       : BYTE;

BEGIN
     { RWI950605: controle op NIL toegevoegd. Kwam anders in een oneindige }
     {            lus terecht.                                             }
     IF (Source = NIL) THEN
        Exit;

     EenRegelPtr:=Source^.FirstRegelRecordPtr;
     MsgsNewSeek (EenRegelPtr);

     WHILE (EenRegelPtr <> NIL) DO
     BEGIN
          CASE EenRegelPtr^.Waar OF
               wMem :
                   BEGIN
                        Line:=EenRegelPtr^.RegelPtr^;
                        EenRegelPtr:=EenRegelPtr^.NextRegelRecordPtr;
                        MsgsNewSeek (EenRegelPtr);
                   END;

               wSwapped :
                   BEGIN
                        BlockRead (SwapFile,Line[0],1);

                        IF (Line[0] = #0) THEN
                        BEGIN
                             EenRegelPtr:=EenRegelPtr^.NextRegelRecordPtr;
                             MsgsNewSeek (EenRegelPtr);
                             Continue;
                        END;

                        BlockRead (SwapFile,Line[1],Byte (Line[0]));
                   END;
          END; { case }

          { speciale verwerking zodat #13's vertaald worden in Cr+Lf }
          WHILE (Line <> '') DO
          BEGIN
               IF (Pos (#13,Line) > 0) THEN
               BEGIN
                    { RWI 950202: Write veranderd in WriteLn. Fixed overwrite dump bug }
                    WriteLn (MsgTrashFile,Copy (Line,1,Pos (#13,Line)-1));
                    Delete (Line,1,Pos (#13,Line));
               END ELSE
               BEGIN
                    Write (MsgTrashFile,Line);
                    Line:='';
               END;
          END; { while line <> '' }
     END; { while not end of lines }
END;


{--------------------------------------------------------------------------}
{ MsgsTrashHeader                                                          }
{                                                                          }
{ Schrijft de header van een te groot bericht naar de trashcan.            }
{                                                                          }
PROCEDURE MsgsTrashHeader;

VAR IORes   : BYTE;
    DestPtr : DestRecordPtr;

BEGIN
     {$I-}
     { dump de header informatie naar disk }
     WriteLn (MsgTrashFile,RepChar (79,'-'));
     WriteLn (MsgTrashFile,DesktopProgramName+' '+FullProgramVersion);
     WriteLn (MsgTrashFile,RepChar (79,'-'));

     IF (Msg.Ready_F <> NotReady) THEN
     BEGIN
          WriteLn (MsgTrashFile,'From: ',Msg.FromUser_F,',',Fido2Str (Msg.FromAddr_F));
          DestPtr:=Msg.FirstDest;
          WHILE (DestPtr <> NIL) DO
          BEGIN
               CASE DestPtr^.ToType OF
                    destTo,
                    destNotSure :
                        Write (MsgTrashFile,'To  : ');

                    destCc :
                        Write (MsgTrashFile,'Cc  : ');

                    destBcc :
                        Write (MsgTrashFile,'Bcc : ');
               END; { case }

               WriteLn (MsgTrashFile,'"'+DestPtr^.ToUser_F+'" at '+
                                     Fido2Str (DestPtr^.ToAddr_F)+
                                     ' ('+DestPtr^.To_U+')');

               DestPtr:=DestPtr^.NextDest;
          END; { while }

          WriteLn (MsgTrashFile,'Subj: ',Msg.Subj_F);
          WriteLn (MsgTrashFile,'Date: ',Msg.Date_F);
          WriteLn (MsgTrashFile,RepChar (79,'-'));

          { Dump de fido header naar de logfile }
          MsgTrashDumpLines (Msg.HeaderTop_F);
          MsgTrashDumpLines (Msg.CopiedHeadersTop_F);
     END ELSE
     BEGIN
          { dump de Usenet header naar de logfile }
          MsgTrashDumpLines (Msg.HeaderTop_U);
     END;
     {$I+}
     IORes:=IOResult;
END;


{--------------------------------------------------------------------------}
{ MsgsTrySwapRecursive                                                     }
{                                                                          }
PROCEDURE MsgsTrySwapRecursive (VAR M : MessageRecord);

VAR PLp : 1..MAX_BODY_PARTS;

BEGIN
     MsgsGoSwap (Msg.HeaderTop_F);
     MsgsGoSwap (Msg.FooterTop_F);
     MsgsGoSwap (Msg.HeaderTop_U);
     MsgsGoSwap (Msg.CopiedHeadersTop_F);

     FOR PLp:=1 TO MAX_BODY_PARTS DO
         MsgsGoSwap (M.BodyParts[PLp]);

     IF (M.PrevMsgPtr <> NIL) THEN
        MsgsTrySwapRecursive (M.PrevMsgPtr^);
END;


{--------------------------------------------------------------------------}
{ MsgsTrySwap                                                              }
{                                                                          }
{ This routine can be called when free memory is needed. It will swap all  }
{ body parts of the current message to disk and then continues with any    }
{ pushed messages.                                                         }
{ Its weakness: it will swap everything to disk instead of just enough     }
{ until we have enough free memory.                                        }
{                                                                          }
PROCEDURE MsgsTrySwap;
BEGIN
     MsgsTrySwapRecursive (Msg);
END;


{--------------------------------------------------------------------------}
{ MsgsAddLineTo en MsgsAddLineToNoEOL                                      }
{                                                                          }
{ Met deze routine kan een regel worden toegevoegd aan de universele msg.  }
{ Door middel van de WhereTo kan gekozen worden uit de header, body of de  }
{ footer.                                                                  }
{                                                                          }
{ RvdW 04-04-93 Foutje bij het toevoegen van de Bittenbak optie. De Exit   }
{               in de case stond er niet, dus NewRegelRecordPtr was onge-  }
{               definieerd en dat gaf bij fouten na het case statement.    }
{                                                                          }
PROCEDURE MsgsAddLineToNoEOL (WhereTo : WhereToType; Line : STRING);

VAR NewRegelRecordPtr : EenRegelRecordPtr;
    Lp                : BYTE;
    IORes             : BYTE;
    DumpName          : STRING;

BEGIN
     IF MsgTrashAllNewLines THEN
     BEGIN
          WHILE (Line <> '') DO
          BEGIN
               IF (Pos (#13,Line) > 0) THEN
               BEGIN
                    WriteLn (MsgTrashFile,Copy (Line,1,Pos (#13,Line)-1));
                    Delete (Line,1,Pos (#13,Line));
               END ELSE
               BEGIN
                    Write (MsgTrashFile,Line);
                    Line:='';
               END;
          END; { while }

          Exit;
     END;

     CASE WhereTo OF
          Header_F  : NewRegelRecordPtr:=CreateLine (Msg.HeaderTop_F,Length (Line));
          Header_U  : NewRegelRecordPtr:=CreateLine (Msg.HeaderTop_U,Length (Line));
          Body      : NewRegelRecordPtr:=CreateLine (Msg.BodyParts[Msg.CurrentBodyPart],Length (Line));
          Footer_F  : NewRegelRecordPtr:=CreateLine (Msg.FooterTop_F,Length (Line));
          CopiedHeaders_F : NewRegelRecordPtr:=CreateLine (Msg.CopiedHeadersTop_F,Length (Line));
          Bittenbak : Exit; { poof! :-) }
     END; { case }

     GetMem (NewRegelRecordPtr^.RegelPtr,Length (Line)+1);
     {$IFDEF LogGetMem} LogGetMem (NewRegelRecordPtr^.RegelPtr,Length (Line)+1,'MsgsAddLineToNoEOL'); {$ENDIF}
     NewRegelRecordPtr^.RegelPtr^:=Line;
     {$IFDEF REGEL_LENGTH_CHECK}
     NewRegelRecordPtr^.Len_Check:=Length (Line);
     {$ENDIF}
     Inc (Msg.MsgSize,Length (Line));

     { deze vergelijking moet ruimte vrij maken. Als dat niet lukt, }
     { dan reageert de opvolger van deze routine met het trashen    }
     { van de file.                                                 }
     { RWI 960309: MemAvail veranderd in MaxAvail ivm CalcMaxAllowedMem }
     IF (_MaxAvail < MSGS_LOWMEM_GOSWAP) THEN
        MsgsTrySwap;

     { header en body mogen nu ook naar disk, maar doen we nog even niet }
     { in verband met de verwerkings snelheid. De code is overal al      }
     { aanwezig en gaat er vanuit dat de header en footer op disk kunnen }
     { staan (neath eh?)                                                 }

     { als er nu nog steeds te weinig geheugen vrij is, dan gaan we }
     { dumpen. Zou eigenlijk nooit meer voor mogen komen.           }
     IF (NOT MsgTrashAllNewLines) AND (_MemAvail < MSGS_LOWMEM_GOTRASH) THEN
     BEGIN
          DumpName:=GetUniqueFilename (Config.TooLargePath,'');

          Assign (MsgTrashFile,DumpName);
          {$I-} ReWrite (MsgTrashFile); {$I+}
          IORes:=IOResult;
          IF (IORes <> 0) THEN
          BEGIN
               LogDiskIOError (IORes,'Unable to create dump file: '+DumpName);
               Exit;
          END;

          {$IFDEF LogFileIO}PostOpenT (MsgTrashFile);{$ENDIF}

          LogMessage (liFatal,'Out of memory. Dumping msg to '+DumpName);

          MsgsTrashHeader;

          FOR Lp:=1 TO MAX_BODY_PARTS DO
          BEGIN
               MsgTrashDumpLines (Msg.BodyParts[Lp]);
               MsgsReleaseLines (Msg.BodyParts[Lp]);
          END;

          {## print + destroy all recipients? (=DestRecords) }

          MsgTrashAllNewLines:=TRUE;
     END;
END;

PROCEDURE MsgsAddLineTo (WhereTo : WhereToType; Line : STRING);
BEGIN
     MsgsAddLineToNoEOL (WhereTo,Line+#13);
END;


{--------------------------------------------------------------------------}
{ MsgsAddFirstLineTo                                                       }
{                                                                          }
{ Met deze routine kan een regel worden toegevoegd aan de universele msg.  }
{ Door middel van de WhereTo kan gekozen worden uit de header, body of de  }
{ footer. Er wordt automatisch een CR toegevoegd.                          }
{                                                                          }
PROCEDURE MsgsAddFirstLineToNoEOL (WhereTo : WhereToType; Line : STRING);

VAR NewRegelRecordPtr : EenRegelRecordPtr;

BEGIN
     CASE WhereTo OF
          Header_F  : NewRegelRecordPtr:=CreateFirstLine (Msg.HeaderTop_F,Length (Line));
          Header_U  : NewRegelRecordPtr:=CreateFirstLine (Msg.HeaderTop_U,Length (Line));
          Body      : NewRegelRecordPtr:=CreateFirstLine (Msg.BodyParts[1],Length (Line));
          Footer_F  : NewRegelRecordPtr:=CreateFirstLine (Msg.FooterTop_F,Length (Line));
          CopiedHeaders_F : NewRegelRecordPtr:=CreateFirstLine (Msg.CopiedHeadersTop_F,Length (Line));
          Bittenbak : Exit; { poof! :-}
     END; { case }

     GetMem (NewRegelRecordPtr^.RegelPtr,Length (Line)+1);
     {$IFDEF LogGetMem} LogGetMem (NewRegelRecordPtr^.RegelPtr,Length (Line)+1,'MsgsAddFirstLineToNoEOL'); {$ENDIF}

     NewRegelRecordPtr^.RegelPtr^:=Line;
     {$IFDEF REGEL_LENGTH_CHECK}
     NewRegelRecordPtr^.Len_Check:=Length (Line);
     {$ENDIF}
     Inc (Msg.MsgSize,Length (Line));
END;

PROCEDURE MsgsAddFirstLineTo (WhereTo : WhereToType; Line : STRING);
BEGIN
     MsgsAddFirstLineToNoEOL (WhereTo,Line+#13);
END;


{---------------------------------------------------------------------------}
{ MsgsNewSeek                                                               }
{                                                                           }
{ Deze routine moet worden aangeroepen als een EenRegelRecordPtr naar een   }
{ nieuwe EenRegelRecord wijst. Als dit nieuwe record namelijk een Waar type }
{ wSwapPacked heeft, dan moet er een seek in de swapfile plaatsvinden. Dat  }
{ gebeurd hier.                                                             }
{                                                                           }
PROCEDURE MsgsNewSeek (RegelPtr : EenRegelRecordPtr);
BEGIN
     IF (RegelPtr <> NIL) AND (RegelPtr^.Waar = wSwapped) THEN
        Seek (SwapFile,RegelPtr^.SwapOffset);
END;


{---------------------------------------------------------------------------}
{ MsgsGetFirstRowInBody                                                     }
{                                                                           }
{ This routine returns the contents of the first line in the body of the    }
{ message. The idea is that the caller looks at it and if it has processed  }
{ it, it uses MsgsDeleteFirstRowFromBody and calls this function again,     }
{ until it is satisfied.                                                    }
{ This is used by CopyHeaderFromFidoBody to delete all RFC headers it has   }
{ copied without having to use MsgsForEach and abort after one line plus    }
{ having to use a lot of static variables.                                  }
{ An empty string is returned when all body parts are empty.                }
{                                                                           }
FUNCTION MsgsGetFirstRowInBody : STRING;

VAR Lp          : 1..MAX_BODY_PARTS;
    EenRegelPtr : EenRegelRecordPtr;
    RegelLength : BYTE;
    Regel       : STRING;

BEGIN
     FOR Lp:=1 TO MAX_BODY_PARTS DO
         IF (Msg.BodyParts[Lp] <> NIL) THEN
         BEGIN
              EenRegelPtr:=Msg.BodyParts[Lp]^.FirstRegelRecordPtr;

              IF (EenRegelPtr <> NIL) THEN
                  CASE EenRegelPtr^.Waar OF
                       wMem :
                           BEGIN
                                MsgsGetFirstRowInBody:=EenRegelPtr^.RegelPtr^;
                                Exit; { ## EXIT ## }
                           END;

                       wSwapped :
                           BEGIN
                                MsgsNewSeek (EenRegelPtr);

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

                                { einde van het swapped blok? }
                                IF (RegelLength = 0) THEN
                                BEGIN
                                     { this admin block should not have existed }
                                     LogMessage (liReport,'[MsgsGetFirstRowInBody] Inconsistency error');
                                     Regel:='';
                                END;

                                { lees de regel zelf in }
                                BlockRead (SwapFile,Regel[1],RegelLength);
                                Regel[0]:=Char (RegelLength);

                                MsgsGetFirstRowInBody:=Regel;
                                Exit; { ## EXIT ## }
                           END;

                  END; { case, if }

              { if the EenRegelPtr was NIL, then the TopRecord did not     }
              { have any lines, which is valid. Simply go to the next part }

         END; { if, for }

     MsgsGetFirstRowInBody:=''; { nothing found }
END;


{---------------------------------------------------------------------------}
{ MsgsForEach                                                               }
{                                                                           }
{ Deze routine doorloopt iedere regel in het opgegeven blok en roept de     }
{ opgegeven routine aan met als argument een pointer naar de regel. Als de  }
{ regel in het geheugen staat is het simpel. Anders wordt ie uit de         }
{ swapfile gelezen en in een lokale variabele opgeslagen.                   }
{                                                                           }
{ Hele leuke routine, maar kan niet gebruikt worden voor object shit als    }
{ de CallProc bij attributen van het object moet kunnen... CallProc moet    }
{ dan een member van het object zijn, want als subproc mag het niet van BP. }
{ Zonder object shit kan je nog lekker vies doen gelukken.                  }
{                                                                           }
{ RAWI 980108: now returns TRUE when aborted.                               }
{                                                                           }
FUNCTION MsgsForEach (TopRegelPtr : TopRegelRecordPtr; CallProc : MsgsCallProcType) : BOOLEAN;

VAR EenRegelPtr : EenRegelRecordPtr;
    RegelLength : BYTE;
    Regel       : STRING; { voor swapped regels }

BEGIN
     IF (TopRegelPtr = NIL) THEN
     BEGIN
          MsgsForEach:=FALSE; { not aborted }
          Exit;
     END;

     MsgsForEach:=TRUE; { assume aborted }

     TopRegelPtr^.IsLocked:=TRUE; { avoid swapping out under process }

     EenRegelPtr:=TopRegelPtr^.FirstRegelRecordPtr;
     MsgsNewSeek (EenRegelPtr);

     WHILE (EenRegelPtr <> NIL) DO
     BEGIN
          CASE EenRegelPtr^.Waar OF
               wMem :
                   BEGIN
                        {$IFDEF Pre}
                        RegelLength:=Length (EenRegelPtr^.RegelPtr^);
                        {Regel:=EenRegelPtr^.RegelPtr^;} { for debugging }
                        {$ENDIF}

                        IF CallProc (EenRegelPtr^.RegelPtr^) THEN
                        BEGIN
                             TopRegelPtr^.IsLocked:=FALSE;
                             Exit; { abort, returns TRUE }
                        END;

                        {$IFDEF Pre}
                        IF (RegelLength <> Length (EenRegelPtr^.RegelPtr^)) THEN
                           LogMessage (liReport,'[MFE] Modify: '+EenRegelPtr^.RegelPtr^);
                        {$ENDIF}

                        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;

                        { lees de regel zelf in }
                        BlockRead (SwapFile,Regel[1],RegelLength);
                        Regel[0]:=Char (RegelLength);

                        { verwerk de regel }
                        IF CallProc (Regel) THEN
                        BEGIN
                             TopRegelPtr^.IsLocked:=FALSE;
                             Exit; { abort, returns TRUE }
                        END;
                   END;

               {$IFDEF Pre}
               ELSE BEGIN
                    LogMessage (liReport,'[MFE] Invalid line type; aborting');
                    Break; { from the while }
               END;
               {$ENDIF}
          END; { case }
     END; { while }

     TopRegelPtr^.IsLocked:=FALSE;
     MsgsForEach:=FALSE; { not aborted }
END;


{---------------------------------------------------------------------------}
{ MsgsForEachKill                                                           }
{                                                                           }
{ As MsgsForEach, but frees each processed line.                            }
{                                                                           }
PROCEDURE MsgsForEachKill (VAR TopRegelPtr : TopRegelRecordPtr; CallProc : MsgsCallProcType);

VAR KillRegelPtr,
    EenRegelPtr  : EenRegelRecordPtr;
    RegelLength  : BYTE;
    Regel        : STRING; { voor swapped regels }

BEGIN
     IF (TopRegelPtr = NIL) THEN
        Exit;

     { RAWI 970608: now swapping when running low of memory to avoid    }
     {              problems later on. Without this, the lines occupied }
     {              by TopRegelPtr would never be swapped out.          }
     IF (_MemAvail < MSGS_LOWMEM_PRESWAP) THEN
        MsgsGoSwap (TopRegelPtr);

     TopRegelPtr^.IsLocked:=TRUE; { avoid being swapped out during process }
     EenRegelPtr:=TopRegelPtr^.FirstRegelRecordPtr;
     MsgsNewSeek (EenRegelPtr);

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

                        KillRegelPtr:=EenRegelPtr;
                        EenRegelPtr:=EenRegelPtr^.NextRegelRecordPtr;

                        FreeMem (KillRegelPtr^.RegelPtr,RegelLength+1);
                        FreeMem (KillRegelPtr,SizeOf (EenRegelRecord));

                        CallProc (Regel);

                        {$IFDEF Pre}
                        IF (RegelLength <> Length (Regel)) THEN
                           LogMessage (liDebug,'[MFEK] Modify: '+Regel);
                        {$ENDIF}

                        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 }
                             KillRegelPtr:=EenRegelPtr;
                             EenRegelPtr:=EenRegelPtr^.NextRegelRecordPtr;
                             FreeMem (KillRegelPtr,SizeOf (EenRegelRecord));
                             MsgsNewSeek (EenRegelPtr);
                             Continue;
                        END;

                        { lees de regel zelf in }
                        BlockRead (SwapFile,Regel[1],RegelLength);
                        Regel[0]:=Char (RegelLength);

                        { verwerk de regel }
                        CallProc (Regel);
                   END;
          END; { case }
     END; { while }

     FreeMem (TopRegelPtr,SizeOf (TopRegelRecord));
     TopRegelPtr:=NIL;
END;


{--------------------------------------------------------------------------}
{ MsgsCopyNLines                                                           }
{                                                                          }
{ This routine adds a copy of the part of a message to the Body of the     }
{ current message. This is mainly used by bounce routines to include a     }
{ part or the complete body of the original message. The number of copied  }
{ lines is return. If 0 is given, all lines are copied.                    }
{                                                                          }
VAR CopyNLinesLeft : WORD;
    LinesCopied    : WORD;

FUNCTION MsgsCopyNLines_CopyLine (VAR Regel : STRING) : BOOLEAN; FAR;
BEGIN
     MsgsAddLineToNoEOL (Body,Regel);
     Inc (LinesCopied);

     { return TRUE (=abort) if we will reach zero soon as should then }
     { stop copying lines. This never returns TRUE if CopyNLinesLeft  }
     { already is 0.                                                  }
     MsgsCopyNLines_CopyLine:=(CopyNLinesLeft = 1{goes to 0});

     { decrease only if not already zero, making 0 == "copy all" }
     IF (CopyNLinesLeft > 0) THEN
        Dec (CopyNLinesLeft);
END;

FUNCTION MsgsCopyNLines (TopRegelPtr : TopRegelRecordPtr; N : WORD) : WORD;
BEGIN
     CopyNLinesLeft:=N;
     LinesCopied:=0;

     MsgsForEach (TopRegelPtr,MsgsCopyNLines_CopyLine);

     MsgsCopyNLines:=LinesCopied;
END;


{--------------------------------------------------------------------------}
{ MsgsCopyBodyFromPrevMsg                                                  }
{                                                                          }
{ This routine copies all the body parts from the previous message and     }
{ adds it to the current message. This is used by the mailing list server  }
{ for distributions plus other routines, mostly when bouncing a message.   }
{ This routine copies both the contents of the body part plus the status,  }
{ which avoids loosing the encoded file information. A mailing list msg    }
{ distributed to an area otherwises does not get its files decoded.        }
{                                                                          }
PROCEDURE MsgsCopyBodyFromPrevMsg;

VAR Lp : 0..MAX_BODY_PARTS;

BEGIN
     IF (Msg.PrevMsgPtr = NIL) THEN
     BEGIN
          LogMessage (liFatal,'MsgsCopyBodyFromPrevMsg: There is no previous message!!');
          Exit;
     END;

     { now copy the body parts from the previous message }
     FOR Lp:=1 TO MAX_BODY_PARTS DO
         IF (Msg.PrevMsgPtr^.BodyParts[Lp] <> NIL) THEN
         BEGIN
              IF (Msg.BodyParts[Msg.CurrentBodyPart] <> NIL) AND (Msg.CurrentBodyPart < MAX_BODY_PARTS) THEN
                 Inc (Msg.CurrentBodyPart);

              { copy the body }
              MsgsCopyNLines (Msg.PrevMsgPtr^.BodyParts[Lp],0{copy all lines});

              { copy the status }
              Msg.BodyParts[Msg.CurrentBodyPart]^.PartStatus:=Msg.PrevMsgPtr^.BodyParts[Lp]^.PartStatus;
              Msg.BodyParts[Msg.CurrentBodyPart]^.AttachmentInfo:=Msg.PrevMsgPtr^.BodyParts[Lp]^.AttachmentInfo;
         END; { if, for }
END;


{--------------------------------------------------------------------------}
{ InitExportedList                                                         }
{                                                                          }
{ Deze routine vraagt geheugen aan voor de exported list. Hierna mag het   }
{ aantal userbaserecords niet meer veranderen! De userbase moeten open     }
{ staan om het aantal records daarin te kunnen bepalen.                    }
{                                                                          }
PROCEDURE InitExportedList;
BEGIN
     Msg.ExportedCount:=UserBaseRecCount;
     GetMem (Msg.Exported,Msg.ExportedCount);
     {$IFDEF LogGetMem} LogGetMem (Msg.Exported,Msg.ExportedCount,'InitExportedList'); {$ENDIF}
     PeekMem;
END;


{--------------------------------------------------------------------------}
{ JunkExportedList                                                         }
{                                                                          }
{ Deze routine geeft het geheugen dat met InitExportedList was aangevraagd }
{ weer vrij.                                                               }
{                                                                          }
PROCEDURE JunkExportedList;
BEGIN
     FreeMem (Msg.Exported,Msg.ExportedCount);
END;


{--------------------------------------------------------------------------}
{ DeleteFirstRowFromBlock                                                  }
{                                                                          }
{ This routine deletes the first row from a TopRegelRecord.                }
{                                                                          }
PROCEDURE DeleteFirstRowFromBlock (VAR TopRegel : TopRegelRecordPtr);

VAR HulpRegelPtr : EenRegelRecordPtr;
    RegelLength  : BYTE;

BEGIN
     IF (TopRegel = NIL) THEN
        Exit; { extratje }

     IF (TopRegel^.FirstRegelRecordPtr = NIL) THEN
        Exit;

     WITH TopRegel^ DO
     BEGIN
          { als de eerste regel in geheugen staat, dan verwijderen }
          { we dat hele record gewoon }
          IF (FirstRegelRecordPtr^.Waar = wMem) THEN
          BEGIN
               { link het begin door naar de volgende regel }
               HulpRegelPtr:=FirstRegelRecordPtr;
               FirstRegelRecordPtr:=FirstRegelRecordPtr^.NextRegelRecordPtr;

               Dec (TotalRegelLength,Length (HulpRegelPtr^.RegelPtr^));
               Dec (Msg.MsgSize,Length (HulpRegelPtr^.RegelPtr^));

               FreeMem (HulpRegelPtr^.RegelPtr,Length (HulpRegelPtr^.RegelPtr^)+1);
               FreeMem (HulpRegelPtr,SizeOf (EenRegelRecord));
          END ELSE
          BEGIN
               { eerste regel staat in de swapfile. Nu wordt het leuk, want }
               { we hoeven alleen SwapOffset aan te passen.                 }
               WITH FirstRegelRecordPtr^ DO
               BEGIN
                    Seek (SwapFile,SwapOffset);
                    BlockRead (SwapFile,RegelLength,1);

                    IF (RegelLength = 0) THEN
                    BEGIN
                         LogMessage (liReport,'[MsgsDeleteFirstRowFromBlock] Stuck due to swapfile admin!');
                         Exit;
                    END;

                    { ook deze nog even aanpassen. Is beter voor split parts berekening enzo }
                    Dec (TotalRegelLength,RegelLength);
                    Dec (Msg.MsgSize,RegelLength);

                    { zet SwapOffset op het begin van de nieuwe regel }
                    Inc (SwapOffset,RegelLength+1);

                    { controleer nu nog even of dit admin blok leeg is geworden }
                    { (minieme kans).                                           }
                    Seek (SwapFile,SwapOffset);
                    BlockRead (SwapFile,RegelLength,1);

                    IF (RegelLength = 0) THEN
                    BEGIN
                         { ja! zowaar... dan kan dit admin blok helemaal weg }
                         HulpRegelPtr:=FirstRegelRecordPtr;
                         FirstRegelRecordPtr:=FirstRegelRecordPtr^.NextRegelRecordPtr;
                         FreeMem (HulpRegelPtr,SizeOf (EenRegelRecord));
                    END;
               END; { with }
          END;

          { any line left? }
          IF (FirstRegelRecordPtr = NIL) THEN
               LastRegelRecordPtr:=NIL;

     END; { with }
END;


{--------------------------------------------------------------------------}
{ MsgsDeleteFirstRowFromBody                                               }
{                                                                          }
{ Haalt de Eerste regel van het bericht weg, dit om TO: commando's uit     }
{ een bericht te kunnen schrappen en later misschien nog wel meer.         }
{                                                                          }
{ RWI 950506: Door de komst van de swapfile is deze routine nu iets        }
{             lastiger geworden. Een leeg swap admin regel record wordt    }
{             ook nog eens verwijderd.                                     }
{             Meteen ook TotalRegelLength aan laten passen. Deed ie nog    }
{             niet. Ook Msg.MsgSize neemt ie nu mee.                       }
{                                                                          }
PROCEDURE MsgsDeleteFirstRowFromBody;

VAR Lp : 1..MAX_BODY_PARTS;

BEGIN
     { find the one body part with a line and then have it removed }
     FOR Lp:=1 TO MAX_BODY_PARTS DO
         IF (Msg.BodyParts[Lp] <> NIL) AND (Msg.BodyParts[Lp]^.FirstRegelRecordPtr <> NIL) THEN
         BEGIN
              DeleteFirstRowFromBlock (Msg.BodyParts[Lp]);
              Exit;
         END;

     {## add code to move the bodypart pointers when the first }
     {   bodypart is NIL. Reduce CurrentPart as well.          }

     LogMessage (liReport,'DeleteFirstRowFromBody failed: no lines left?');
END;


{--------------------------------------------------------------------------}
{ MsgsLimited_Init                                                         }
{                                                                          }
{ This routine initializes the PosRec so it can be used for calls to       }
{ MsgsLimited_ForEach. Initialization with NIL is possible.                }
{                                                                          }
PROCEDURE MsgsLimited_Init (VAR PosRec : ForEach_PosRecord; IncludeAttachments : BOOLEAN);
BEGIN
     PosRec.EenRegelPtr:=NIL; { start next part }
     PosRec.CurrentPart:=0;
     PosRec.SwapPos:=-1; { crashes us if used wrong 8}
     PosRec.IncludeAttachments:=IncludeAttachments;
     PosRec.SkipHeader:=(Msg.IsMime) AND (Msg.MultiPartBoundary <> '');

     {
     LogMessage (liDebug, '[MIME] Msg.IsMime='+Integer2String(Integer(Msg.IsMime))+', Msg.MultiPartBoundary="'+
               Msg.MultiPartBoundary+'"');
     }

     { skip crap before first boundary? }
     IF PosRec.SkipHeader THEN
     BEGIN
          {
          LogMessage (liDebug, '[MIME] Skipping garbage before first boundary');
          }

          { get the first line. If it is a boundary header, there was }
          { nothing between the headers and the first block, in which }
          { case we shouldn't skip anything to avoid loss of a part!  }
          {AAT 000317: Causing first part to be skipped? }
          IF (MsgsGetFirstRowInBody <> '--'+Msg.MultiPartBoundary+#13) THEN
          BEGIN
               {
               LogMessage (liDebug, '[MIME] Skipping first part b/c there is no text');
               LogExtraMessage ('FirstLine="'+MsgsGetFirstRowInBody+'"');
               }
               { skip it! }
               Inc (PosRec.CurrentPart);
          END;
     END;
END;


{--------------------------------------------------------------------------}
{ MsgsLimited_ForEach                                                      }
{                                                                          }
{ This routine calls CallProc for each line in a message block pointed to  }
{ by PosRec, for a maximum number of bytes given in Limit. PosRec is       }
{ updated and can be used in a next call to this function. TRUE is         }
{ returned only when all lines have been processed.                        }
{                                                                          }
FUNCTION MsgsLimited_ForEach (VAR PosRec : ForEach_PosRecord; Limit : LONGINT; CallProc : MsgsCallProcType) : BOOLEAN;

    FUNCTION GoToNextPart : BOOLEAN;
    BEGIN
         REPEAT
               IF (PosRec.CurrentPart = MAX_BODY_PARTS) THEN
               BEGIN
                    PosRec.EenRegelPtr:=NIL; { makes MsgsLimited_ForEach return TRUE }
                    GoToNextPart:=FALSE;
                    Exit; { end of the journey }
               END;

               Inc (PosRec.CurrentPart);
         UNTIL (Msg.BodyParts[PosRec.CurrentPart] <> NIL);

         PosRec.EenRegelPtr:=Msg.BodyParts[PosRec.CurrentPart]^.FirstRegelRecordPtr;

         IF (PosRec.EenRegelPtr <> NIL) AND (PosRec.EenRegelPtr^.Waar = wSwapped) THEN
            PosRec.SwapPos:=PosRec.EenRegelPtr^.SwapOffset  { seek is done below }
         ELSE
             PosRec.SwapPos:=-1; { crashes us if used wrong }

         PosRec.SkipHeader:=(Msg.IsMime) AND (Msg.MultiPartBoundary <> '');

         GoToNextPart:=TRUE; { continue processing }
    END;

    FUNCTION GoToNextLine : BOOLEAN;
    BEGIN
         IF (PosRec.EenRegelPtr = NIL) THEN
         BEGIN
              { multi-part abort situation }
              GotoNextLine:=FALSE;
              Exit;
         END;

         { ja, ga naar de volgende regel }
         PosRec.EenRegelPtr:=PosRec.EenRegelPtr^.NextRegelRecordPtr;
         IF (PosRec.EenRegelPtr = NIL) THEN
         BEGIN
              IF (NOT GoToNextPart) THEN
              BEGIN
                   GoToNextLine:=FALSE; { stop processing }
                   Exit;
              END;
         END;

         IF (PosRec.EenRegelPtr <> NIL) AND (PosRec.EenRegelPtr^.Waar = wSwapped) THEN
            Seek (SwapFile,PosRec.EenRegelPtr^.SwapOffset);

         GoToNextLine:=TRUE; { continue processing }
    END;

    PROCEDURE CheckHeader (VAR Regel : STRING);
    BEGIN
         IF (Regel = #13) THEN
            PosRec.SkipHeader:=FALSE
         ELSE
             IF (Regel = '--'+Msg.MultiPartBoundary+'--'+#13) THEN
             BEGIN
                  { this multi-part header indicated the end of this }
                  { message. we abort at once.                       }
                  Limit:=0;
                  PosRec.EenRegelPtr:=NIL;
                  PosRec.CurrentPart:=MAX_BODY_PARTS;
             END;
    END;

VAR SwapOld     : LONGINT;
    RegelLength : BYTE;
    Regel       : STRING;
    StopNow     : BOOLEAN;

BEGIN
     IF (PosRec.EenRegelPtr = NIL) AND
        (PosRec.CurrentPart = MAX_BODY_PARTS) THEN
     BEGIN
          MsgsLimited_ForEach:=TRUE; { all lines have been procesed }
          Exit;
     END;

     { store the current position of the swapfile }
     IF SwapIsOpen THEN
        SwapOld:=FilePos (SwapFile);

     IF (PosRec.EenRegelPtr = NIL) THEN
     BEGIN
          IF (NOT GoToNextPart) THEN
          BEGIN
               { assume no gaps between the parts }
               MsgsLimited_ForEach:=TRUE;  { all lines have been processed }
               Exit;
          END;
     END;

     { if the line we were working on is in the swapfile, then }
     { restore the position of the swapfile.                   }
     IF (PosRec.EenRegelPtr^.Waar = wSwapped) THEN
        Seek (SwapFile,PosRec.SwapPos);

     WHILE (Limit <> 0) DO
     BEGIN
          IF (NOT PosRec.IncludeAttachments) AND (Msg.BodyParts[PosRec.CurrentPart]^.PartStatus = psAttachment) THEN
          BEGIN
               { stepped on an attachment and we don't want these in our }
               { message store. Write the AttachmentInfo line to the     }
               { message store and then jump to the next part.           }

               Regel:=Msg.BodyParts[PosRec.CurrentPart]^.AttachmentInfo+#13;

               IF (Length (Regel) > Limit) THEN
                  Break; { not enough space, do it the next time }

               Dec (Limit,Length (Regel));

               { must execute both below }
               StopNow:=CallProc (Regel);
               StopNow:=StopNow OR (NOT GoToNextPart); { must execute }

               IF StopNow THEN
                  Break; { from the while }

               Continue; { with the while }
          END;

          CASE PosRec.EenRegelPtr^.Waar OF
               wMem :
                   BEGIN
                        RegelLength:=Length (PosRec.EenRegelPtr^.RegelPtr^);

                        IF (NOT PosRec.SkipHeader) THEN
                        BEGIN
                             { have pasted header, process rest }
                             IF (RegelLength > Limit) THEN
                                Break; { from the while }

                             Dec (Limit,RegelLength);

                             IF CallProc (PosRec.EenRegelPtr^.RegelPtr^) THEN
                             BEGIN
                                  {## set EenRegelPtr to NIL?}
                                  Break; { from the while }
                             END;

                             IF (RegelLength <> Length (PosRec.EenRegelPtr^.RegelPtr^)) THEN
                                LogMessage (liDebug,'[MLFE1] Modify: '+PosRec.EenRegelPtr^.RegelPtr^);
                        END ELSE
                            { reached end of header? }
                            CheckHeader (PosRec.EenRegelPtr^.RegelPtr^);

                        IF (NOT GoToNextLine) THEN
                           Break; { from the while }
                   END;

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

                        { einde van het swapped blok? }
                        IF (RegelLength = 0) THEN
                        BEGIN
                             IF (NOT GotoNextLine) THEN
                                Break; { from the while }

                             Continue;
                        END;

                        IF (NOT PosRec.SkipHeader) THEN
                        BEGIN
                             { have pasted header, process rest }
                             IF (RegelLength > Limit) THEN
                             BEGIN
                                  { make sure this length byte is read again }
                                  Seek (SwapFile,FilePos (SwapFile)-1);
                                  Break; { from the while }
                             END;
                        END;

                        { lees de regel zelf in }
                        BlockRead (SwapFile,Regel[1],RegelLength);
                        Regel[0]:=Char (RegelLength);

                        IF (NOT PosRec.SkipHeader) THEN
                        BEGIN
                             { verwerk de regel }
                             Dec (Limit,RegelLength);

                             IF CallProc (Regel) THEN
                             BEGIN
                                  {## set EenRegelPtr to NIL?}
                                  Break; { from the while }
                             END;

                             IF (RegelLength <> Length (Regel)) THEN
                                LogMessage (liDebug,'[MLFE2] Modify: '+Regel);
                        END ELSE
                            { single empty line terminates header }
                            CheckHeader (Regel);
                   END;

               ELSE BEGIN
                    LogMessage (liDebug,'[MLFE] Unknown type '+Byte2String (Byte (PosRec.EenRegelPtr^.Waar)));
                    Break; { from the while }
               END;

          END; { case }
     END; { while }

     { restore the position of the swapfile }
     IF SwapIsOpen THEN
     BEGIN
          PosRec.SwapPos:=FilePos (SwapFile);
          Seek (SwapFile,SwapOld);
     END;

     { return TRUE if we have processed the last line }
     MsgsLimited_ForEach:=(PosRec.EenRegelPtr = NIL);
END;


{--------------------------------------------------------------------------}
{ MsgsCalcSplitParts                                                       }
{                                                                          }
{ This routine calculates the total length of the body text that will be   }
{ stored in the message base or .PKT file. This is the basis for the split }
{ parts calculation.                                                       }
{ If attached files have been decoded, then this routine does not count    }
{ the lines involved for parts with the psAttachment status.               }
{ Header lines belonging to multi-part MIME messages are left out.         }
{ Real header and footer lines are not included.                           }
{                                                                          }
FUNCTION MsgsCalcBodyLen (IncludeAttachments : BOOLEAN) : LONGINT;

VAR Lp      : 0..MAX_BODY_PARTS;
    BodyLen : LONGINT;

BEGIN
     BodyLen:=0;

     FOR Lp:=1 TO MAX_BODY_PARTS DO
         IF (Msg.BodyParts[Lp] <> NIL) THEN
            WITH Msg.BodyParts[Lp]^ DO
            BEGIN
                 IF IncludeAttachments OR (PartStatus <> psAttachment) THEN
                 BEGIN
                      Inc (BodyLen,TotalRegelLength);

                      {## now correct for the header lines we will skip }
                      {## count when making new split part??}
                      {Dec (BodyLen,TotalHeaderLength);}
                 END;
            END; { with, if, for }

     MsgsCalcBodyLen:=BodyLen;
END;


{--------------------------------------------------------------------------}
{ MsgsCalcMessageSize                                                      }
{                                                                          }
{ This routine counts the number of bytes in the header, footer and body   }
{ part of a message, in its current format. This is used when exporting a  }
{ message.                                                                 }
{                                                                          }
FUNCTION MsgsCalcMessageSize : LONGINT;

VAR Lp  : 0..MAX_BODY_PARTS;
    Len : LONGINT;

BEGIN
     Len:=0;

     FOR Lp:=1 TO MAX_BODY_PARTS DO
         IF (Msg.BodyParts[Lp] <> NIL) THEN
            WITH Msg.BodyParts[Lp]^ DO
                 Inc (Len,TotalRegelLength);

     IF (Msg.Ready_F <> NotReady) THEN
     BEGIN
          IF (Msg.HeaderTop_F <> NIL) THEN
             Inc (Len,Msg.HeaderTop_F^.TotalRegelLength);

          IF (Msg.FooterTop_F <> NIL) THEN
             Inc (Len,Msg.FooterTop_F^.TotalRegelLength);

          IF (Msg.CopiedHeadersTop_F <> NIL) THEN
             Inc (Len,Msg.CopiedHeadersTop_F^.TotalRegelLength);
     END;

     IF (Msg.Ready_U <> NotReady) THEN
     BEGIN
          IF (Msg.HeaderTop_U <> NIL) THEN
             Inc (Len,Msg.HeaderTop_U^.TotalRegelLength);
     END;

     {## probably not included: FMPT, TOPT, INTL, AREA}

     MsgsCalcMessageSize:=Len;
END;


{--------------------------------------------------------------------------}
{ MsgsCalcBodyLines                                                        }
{                                                                          }
{ This routine counts the number of lines in the body of a message.        }
{                                                                          }
FUNCTION MsgsCalcBodyLines : LONGINT;

VAR Lines       : LONGINT;
    Lp          : 1..MAX_BODY_PARTS;
    EenRegelPtr : EenRegelRecordPtr;
    RegelLength : BYTE;
    Regel       : STRING; { voor swapped regels }

BEGIN
     Lines:=0;

     FOR Lp:=1 TO MAX_BODY_PARTS DO
         IF (Msg.BodyParts[Lp] <> NIL) THEN
         BEGIN
              EenRegelPtr:=Msg.BodyParts[Lp]^.FirstRegelRecordPtr;
              MsgsNewSeek (EenRegelPtr);

              WHILE (EenRegelPtr <> NIL) DO
              BEGIN
                   CASE EenRegelPtr^.Waar OF
                        wMem :
                            BEGIN
                                 Inc (Lines);
                                 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;

                                 Inc (Lines);

                                 {## is a Seek() sneller?}
                                 BlockRead (SwapFile,Regel[1],RegelLength);
                            END;
                   END; { case }
              END; { while }
         END; { if, for }

     MsgsCalcBodyLines:=Lines;
END;


{--------------------------------------------------------------------------}
{ MsgsAddEmptyLineIfNotPresentAlready                                      }
{                                                                          }
{ This routine checks whether there is an empty line at the end of the     }
{ last body part. If not, it adds one.
{                                                                          }
PROCEDURE MsgsAddEmptyLineIfNotPresentAlready;

VAR Part  : 0..MAX_BODY_PARTS;
    Regel : STRING;

BEGIN
     { find the last body part in use }
     Part:=MAX_BODY_PARTS;

     WHILE (Part > 0) AND (Msg.BodyParts[Part] = NIL) DO
           Dec (Part);

     IF (Part = 0) THEN
     BEGIN
          { there are no body parts at all }
          { add the empty line }
          MsgsAddLineTo (Body,'');
          Exit; { ## EXIT ## }
     END;

     { we now point to a TopRegelRecord }

     WITH Msg.BodyParts[Part]^ DO
          IF (LastRegelRecordPtr = NIL) THEN
          BEGIN
               { empty body part }
               { weird situation - add the empty line }
               MsgsAddLineTo (Body,'');
               Exit; { ## EXIT ## }
          END;

     { body part found, last message is present }
     { check if this is an empty line }
     WITH Msg.BodyParts[Part]^.LastRegelRecordPtr^ DO
     BEGIN
          IF (Waar = wSwapped) THEN
          BEGIN
               { line is in the swap file - read it }
               Seek (SwapFile,SwapOffset);
               BlockRead (SwapFile,Regel[0],1);
               IF (Regel[0] = #0) THEN
               BEGIN
                    { end of swap file part }
                    { weird situation - add the empty line }
                    MsgsAddLineTo (Body,'');
                    Exit; { ## EXIT ## }
               END;

               { read the line so we can check it }
               BlockRead (SwapFile,Regel[1],Longint (Word (Byte (Regel[0]))));

               { add the empty line if this line is empty }
               IF (Regel <> #13) THEN
                  MsgsAddLineTo (Body,'');
          END ELSE
          BEGIN
               { line is in memory }
               IF (RegelPtr = NIL) THEN
               BEGIN
                    { weird situation - add the empty line }
                    MsgsAddLineTo (Body,'');
                    Exit; { ## EXIT ## }
               END;

               { see if the line is empty }
               IF (RegelPtr^ <> #13) THEN
                  MsgsAddLineTo (Body,'');
          END;
     END; { with }
END;


{--------------------------------------------------------------------------}
{ MsgsInsertBodyPartAtTop                                                  }
{                                                                          }
{ Attempts to insert a new bodypart at the top of the message.  Returns    }
{ FALSE if this is not possible (Msg.CurrentBodyPart is MAX_BODY_PARTS)    }
{                                                                          }
FUNCTION MsgsInsertBodyPartAtTop : BOOLEAN;

VAR Part : 0..MAX_BODY_PARTS;

BEGIN
     { Move the pointers down one. }

     { We can't handle this yet -- if this happens, MAX_BODY_PARTS should }
     { probably be increased anyway.                                      }
     IF (Msg.BodyParts[MAX_BODY_PARTS] <> NIL) THEN
     BEGIN
          LogMessage (liReport,'[MsgsInsertBodyPartAtTop] Increase MAX_BODY_PARTS!');
          MsgsInsertBodyPartAtTop:=FALSE;
          Exit;       { ## EXIT ## }
     END;

     Part:=MAX_BODY_PARTS-1;

     WHILE (Part > 0) DO
     BEGIN
          Msg.BodyParts[Part+1]:=Msg.BodyParts[Part];
          Dec (Part);
     END;

     Msg.BodyParts[1]:=NIL;
     Msg.CurrentBodyPart:=1;

     MsgsInsertBodyPartAtTop:=TRUE;
END;


{--------------------------------------------------------------------------}
{ MsgsRemoveBodyPart                                                       }
{                                                                          }
{ This routine is used to reverse the work done by the routine just above. }
{ The insertion focus is kept at the current body part, but is decreased   }
{ with one if we removed a body part before the current part.              }
{                                                                          }
PROCEDURE MsgsRemoveBodyPart (BodyPartNr : BYTE);

VAR Lp : 1..MAX_BODY_PARTS;

BEGIN
     MsgsReleaseLines (Msg.BodyParts[BodyPartNr]);

     FOR Lp:=BodyPartNr TO MAX_BODY_PARTS-1 DO
         Msg.BodyParts[Lp]:=Msg.BodyParts[Lp+1];

     IF (Msg.CurrentBodyPart > BodyPartNr) THEN
        Dec (Msg.CurrentBodyPart);
END;


{--------------------------------------------------------------------------}
{ MsgsGetLastBodyPart                                                      }
{                                                                          }
{ Returns a TopRegelRecordPtr to the last body part in a message.          }
{ Returns Nil if there are no body parts.                                  }
{                                                                          }
FUNCTION MsgsGetLastBodyPart: TopRegelRecordPtr;

VAR Part  : 0..MAX_BODY_PARTS;

BEGIN
     { find the last body part in use }
     Part:=MAX_BODY_PARTS;

     WHILE (Part > 0) AND (Msg.BodyParts[Part] = NIL) DO
           Dec (Part);

     IF (Part = 0) THEN
     BEGIN
          { there are no body parts at all }
          MsgsGetLastBodyPart := Nil;
          Exit; { ## EXIT ## }
     END;

     MsgsGetLastBodyPart := Msg.BodyParts [Part];
END;


{--------------------------------------------------------------------------}
{ MsgsSeekToLastBodyPart                                                   }
{                                                                          }
{ Sets CurrentBodyPart to the last active body part in a message.  (Used   }
{ as insurance by the tear-line adding functions of Netmail->Echomail)     }
{                                                                          }
PROCEDURE MsgsSeekToLastBodyPart;
BEGIN
     Msg.CurrentBodyPart:=MAX_BODY_PARTS;

     WHILE (Msg.CurrentBodyPart > 0) AND
           (Msg.BodyParts[Msg.CurrentBodyPart] = NIL) DO
           Dec (Msg.CurrentBodyPart);
END;


{--------------------------------------------------------------------------}
{ MsgsMergeFirstAndSecondBodyPart                                          }
{                                                                          }
{ This routine connects the chains of lines of the second body part to the }
{ end of the chain of lines of the first body part. It then cleans up the  }
{ second body part header.                                                 }
{                                                                          }
PROCEDURE MsgsMergeFirstAndSecondBodyPart;

VAR Top1,Top2 : TopRegelRecordPtr;
    Lp        : 1..MAX_BODY_PARTS;

BEGIN
     Top1:=Msg.BodyParts[1];
     Top2:=Msg.BodyParts[2];

{$IFDEF Pre}
     IF (Top1 = NIL) THEN
     BEGIN
          LogMessage (liReport,'Merge1&2: Top1 is NIL');
          Exit;
     END;

     IF (Top2 = NIL) THEN
     BEGIN
          LogMessage (liReport,'Merge1&2: Top2 is NIL');
          Exit;
     END;

     IF (Top1^.LastRegelRecordPtr = NIL) THEN
     BEGIN
          LogMessage (liReport,'Merg1&2: Top1 has no lines');
          Exit;
     END;

     IF (Top1^.LastRegelRecordPtr^.NextRegelRecordPtr <> NIL) THEN
     BEGIN
          LogMessage (liReport,'Merge1&2: Last.Next is not NIL');
          Exit;
     END;

     IF (Top2^.FirstRegelRecordPtr = NIL) THEN
     BEGIN
          LogMessage (liReport,'Merg1&2: Top2 has no lines');
          Exit;
     END;

     IF (Top1^.IsLocked) THEN
     BEGIN
          LogMessage (liReport,'Merge1&2: Top1 is locked!');
          Exit;
     END;

     IF (Top2^.IsLocked) THEN
     BEGIN
          LogMessage (liReport,'Merge1&2: Top2 is locked!');
          Exit;
     END;
{$ENDIF}

     Top1^.LastRegelRecordPtr^.NextRegelRecordPtr:=Top2^.FirstRegelRecordPtr;
     Top1^.LastRegelRecordPtr:=Top2^.LastRegelRecordPtr;
     Inc (Top1^.TotalRegelLength,Top2^.TotalRegelLength);

     { free the second body part top }
     FreeMem (Top2,SizeOf (TopRegelRecord));

     { pack the pointers }
     FOR Lp:=2 TO MAX_BODY_PARTS-1 DO
         Msg.BodyParts[Lp]:=Msg.BodyParts[Lp+1];
END;

{$IFDEF MSGS_DEBUG}
{--------------------------------------------------------------------------}
{ MsgsDumpDebugCopy                                                        }
{                                                                          }
{ This routine can be used at different stages of the message processing   }
{ to get a status dump of the enter message (top level only).              }
{                                                                          }
PROCEDURE MsgsDumpDebugCopy (MomentDescr : STRING);

VAR DumpF : TEXT;

    PROCEDURE DumpRegel (Regel : STRING);

    VAR Lp    : BYTE;
        InStr : BOOLEAN;

    BEGIN
         Write (DumpF,'Regel=');

         IF (Regel = '') THEN
         BEGIN
              WriteLn (DumpF,'""');
              Exit;
         END;

         InStr:=FALSE;

         FOR Lp:=1 TO Length (Regel) DO
         BEGIN
              IF (Regel[Lp] IN [' '..'~']) THEN
              BEGIN
                   IF (NOT InStr) THEN
                   BEGIN
                        InStr:=TRUE;
                        IF (Lp = 1) THEN
                           Write (DumpF,'"')
                        ELSE
                            Write (DumpF,',"');
                   END;

                   Write (DumpF,Regel[Lp]);
              END ELSE
              BEGIN
                   IF InStr THEN
                   BEGIN
                        InStr:=FALSE;
                        Write (DumpF,'"');
                   END;

                   IF (Lp <> 1) THEN
                      Write (DumpF,',');

                   Write (DumpF,Byte2HexString (Byte (Regel[Lp])));
              END;
         END;

         IF InStr THEN
            Write (DumpF,'"');

         WriteLn (DumpF);
    END;

    PROCEDURE DumpTopRegel (Descr : STRING; TopPtr : TopRegelRecordPtr);

    VAR RegelPtr : EenRegelRecordPtr;
        Regel    : STRING;

    BEGIN
         WriteLn (DumpF,'-------');

         IF (TopPtr = NIL) THEN
         BEGIN
              WriteLn (DumpF,Descr,' = NIL');
              Exit;
         END;

         WriteLn (DumpF,Descr,':');

         WriteLn (DumpF,'TotalRegelLength = ',TopPtr^.TotalRegelLength);
         IF (TopPtr^.FirstRegelRecordPtr = NIL) THEN
            WriteLn (DumpF,'FirstRegelRecordPtr = NIL')
         ELSE
             WriteLn (DumpF,'FirstRegelRecordPtr <> NIL');

         IF (TopPtr^.LastRegelRecordPtr = NIL) THEN
            WriteLn (DumpF,'LastRegelRecordPtr = NIL')
         ELSE
             WriteLn (DumpF,'LastRegelRecordPtr <> NIL');

         WriteLn (DumpF,'PartStatus = ',Byte (TopPtr^.PartStatus));
         WriteLn (DumpF,'AttachmentInfo = "',TopPtr^.AttachmentInfo,'"');
         WriteLn (DumpF,'IsLocked = ',TopPtr^.IsLocked);

         RegelPtr:=TopPtr^.FirstRegelRecordPtr;

         WHILE (RegelPtr <> NIL) DO
         BEGIN
              CASE RegelPtr^.Waar OF
                   wMem :
                       BEGIN
                            {$IFDEF REGEL_LENGTH_CHECK}
                            Write (DumpF,'Len_Check=',RegelPtr^.Len_Check,'; ');
                            {$ENDIF}

                            DumpRegel (RegelPtr^.RegelPtr^);
                       END;

                   wSwapped :
                       BEGIN
                            WriteLn (DumpF,'SwapOffset=',RegelPtr^.SwapOffset,':');

                            Seek (SwapFile,RegelPtr^.SwapOffset);

                            REPEAT
                                  BlockRead (SwapFile,Regel[0],1);

                                  IF (Regel <> '') THEN
                                     BlockRead (SwapFile,Regel[1],Byte (Regel[0]));

                                  DumpRegel (Regel);

                            UNTIL (Regel = '');
                       END;

                   ELSE
                       WriteLn (DumpF,'Waar=',Byte (RegelPtr^.Waar),' = ?? ***********');
              END; { case }

              RegelPtr:=RegelPtr^.NextRegelRecordPtr;
         END; { while }
    END;

VAR Name    : STRING;
    IORes   : BYTE;
    DestPtr : DestRecordPtr;
    Lp      : WORD;
    SBPPtr  : SBP_BlockPtr;

BEGIN
     Name:=GetUniqueFilename ('.','.DMP');

     Assign (DumpF,Name);
     {$I-} ReWrite (DumpF); {$I+} IORes:=IOResult;
     IF (IORes <> 0) THEN
     BEGIN
          LogDiskIOError (IORes,'Failed to create debug dump '+Name);
          Exit;
     END;

     WriteLn (DumpF,'Debug Dump File');
     WriteLn (DumpF);
     WriteLn (DumpF,'Moment: ',MomentDescr);
     WriteLn (DumpF);

     WriteLn (DumpF,'Msg.Ready_F = ',Byte (Msg.Ready_F));
     WriteLn (DumpF,'Msg.Ready_U = ',Byte (Msg.Ready_U));

     WriteLn (DumpF,'Destinations:');

     DestPtr:=Msg.FirstDest;
     WHILE (DestPtr <> NIL) DO
     BEGIN
          WriteLn (DumpF,'Status = ',Byte (DestPtr^.Status));
          WriteLn (DumpF,'ByFilter = ',DestPtr^.ByFilter);
          WriteLn (DumpF,'ToUser_F = "',DestPtr^.ToUser_F,'"');
          WriteLn (DumpF,'ToAddr_F = ',Fido2Str (DestPtr^.ToAddr_F));
          WriteLn (DumpF,'To_U = "',DestPtr^.To_U,'"');
          WriteLn (DumpF,'ToType = ',Byte (DestPtr^.ToType));
          WriteLn (DumpF,'UserRecNr = ',DestPtr^.UserRecNr);
          WriteLn (DumpF,'AreaRecNr = ',DestPtr^.AreaRecNr);
          WriteLn (DumpF,'AddNote = ',DestPtr^.AddNote);
          WriteLn (DumpF,'ListPos = ',DestPtr^.ListPos);
          WriteLn (DumpF,'--');
          DestPtr:=DestPtr^.NextDest;
     END; { while }

     IF (Msg.PrevMsgPtr = NIL) THEN
        WriteLn (DumpF,'Msg.PrevMsgPtr = NIL')
     ELSE
         WriteLn (DumpF,'Msg.PrevMsgPtr <> NIL');

     WriteLn (DumpF,'Msg.AddedEcho = ',Msg.AddedEcho);
     WriteLn (DumpF,'Msg.AddedNews = ',Msg.AddedNews);
     WriteLn (DumpF,'Msg.DidAreaToList = ',Msg.DidAreaToList);

     FOR Lp:=1 TO MAX_AREA_CROSS_POSTS DO
         IF (Msg.AreaRecNrs[Lp] <> NILRecordNr) THEN
            WriteLn (DumpF,'Msg.AreaRecNrs[',Lp,'] = ',Msg.AreaRecNrs[Lp]);

     FOR Lp:=1 TO MAX_AREA_CROSS_POSTS DO
         IF (Msg.AreaMsgIds[Lp] <> '') THEN
            WriteLn (DumpF,'Msg.AreaMsgIds[',Lp,'] = "',Msg.AreaMsgIds[Lp],'"');

     WriteLn (DumpF,'Msg.DidList = ',Msg.DidList);

     WriteLn (DumpF,'Msg.Stored_ToUser = "',Msg.Stored_ToUser,'"');
     WriteLn (DumpF,'Msg.Stored_ToAddr = ',Fido2Str (Msg.Stored_ToAddr));

     WriteLn (DumpF,'Msg.IsBounceMsg = ',Msg.IsBounceMsg);
     WriteLn (DumpF,'Msg.ExportAreaRecNr = ',Msg.ExportAreaRecNr);

     WriteLn (DumpF,'Msg.FromUser_F = "',Msg.FromUser_F,'"');
     WriteLn (DumpF,'Msg.FromAddr_F = ',Fido2Str (Msg.FromAddr_F));
     WriteLn (DumpF,'Msg.ToUser_F = "',Msg.ToUser_F,'"');

     WriteLn (DumpF,'Msg.ReplyAKA = ',Fido2Str (Msg.ReplyAKA));
     WriteLn (DumpF,'Msg.ReplyUser = "',Msg.ReplyUser,'"');
     WriteLn (DumpF,'Msg.ReplyEmail = "',Msg.ReplyEmail,'"');

     WriteLn (DumpF,'Msg.Attr_F = ',Word2HexString (Msg.Attr_F));
     WriteLn (DumpF,'Msg.ExtAttr_F = ',Long2HexString (Msg.ExtAttr_F));
     WriteLn (DumpF,'Msg.Subj_F = "',Msg.Subj_F,'"');
     WriteLn (DumpF,'Msg.Cost_F = ',Msg.Cost_F);
     WriteLn (DumpF,'Msg.Date_F = "',Msg.Date_F,'"');
     WriteLn (DumpF,'Msg.Chrs_F = "',Msg.Chrs_F,'"');
     WriteLn (DumpF,'Msg.MsgID_F = "',Msg.MsgID_F,'"');
     WriteLn (DumpF,'Msg.ReplyID_F = "',Msg.ReplyID_F,'"');

     WriteLn (DumpF,'Msg.FromUser_U = "',Msg.FromUser_U,'"');
     WriteLn (DumpF,'Msg.ToUser_U = "',Msg.ToUser_U,'"');
     WriteLn (DumpF,'Msg.Subj_U = "',Msg.Subj_U,'"');
     WriteLn (DumpF,'Msg.Date_U = "',Msg.Date_U,'"');
     WriteLn (DumpF,'Msg.ApparentlyTo_U = "',Msg.ApparentlyTo,'"');
     WriteLn (DumpF,'Msg.ApparentlyFrom_U = "',Msg.ApparentlyFrom,'"');
     WriteLn (DumpF,'Msg.ReplyTo_U = "',Msg.ReplyTo_U,'"');
     WriteLn (DumpF,'Msg.Sender_U = "',Msg.Sender_U,'"');
     WriteLn (DumpF,'Msg.Newsgroups_U = "',Msg.Newsgroups_U,'"');
     WriteLn (DumpF,'Msg.Organization_U = "',Msg.Organization_U,'"');
     WriteLn (DumpF,'Msg.InReplyTo_U = "',Msg.InReplyTo_U,'"');
     WriteLn (DumpF,'Msg.MessageId_U = "',Msg.MessageId_U,'"');
     WriteLn (DumpF,'Msg.Approved_U = "',Msg.Approved_U,'"');

     WriteLn (DumpF,'Msg.IsMime = ',Msg.IsMime);
     WriteLn (DumpF,'Msg.MultiPartBoundary = "',Msg.MultiPartBoundary,'"');

     WriteLn (DumpF,'Msg.CurrentBodyPart = ',Msg.CurrentBodyPart);
     WriteLn (DumpF,'Msg.MsgSize = ',Msg.MsgSize);

     WriteLn (DumpF,'Msg.ExportedCount = ',Msg.ExportedCount);
     FOR Lp:=1 TO Msg.ExportedCount DO
         WriteLn (DumpF,'Msg.Exported^[',Lp,'] = ',Byte (Msg.Exported^[Lp]));

     WriteLn (DumpF,'Msg.MappersDone = ',Msg.MappersDone);
     WriteLn (DumpF,'Msg.MapperAction = ',Byte (Msg.MapperAction));
     WriteLn (DumpF,'Msg.MapperPos = ',Msg.MapperPos);
     WriteLn (DumpF,'Msg.FilterUsed = ',Byte (Msg.FilterUsed));

     WriteLn (DumpF,'Msg.DeliveringUserRecNr = ',Msg.DeliveringUserRecNr);

     WriteLn (DumpF,'Msg.SBP_Zone = ',Msg.SBP_Zone);
     WriteLn (DumpF,'SEEN-BY lines:');

     SBPPtr:=Msg.FirstSeenByPtr;
     WHILE (SBPPtr <> NIL) DO
     BEGIN
          WriteLn (DumpF,'Count=',SBPPtr^.Count);
          FOR Lp:=1 TO SBPPtr^.Count DO
              WriteLn (DumpF,'Nets,Nodes[',Lp,'] = ',SBPPtr^.Nets[Lp],',',SBPPtr^.Nodes[Lp]);

          SBPPtr:=SBPPtr^.NextBlockPtr;
     END;

     WriteLn (DumpF,'PATH lines:');

     SBPPtr:=Msg.FirstPathPtr;
     WHILE (SBPPtr <> NIL) DO
     BEGIN
          WriteLn (DumpF,'Count=',SBPPtr^.Count);
          FOR Lp:=1 TO SBPPtr^.Count DO
              WriteLn (DumpF,'Nets,Nodes[',Lp,'] = ',SBPPtr^.Nets[Lp],',',SBPPtr^.Nodes[Lp]);

          SBPPtr:=SBPPtr^.NextBlockPtr;
     END;

     WriteLn (DumpF,'Msg.IsListDist = ',Msg.IsListDist);
     WriteLn (DumpF,'Msg.ListPos = ',Msg.ListPos);
     WriteLn (DumpF,'Msg.ListSubj = "',Msg.ListSubj,'"');
     WriteLn (DumpF,'Msg.ListPosterEmail = "',Msg.ListPosterEmail,'"');
     WriteLn (DumpF,'Msg.ListPosterName = "',Msg.ListPosterName,'"');
     WriteLn (DumpF,'Msg.ListPosterAKA = ',Fido2Str (Msg.ListPosterAKA));
     WriteLn (DumpF,'Msg.BounceReason = "',Msg.BounceReason,'"');
     WriteLn (DumpF,'Msg.BadReason = "',Msg.BadReason,'"');
     WriteLn (DumpF,'Msg.WasGated = ',Msg.WasGated);
     WriteLn (DumpF,'Msg.Area_F = "',Msg.Area_F,'"');
     WriteLn (DumpF,'Msg.Control = "',Msg.Control,'"');
     WriteLn (DumpF,'Msg.References_U = "',Msg.References_U,'"');
     WriteLn (DumpF,'Msg.BBSUserIndex = ',Msg.BBSUserIndex);
     WriteLn (DumpF,'Msg.BadAreaRecNr = ',Msg.BadAreaRecNr);

     DumpTopRegel ('Msg.HeaderTop_F',Msg.HeaderTop_F);
     DumpTopRegel ('Msg.FooterTop_F',Msg.FooterTop_F);
     DumpTopRegel ('Msg.CopiedHeadersTop_F',Msg.CopiedHeadersTop_F);
     DumpTopRegel ('Msg.HeaderTop_U',Msg.HeaderTop_U);

     FOR Lp:=1 TO MAX_BODY_PARTS DO
         DumpTopRegel ('Msg.BodyParts['+Word2String (Lp)+']',Msg.BodyParts[Lp]);

     WriteLn (DumpF);
     Close (DumpF);
END;
{$ENDIF}

{$IFDEF Pre}
{--------------------------------------------------------------------------}
{ Msgs_SanityCheck                                                         }
{                                                                          }
{ This routine verifies that all fields of the Msgs structure contain      }
{ valid date. Some important rules are checked here to avoid unnecessary   }
{ bugs and work-arounds in the generic code. This routine is called from   }
{ Deliver_Now.                                                             }
{                                                                          }
PROCEDURE Msgs_SanityCheck;

    PROCEDURE CheckNoHash13 (VAR Regel : STRING; Descr : STRING);
    BEGIN
         IF (Pos (#13,Regel) > 0) THEN
            LogMessage (liReport,'[Msgs] Found #13 in Msg.'+Descr);
    END;

    PROCEDURE CheckHash13 (VAR Regel : STRING; Descr : STRING);

    VAR P,L : BYTE;

    BEGIN
         L:=Length (Regel);

         IF (L = 0) THEN
            Exit;

         P:=Pos (#13,Regel);

         IF (P = 0) THEN
            LogMessage (liReport,'[Msgs] Missing #13 in Msg.'+Descr)
         ELSE
             IF (P <> L) THEN
                LogMessage (liReport,'[Msgs] Badly placed #13 in Msg.'+Descr);
    END;

BEGIN
     { check that the headers do not contain a #13 at the end }

     CheckNoHash13 (Msg.FromUser_U,    'FromUser_U');
     CheckNoHash13 (Msg.ToUser_U,      'ToUser_U');
     CheckNoHash13 (Msg.Subj_U,        'Subj_U');
     CheckNoHash13 (Msg.Date_U,        'Date_U');
     CheckNoHash13 (Msg.ApparentlyTo,  'ApparentlyTo');
     CheckNoHash13 (Msg.ApparentlyFrom,'ApparentlyFrom');
     CheckNoHash13 (Msg.ReplyTo_U,     'ReplyTo_U');
     CheckNoHash13 (Msg.Sender_U,      'Sender_U');
     CheckNoHash13 (Msg.Newsgroups_U,  'Newsgroups_U');
     CheckNoHash13 (Msg.Organization_U,'Organisation_U');
     CheckNoHash13 (Msg.InReplyTo_U,   'InReplyTo_U');
     CheckNoHash13 (Msg.MessageId_U,   'MessageId_U');

     CheckHash13 (Msg.UUCP_From_,  'UUCP_From_');

     (* not yet checked headers:
                           { current format of this message }
                           Ready_F,
                           Ready_U         : MsgType;

                           { list of recipient addresses }
                           FirstDest       : DestRecordPtr;

                           { for MsgsPush/PopState }
                           PrevMsgPtr      : MessageRecordPtr;

                           { to prevent distributing twice }
                           AddedEcho       : BOOLEAN;
                           AddedNews       : BOOLEAN;
                           DidAreaToList   : BOOLEAN;

                           { for news->echo distribution }
                           AreaRecNrs      : ARRAY[1..MAX_AREA_CROSS_POSTS] OF AreaBaseRecordNrType;
                           AreaMsgIds      : ARRAY[1..MAX_AREA_CROSS_POSTS] OF STRING[8];

                           { set when echo/news is distributed via a list }
                           { limits to one list per incoming message      }
                           DidList         : BOOLEAN;

                           { single user destination during I/O }
                           { (for message bases and pkt) }
                           Stored_ToUser   : STRING;
                           Stored_ToAddr   : FidoAddrType;

                           {## sending system for bouncing?? }
                           { to know where to bounce the message }
                           { set to empty for internally originated }
                           { messages, to prevent bounce loops.     }
                           {##need type of address as well?
                           Bounce_User     : STRING[MaxLenUserName_F];
                           Bounce_Addr     : FidoAddrType;
                           Bounce_To       : STRING;
                           }

                           { to suppress bounce filters }
                           IsBounceMsg     : BOOLEAN;

                           { avoid import during export }
                           ExportAreaRecNr : AreaBaseRecordNrType;

                           { FTN fields }
                           FromUser_F      : STRING[MaxLenUserName_F];
                           FromAddr_F      : FidoAddrType;

                           { echomail only }
                           ToUser_F        : STRING[MaxLenUserName_F];

                           { REPLYADDR/REPLYTO kludges }
                           ReplyAKA        : FidoAddrType;
                           ReplyUser       : STRING[MaxLenUserName];
                           ReplyEmail      : STRING;

                           { other FTN fields }
                           Attr_F          : WORD;
                           ExtAttr_F       : LONGINT;
                           Subj_F          : STRING[MaxLenSubj_F];
                           Cost_F          : INTEGER;
                           Date_F          : STRING[MaxLenDate_F];
                           Chrs_F          : STRING[20];
                           MsgID_F         : STRING;
                           ReplyID_F       : STRING;


                           { MIME }
                           IsMime            : BOOLEAN;
                           MultiPartBoundary : STRING[70];  { part boundary text }
                                                            { 70=Limit is RFC1521 }

                           { message parts }
                           HeaderTop_F,
                           HeaderTop_U,
                           FooterTop_F     : TopRegelRecordPtr;

                           CurrentBodyPart : BYTE;
                           BodyParts       : ARRAY[1..MAX_BODY_PARTS] OF TopRegelRecordPtr;

                           { voor de stats }
                           MsgSize         : LONGINT; { in bytes }

                           { only one news article copy to each user }
                           Exported        : ExportedListPtr;
                           ExportedCount   : WORD;

                           { filters }
                           MappersDone     : BYTE; { as Limit }
                           MapperAction    : MapActionType;
                           MapperPos       : LONGINT; { for action }
                           FilterUsed      : MapActionType;

                           { for stats }
                           DeliveringUserRecNr : UserBaseRecordNrType;

                           { seen-by and path of original message }
                           SBP_Zone        : WORD;         { at creation time }
                           FirstSeenByPtr  : SBP_BlockPtr;
                           FirstPathPtr    : SBP_BlockPtr;

                           { if TRUE doesn't trigger mailing lists, tunnels, }
                           { etc. and performs special translations.         }
                           IsListDist      : BOOLEAN;
                           ListPos         : LONGINT;
                           ListSubj        : STRING;

                           ListPosterEmail : STRING[MaxLenDomain];
                           ListPosterName  : STRING[MaxLenUserName_F];
                           ListPosterAKA   : FidoAddrType;

                           BounceReason    : STRING; { for route.tdb }

                           { v--- old ---v }

                           BadReason   : STRING;

                           {ListServer  : BOOLEAN; { TRUE als msg distributie van mailing list }
                           WasGated    : BOOLEAN; { to usenet, ivm KillGatedNetmail & BBS-EMAILAREA }
                           { other for Areafix ivm Received ipv Sent vlag }

                           Area_F      : STRING[MaxLenAreaName];

                           { RFC fields }
                           Control        : STRING;
                           References_U   : STRING;
                           BBSUserIndex   : WORD;

                           BadAreaRecNr : AreaBaseRecordNrType;
     *)
END;
{$ENDIF (Pre)}

{--------------------------------------------------------------------------}
{ unit initialisation                                                      }
{                                                                          }
{ Hier worden de regel pointer van de universele msg op NIL gezet zodat    }
{ MsgsEmpty geen onaangevraagd geheugen vrij probeert te geven.            }
{                                                                          }

VAR Lp : BYTE;

BEGIN
     WITH Msg DO
     BEGIN
          HeaderTop_F:=NIL;
          HeaderTop_U:=NIL;
          FooterTop_F:=NIL;
          CopiedHeadersTop_F:=NIL;
          FirstDest:=NIL;
          PrevMsgPtr:=NIL;
          FirstSeenByPtr:=NIL;
          FirstPathPtr:=NIL;

          FOR Lp:=1 TO MAX_BODY_PARTS DO
              BodyParts[Lp]:=NIL;

          CurrentBodyPart:=1;
     END;

     MsgTrashAllNewLines:=FALSE;
END.
