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

{$i platform.inc}

{ De AreaFix, AreaMgr, NewsFix, ... }

{ History

RvdW 20-02-93 Deze unit begonnen ConnectArea en DisConnectArea gemaakt
     26-02-93 ConnectArea public gemaakt voor de Import unit
     02-04-93 MgrAreaData en MgrUserData public aangemaakt ipv lokaal in
              de procedures.
MD   24-06-93 Samenvoegen met de Fido Areafix routines
     21-10-93 Toevoegen van %PASSIVE en %ACTIVE aan de fido routines
     17-02-94 Bug gefixed in %QUERY commando, en een standaard uucp
              adres parsing routine toegevoegt.

Note: Er zit in deze routines een hoop onnodige en dubbele code, als ik een
      keer de geest krijg zal ik er eens een bezem doorhalen.

RvdW ??-??-94 Correctie op het sorteren van de lijst.
     18-02-95 Rewrite en integratie van AreaFix/NewsFix.
              Uitbreiding met sorteren op group.

     19-08-95 Query en List lijsten worden in altijd in het geheugen
              gesorteerd met de geavanceerde methode die ook bij
              Pack Databases gebruikt wordt.
     9710     Big rewrite for multi-recipient handling and multiple
              messages in internal memory.
}

INTERFACE

USES Database;

FUNCTION  ConnectArea (AreaBaseRecordNr : AreaBaseRecordNrType; UserBaseRecordNr : UserBaseRecordNrType) : BOOLEAN;

PROCEDURE Newsfix_ProcessMessage;
PROCEDURE AreaFix_ProcessMessage;

PROCEDURE ExportAreafixForwardRequests;
PROCEDURE ExportNewsfixForwardRequests;

PROCEDURE SendNotificationMessages;

FUNCTION  IsAreafixName (Name: STRING): BOOLEAN;

VAR NotifyArgument : STRING[30];


IMPLEMENTATION

USES Cfg,
     Msgs,
     Ramon,
     Fido,
     Logs,
     TextFile,
     Usenet,
     Globals,
     AreaBase,
     SwapMem,
     Language,
     FlexCfg,
     Outbound,
     Address,
     Deliver,
     DList,
     Dos,
     Rescan,
     UnixTime;

CONST FIDOFWDBUFFER_FILENAME = 'FIDOREQ.LST';

    { schrijver van de fix }
VAR UserInfoRecNr  : UserBaseRecordNrType;
    UserInfo       : UserBaseRecord;

    { voor de processor }
    IgnoreCommand,              { onbekende %FROM node }
    RequestedQuery,
    RequestedList,
    RequestedHelp  : BOOLEAN;

    SearchDescr    : STRING[MaxLenComment];

{
VAR AreaFixForwardList,
    NewsFixForwardList : TopRegelRecordPtr;
}

{ structuren voor List en Query lijsten om de lijst te sorteren }
CONST QLXb  = 10;
      QLYb  = 5;
      QLXl  = 60;
      QLYl  = 9;
      QLXb2 = 42;

CONST MapRecordsPerArray = 4096; { veelvoud van twee, optimaliseert DIV en MOD }
      MapArrays          = 65536 DIV MapRecordsPerArray; { max arrays nodig voor alle areabase records }

TYPE NamesBlock    = ARRAY[1..61440] OF CHAR;
     NamesBlockPtr = ^NamesBlock;

     MapRecord    = RECORD
                          RecNr : WORD; { NILRecordNr = Deleted }

                          { GroupCh wordt ingevuld als het geheugen voor   }
                          { de area namen vrijgegeven wordt, zodat bij het }
                          { toevoegen aan het bericht de GroupCh gebruikt  }
                          { kan worden om de area in een bepaalde groep te }
                          { stoppen. Ze worden dus niet tegelijk gebruikt. }
                          CASE Integer OF
                               0 : (NamePtr : ^STRING);
                               1 : (Group   : STRING[2]);
                    END;

     MapRecordPtr = ^MapRecord;

     MapArray     = ARRAY[0..MapRecordsPerArray-1] OF MapRecord;
     MapArrayPtr  = ^MapArray;

     FetchNextRecNrFunc = PROCEDURE (VAR RecNr : WORD; VAR AreaName : STRING);

VAR MapAreaRecCount : WORD;
    PartNameLen     : BYTE;
    AreaDataTable   : ARRAY[0..MapArrays-1] OF MapArrayPtr;
    NameCount       : BYTE;
    NameLengths     : ARRAY[1..10] OF WORD;
    NamePtrs        : ARRAY[1..10] OF NamesBlockPtr;

    QuerySearch     : SubscrSearchRecord;

VAR RulesToSend : List;


(*
{--------------------------------------------------------------------------}
{ AreaMgr_MatchAKA (Node: FidoAddrType);                                   }
{                                                                          }
{ (Used in Areafix replies)                                                }
{                                                                          }
{ If the specified node is in our userbase, this returns the AKA index for }
{ sending.  This way, the message will come from the same address as the   }
{ packet normally would.                                                   }
{                                                                          }
FUNCTION AreaMgr_MatchAKA (Node: FidoAddrType): BYTE;
VAR
     RecNr: UserBaseRecordNrType;
     UserRec: UserBaseRecord;

BEGIN
     AreaMgr_MatchAKA := 0;                       { Automatic }

     IF (NOT FindUserBaseRecordByFidoAddress (Node, RecNr)) THEN
          Exit;

     ReadUserBaseRecord (RecNr, UserRec);
     AreaMgr_MatchAKA := UserRec.ExportAKA;
END;
*)

{--------------------------------------------------------------------------}
{ ConnectArea                                                              }
{                                                                          }
{ Deze routine sluit een area aan bij een user. Deze routine koppelt zowel }
{ de Area bij de UserSubscrList van de UserBase als de User bij de         }
{ AreaSubscrList bij de AreaBase. Het is van groot belang dat beide        }
{ records die mogelijk gewijzigd kunnen worden naar disk geschreven zijn.  }
{ Dat zijn dus de records waarvan de nummers aan deze routine worden mee-  }
{ gegeven. Achteraf moeten deze weer ingelezen worden om up to date te     }
{ zijn.                                                                    }
{ RAWI980522: Now returns TRUE when the two were already subscribed to     }
{             each other.                                                  }
{                                                                          }
FUNCTION ConnectArea (AreaBaseRecordNr : AreaBaseRecordNrType; UserBaseRecordNr : UserBaseRecordNrType) : BOOLEAN;

VAR MgrAreaData : AreaBaseRecord;
    MgrUserData : UserBaseRecord;
    Already     : BOOLEAN;

BEGIN
     IF (AreaBaseRecordNr = NILRecordNr) OR (UserBaseRecordNr = NILRecordNr) THEN
        Exit;

     ReadAreaBaseRecord (AreaBaseRecordNr,MgrAreaData);
     Already:=AddUserToAreaSubscrList (MgrAreaData,UserBaseRecordNr);
     WriteAreaBaseRecord (AreaBaseRecordNr,MgrAreaData);

     ReadUserBaseRecord (UserBaseRecordNr,MgrUserData);
     Already:=Already OR AddAreaToUserSubscrToList (MgrUserData,AreaBaseRecordNr);
     WriteUserBaseRecord (UserBaseRecordNr,MgrUserData);

     ConnectArea:=Already;
END;


{--------------------------------------------------------------------------}
{ DisconnectArea                                                           }
{                                                                          }
{ Deze routine koppelt een area voor een user af. Bij de AreaBase wordt    }
{ het User nummer uit de UserSubscrList gehaald en in de UserBase wordt    }
{ het Area nummer uit de AreaSubscrList gehaald. Het is van groot belang   }
{ dat beide records waarvan de record nummers zijn opgegeven, zijn         }
{ geupdate op disk. Na de aanroep van deze routine kunnen ze weer worden   }
{ ingelezen.                                                               }
{                                                                          }
PROCEDURE DisconnectArea (AreaBaseRecordNr : AreaBaseRecordNrType; UserBaseRecordNr : UserBaseRecordNrType);

VAR MgrAreaData : AreaBaseRecord;
    MgrUserData : UserBaseRecord;

BEGIN
     ReadAreaBaseRecord (AreaBaseRecordNr,MgrAreaData);
     RemoveUserFromAreaSubscrList (MgrAreaData,UserBaseRecordNr);
     WriteAreaBaseRecord (AreaBaseRecordNr,MgrAreaData);

     ReadUserBaseRecord (UserBaseRecordNr,MgrUserData);
     RemoveAreaFromUserSubscrToList (MgrUserData,AreaBaseRecordNr);
     WriteUserBaseRecord (UserBaseRecordNr,MgrUserData);
END;


{==========================================================================}
{                        AREAFIX FORWARDING                                }
{                                                                          }
{ Dit stel routines kijkt of we een area bij een ander systeem wel kunnen  }
{ aanvragen als deze lokaal niet beschikbaar is.                           }
{==========================================================================}


{--------------------------------------------------------------------------}
{ ExportAreaFixForwardRequests                                             }
{                                                                          }
{ Deze routine handelt de areafix forward verzoeken af en zet deze om in   }
{ berichten aan uplink systemen.                                           }
{                                                                          }
PROCEDURE ExportAreaFixForwardRequests;

VAR InFile    : TEXT;
    InPath    : FilePathStr;
    OutFile   : TEXT;
    OutPath   : FilePathStr;
    IORes     : BYTE;
    Regel     : STRING;
    FwdStr,
    OurStr    : STRING;
    OurAddr,
    FwdAddr   : FidoAddrType;
    P         : BYTE;
    AddedSome : BOOLEAN;
    Found     : BOOLEAN;
    FwdRec    : AreafixForwardRecord;
    ReadPos   : LONGINT;
    Search    : SearchRec;

LABEL Einde;

BEGIN
     { we kunnen maar e'e'n netmailtje tegelijk schrijven, dus we moeten }
     { een paar keer door de file heen. We schrijven alles wat we niet   }
     { verwerken naar een tijdelijke file.                               }

     InPath:=Config.SystemDir+FIDOFWDBUFFER_FILENAME;
     OutPath:=Config.SystemDir+'FIDOREQ.$$$';

     FindFirst (InPath,saJustFiles,Search);
     IF (DosError <> 0) OR (Search.Size = 0) THEN
     BEGIN
          FindClose (Search);
          Exit;
     END;

     FindClose (Search);

     REPEAT
           Assign (InFile,InPath);
           {$I-} Reset (InFile); {$I+} IORes:=IOResult;
           IF (IORes <> 0) THEN
           BEGIN
                IF (IORes <> 2{file not found is normal}) THEN
                   LogDiskIOError (IORes,'Cannot open '+InPath);
                Exit;
           END;

           {$IFDEF LogFileIO}PostOpenT (InFile);{$ENDIF}
           PeekFiles;

           { lees een regel uit de InFile }
           ReadLn (InFile,Regel);

           IF (Regel = '') OR (Pos (' ',Regel) = 0) THEN
           BEGIN
                LogMessage (liFatal,InPath+' is corrupt');
                {$IFDEF LogFileIO}PreCloseT (InFile);{$ENDIF}
                Close (InFile);
                Exit;
           END;

           Assign (OutFile,OutPath);
           {$I-} ReWrite (OutFile); {$I+} IORes:=IOResult;
           IF (IORes <> 0) THEN
           BEGIN
                LogDiskIOError (IORes,'Cannot create temporary file '+OutPath);
                {$IFDEF LogFileIO}PreCloseT (InFile);{$ENDIF}
                Close (InFile);
                Exit;
           END;

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

           AddedSome:=FALSE;

           { zoek het forward systeem voor deze regel. Alle andere regels }
           { voor ditzelfde systeem worden nu behandeld.                  }

           FwdStr:=Copy (Regel,1,Pos (' ',Regel)-1);
           FidoSplit (FwdStr,FwdAddr);

           Found:=FALSE;
           IF Flex_AreafixFwd_ReadFirst (FwdRec,ReadPos) THEN
              REPEAT
                    IF FidoCompare (FwdAddr,FwdRec.UplinkAddress) THEN
                       Found:=TRUE;
              UNTIL Found OR (NOT Flex_AreafixFwd_ReadNext (FwdRec,ReadPos));

           IF (NOT Found) THEN
              LogMessage (liConfig,FwdStr+' is not an AreaFix forward system')
           ELSE BEGIN
                { gevonden }
                {FidoMatch (FwdRec.UplinkAddress,OurAddr);}

                Delete (Regel,1,Pos (' ',Regel));

                OurStr:=Copy (Regel,1,Pos (' ',Regel)-1);
                FidoSplit (OurStr,OurAddr);

                Delete (Regel,1,Pos (' ',Regel));

                FTN_CreateNetmail (OurAddr,                { from aka }
                                   Config.Sysop,           { from }
                                   FwdRec.Password);       { subj }

                LogMessage (liGeneral,'Sending netmail to uplink '+FwdStr+' (from '+OurStr+')');

                Address_AddFTN (FwdRec.AreaManager,       { to }
                                FwdRec.UplinkAddress,     { to aka }
                                FALSE,FALSE);             { add note }

                IF Config.AdminCCAFixFwd THEN
                BEGIN
                     LogMessage (liTrivial,'Administrator will get a copy too');
                     Address_AddAdmin;
                END;

                MsgsAddLineTo (Body,Regel);
                LogExtraMessage (Regel);

                FwdStr:=FwdStr+' '+OurStr+' ';

                WHILE (NOT Eof (InFile)) DO
                BEGIN
                     ReadLn (InFile,Regel);

                     IF (Copy (Regel,1,Length (FwdStr)) = FwdStr) THEN
                     BEGIN
                          Delete (Regel,1,Length (FwdStr));
                          MsgsAddLineTo (Body,Regel);
                          LogExtraMessage (Regel);
                     END ELSE
                     BEGIN
                          WriteLn (OutFile,Regel);
                          AddedSome:=TRUE;
                     END;

                END; { while }

                LogMessage (liTrivial,'End of message');

                DeliverNow;

           END; { found }

           {$IFDEF LogFileIO}PreCloseT (OutFile);{$ENDIF}
           Close (OutFile);

           {$IFDEF LogFileIO}PreCloseT (InFile);{$ENDIF}
           Close (InFile);

           Erase (InFile);

           IF AddedSome THEN
              Rename (OutFile,InPath)
           ELSE
               Erase (OutFile);

     UNTIL (NOT AddedSome);

Einde:

     MsgsEmpty;
END;


{---------------------------------------------------------------------------}
{ ExportNewsFixForwardRequests                                              }
{                                                                           }
{ Deze routine handelt de forward requests die voor uucp uplinks nog        }
{ staan te wachten om afgehandeld te worden.                                }
{                                                                           }
PROCEDURE ExportNewsFixForwardRequests;
BEGIN
     { nog niet geimplementeerd }
END;


{---------------------------------------------------------------------------}
{ FidoUplinkRequest                                                         }
{                                                                           }
{ Deze routine verzoekt om een area bij een uplink. Deze verzoeken worden   }
{ in een file opgeslagen (zodat het bij een crash ook goed gaat) en later   }
{ verwerkt.                                                                 }
{ Action bepaald +, niets of -.                                             }
{                                                                           }
PROCEDURE FidoUplinkRequest (UplinkAddr : FidoAddrType; AreaName : AreaNameString; Action : STRING; OurAka : BYTE);

VAR AFile : TEXT;
    IORes : BYTE;

BEGIN
     Assign (AFile,Config.SystemDir+FIDOFWDBUFFER_FILENAME);
     {$I-} Append (AFile); {$I+} IORes:=IOResult;
     IF (IORes = 2) THEN
     BEGIN
          {$I-} ReWrite (AFile); {$I+} IORes:=IOResult;
     END;

     IF (IORes <> 0) THEN
     BEGIN
          LogDiskIOError (IORes,'Cannot store AreaFix forward request in '+FIDOFWDBUFFER_FILENAME);
          Exit;
     END;

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

     WriteLn (AFile,Fido2Str (UplinkAddr)+' '+
                    Fido2Str (Config.NodeNrs[OurAka])+' '+
                    Action+AreaName);

     {$IFDEF LogFileIO}PreCloseT (AFile);{$ENDIF}
     Close (AFile);

     IF Config.LogAreaFix THEN
        LogMessage (liGeneral,'Forward to '+Fido2Str (UplinkAddr)+': '+Action+AreaName);
END;


{---------------------------------------------------------------------------}
{ UUCPUplinkRequest                                                         }
{                                                                           }
{ Deze routine verzoekt om een area bij een uplink. Deze verzoeken worden   }
{ in een file opgeslagen (zodat het bij een crash ook goed gaat) en later   }
{ verwerkt.                                                                 }
{ Action bepaald +, niets of -.                                             }
{                                                                           }
PROCEDURE UUCPUplinkRequest (UplinkUUCPName : STRING; AreaName : AreaNameString; Action : STRING);

VAR AFile : TEXT;
    IORes : BYTE;

BEGIN
     Assign (AFile,Config.SystemDir+'UUCPREQ.LST');
     {$I-} Append (AFile); {$I+} IORes:=IOResult;
     IF (IORes = 2) THEN
     BEGIN
          {$I-} ReWrite (AFile); {$I+} IORes:=IOResult;
     END;

     IF (IORes <> 0) THEN
     BEGIN
          LogDiskIOError (IORes,'Cannot store NewsFix forward request in UUCPREQ.LST');
          Exit;
     END;

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

     WriteLn (AFile,UplinkUUCPName+','+Action+AreaName);

     {$IFDEF LogFileIO}PreCloseT (AFile);{$ENDIF}
     Close (AFile);

     IF Config.LogAreaFix THEN
        LogMessage (liGeneral,'Forward to '+UplinkUUCPName+': '+Action+AreaName);
END;


{--------------------------------------------------------------------------}
{ SearchAreasBBS                                                           }
{                                                                          }
{ Doorzoek een file met het AREAS.BBS formaat door om te kijken of de      }
{ genoemde area naam erin voorkomt en we het verzoek ervoor dus mogen      }
{ forwarden. Het formaat is als volgt:                                     }
{                                                                          }
{ origin!sysop                                                             }
{ ; comment                                                                }
{ P     ARENA 2:280/802  passthrough        <-- alleen deze worden bekeken }
{ %path ARENA 2:280/802  squish msgbase                                    }
{ !path ARENA 2:280/802  jam msgbase                                       }
{ 150   ARENA 2:280/802  hudson base                                       }
{                                                                          }
FUNCTION SearchAreasBBS (FileName,AreaName : STRING) : BOOLEAN;

VAR AreasFile : TEXT;
    IORes     : BYTE;
    Regel     : STRING;

BEGIN
     SearchAreasBBS:=FALSE; { assume not found }

     Assign (AreasFile,Filename);
     {$I-} Reset (AreasFile); {$I+} IORes:=IOResult;
     IF (IORes <> 0) THEN
     BEGIN
          IF (IORes = 2) THEN
             LogMessage (liConfig,'Areafix forward AREAS.BBS file not found: '+Filename)
          ELSE
              LogDiskIOError (IORes,'[SearchAreasBBS] Cannot open areas file '+Filename);
          Exit;
     END;

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

     { Skip de eerste regel van een AREAS.BBS file }
     ReadLn (AreasFile,Regel);

     WHILE (NOT Eof (AreasFile)) DO
     BEGIN
          ReadLn (AreasFile,Regel);

          { alleen regels met passthrough interpreteren }
          IF (Regel = '') OR (UpCase (Regel[1]) <> 'P') THEN
             Continue;

          { Strip het eerste gedeelte }
          Delete (Regel,1,Pos (' ',Regel));
          Regel:=DeleteFrontSpaces (Regel)+' ';

          { Strip het achterste gedeelte }
          Delete (Regel,Pos (' ',Regel),255);

          IF CaselessMatch (Regel,AreaName) THEN
          BEGIN
               SearchAreasBBS:=TRUE;
               Break;
          END;
     END; { while }

     {$IFDEF LogFileIO}PreCloseT (AreasFile);{$ENDIF}
     Close (AreasFile);
END;


{--------------------------------------------------------------------------}
{ SearchNamesList                                                          }
{                                                                          }
{ Doorzoek een file met het volgende formaat:                              }
{                                                                          }
{ ; comment                                                                }
{ AREANAME  Beschrijving                                                   }
{                                                                          }
{ Als in die file de opgegeven areanaam voorkomt, dan gegeven we TRUE      }
{ terug en mag het verzoek voor deze area resulteren in een forward        }
{ verzoek aan een uplink.                                                  }
{                                                                          }
FUNCTION SearchNamesList (FileName,AreaName : STRING) : BOOLEAN;

VAR AreasFile : TEXT;
    IORes     : BYTE;
    Comment,
    Regel     : STRING;

BEGIN
     SearchNamesList:=FALSE; { assume not found }

     Assign (AreasFile,Filename);
     {$I-} Reset (AreasFile); {$I+} IORes:=IOResult;
     IF (IORes <> 0) THEN
     BEGIN
          IF (IORes = 2) THEN
             LogMessage (liConfig,'Areafix forward names file not found: '+Filename)
          ELSE
              LogDiskIOError (IORes,'[SearchNamesList] Cannot open file '+Filename);
          Exit;
     END;

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

     WHILE (NOT Eof (AreasFile)) DO
     BEGIN
          ReadLn (AreasFile,Regel);

          IF (Regel = '') OR (Regel[1] = ';') THEN
             Continue;

          Regel:=DeleteFrontAndBackSpaces (CleanTabs (Regel,1));

          IF (Pos (' ',Regel) > 0) THEN
          BEGIN
               Comment:=Copy (Regel,Pos (' ',Regel),255);
               Comment:=DeleteFrontSpaces (Regel);
               Regel:=Copy (Regel,1,Pos (' ',Regel)-1);
          END ELSE
              Comment:='';

          IF CaselessMatch (Regel,AreaName) THEN
          BEGIN
               IF (Comment <> '') THEN
                  SearchDescr:=Comment;

               SearchNamesList:=TRUE;
               Break;
          END;
     END; { while }

     {$IFDEF LogFileIO}PreCloseT (AreasFile);{$ENDIF}
     Close (AreasFile);
END;


{--------------------------------------------------------------------------}
{ AreafixCheckForward                                                      }
{                                                                          }
{ Loop door de geconfigureerde lijsten, op zoek naar een matching areanaam }
{                                                                          }
{ Return : 0 = no match                                                    }
{          1 = Fido match                                                  }
{          2 = UUCP match                                                  }
{                                                                          }
FUNCTION AreafixCheckForward (AreaName : STRING) : INTEGER;

VAR ForwardTeller : 1..MaxAreafixFwd;
    RecNr         : UserBaseRecordNrType;
    Dummy         : FidoAddrType;
    Regel         : STRING;
    Res           : BOOLEAN;
    Found         : BOOLEAN;
    SentFwdReq    : BOOLEAN;
    UUCPFile,
    UUCPAreaFile  : TEXT;
    IORes         : BYTE;
    Asteriks      : BYTE;
    AddStr        : STRING[1];
    P             : BYTE;
    Comment       : STRING[MaxLenComment];
    AFwdRec       : AreafixForwardRecord;
    NFwdRec       : NewsfixForwardRecord;
    ReadPos       : LONGINT;
    GroupRec      : GroupDescRecord;

BEGIN
     AreafixCheckForward:=0; { niet gevonden }

     Found:=FALSE;
     SentFwdReq:=FALSE;

     IF Flex_AreafixFwd_ReadFirst (AFwdRec,ReadPos) THEN
        REPEAT
              { controleer of de user toegang heeft tot de groep }
              IF (NOT TestIfInGroup (UserInfo.Groups,AFwdRec.Group)) THEN
                 Continue;

              { controleer of er uberhaupt wel een adres is }
              IF (AFwdRec.UplinkAddress.Zone = 0) AND (AFwdRec.UplinkAddress.Net = 0) THEN
                 Continue;

              { controleer of de geconfigureerde NODE wel bestaat }
              IF (NOT FindUserBaseRecordByFidoAddress (AFwdRec.UplinkAddress,RecNr)) THEN
              BEGIN
                   LogMessage (liConfig,Config.AreaFixNames[1]+' forward system '+Fido2Str (AFwdRec.UplinkAddress)+
                                             ' is not defined in the Userbase!');
                   Continue;
              END;

              { kijk of dit een unconditional forward is }
              IF (NOT AFwdRec.Unconditional) THEN
              BEGIN
                   { Kijk of er wel een path gedefinieerd is }
                   IF (AFwdRec.AreaListPath = '') THEN
                   BEGIN
                        LogMessage (liConfig,'No arealist defined for conditional areafix forward system '+
                                    Fido2Str (AFwdRec.UplinkAddress));
                        Continue;
                   END;

                   SearchDescr:='Requested from '+Fido2Str (AFwdRec.UplinkAddress);

                   IF (AFwdRec.AreaList = lstAREASBBS) THEN
                      Res:=SearchAreasBBS (AFwdRec.AreaListPath,AreaName);

                   IF (AFwdRec.AreaList = lstNAMES) THEN
                      Res:=SearchNamesList (AFwdRec.AreaListPath,AreaName);

                   IF NOT Res THEN
                      Continue;
              END; { not unconditional }

              { voeg het verzoek om een area toe aan de lijst }
              IF (AFwdRec.AddPlus) THEN
                 AddStr:='+'
              ELSE
                  AddStr:='';

              ReadGroupDescRecord (AFwdRec.Group,GroupRec);

              FidoUplinkRequest (AFwdRec.UplinkAddress,AreaName,AddStr,AFwdRec.ExportAKA{GroupRec.OriginAka});

              AreaFixCheckForward:=1; { fido match }

              { creer een area en sluit de uplink en downlink aan }
              EmptyAreaDataRecord (AreaData);

              AreaData.AreaName_F:=AreaName;
              AreaData.AreaName_U:=AreaName;
              ResetGroupFlags (AreaData.IsInGroups);
              AddGroupToGroupList (AreaData.IsInGroups,AFwdRec.Group);
              AreaData.Comment:=SearchDescr;
              LogMessage (liGeneral,'Requested '+AreaName+' from '+Fido2Str (AFwdRec.UplinkAddress));

              { probeer het adres aan te passen aan de zender }
              AreaData.OriginAKA:=FidoMatchAdres (AFwdRec.UplinkAddress,Dummy);

              SetSingleSeenByBit (AreaData.AddSeenByAkas,AreaData.OriginAKA);

              AddIndexValueToAreaBaseIndexTable (GetAreaNameIndexValue (AreaName));
              WriteNewAreaBaseRecord (AreaData);

              { sluit de leverancier aan op de area }
              ConnectArea (AreaBaseRecCount,RecNr);

              { sluit de klant aan op de area }
              ConnectArea (AreaBaseRecCount,UserInfoRecNr);

              Found:=TRUE;
        UNTIL (Found) OR (NOT Flex_AreafixFwd_ReadNext (AFwdRec,ReadPos));

     { als ie nu nog niet gevonden is, dan kan ie nog in een van de uucp }
     { lijsten voorkomen.                                                }
     IF (NOT Found) THEN
        IF Flex_ReadNewsfixFwd_First (NFwdRec,ReadPos) THEN
           REPEAT
                 IF (NFwdRec.UUCPName <> '') AND (NFwdRec.AreaListPath <> '') THEN
                 BEGIN
                      { controleer of de user toegang heeft tot de groep }
                      IF (NOT TestIfInGroup (UserInfo.Groups,NFwdRec.Group)) THEN
                         Continue;

                      { controleer of de geconfigureerde NODE wel bestaat }
                      IF (NOT FindUserBaseRecordByUUCPName (NFwdRec.UUCPName,RecNr)) THEN
                      BEGIN
                           LogMessage (liConfig,Config.NewsfixName+' forward system '+
                                       NFwdRec.UUCPName+' is not defined in the Userbase!');
                           Continue;
                      END;

                      Assign (UUCPFile,NFwdRec.AreaListPath);
                      {$I-} Reset (UUCPFile); {$I+} IORes:=IOResult;
                      IF (IORes <> 0) THEN
                      BEGIN
                           LogDiskIOError (IORes,'[NewsfixCheckForward] Cannot open UUCP areas file '+NFwdRec.AreaListPath);
                           Continue;
                      END;

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

                      WHILE (NOT Eof (UUCPFile)) DO
                      BEGIN
                           ReadLn (UUCPFile,Regel);

                           { omdat we verderop een spatie zoeken, }
                           { zetten we de eerste eventuele tab om }
                           { in een spatie.                       }
                           IF (Pos (#9,Regel) > 0) THEN
                              Regel[Pos (#9,Regel)]:=' ';

                           { breek af op eerste spatie, zodat we     }
                           { "name description moderated" aankunnen. }
                           IF (Pos (' ',Regel) > 0) THEN
                           BEGIN
                                Comment:=Copy (Regel,Pos (' ',Regel),255);
                                Regel:=Copy (Regel,1,Pos (' ',Regel)-1);
                           END ELSE
                               Comment:='';

                           Regel:=UpCaseString (Regel);

                           Asteriks:=Pos ('*',Regel);

                           { vergelijk naam uit file met areaname }
                           IF (Asteriks = 0) THEN
                           BEGIN
                                IF (Regel <> AreaName) THEN
                                   Continue;
                           END ELSE
                               IF (Copy (Regel,1,Asteriks-1) <> Copy (AreaName,1,Asteriks-1)) THEN
                                  Continue;

                           { gevonden! }

                           UUCPUplinkRequest (NFwdRec.UUCPName,AreaName,'+');

                           LogMessage (liGeneral,'Requested '+AreaName+' from '+NFwdRec.UUCPName);

                           AreaFixCheckForward:=2; { uucp }

                           { creer een area, en sluit de uplink en downlink aan }
                           EmptyAreaDataRecord (AreaData);

                           AreaData.AreaName_F:=AreaName;
                           AreaData.AreaName_U:=AreaName;
                           ResetGroupFlags (AreaData.IsInGroups);
                           AddGroupToGroupList (AreaData.IsInGroups,NFwdRec.Group);
                           IF (Comment <> '') THEN
                           BEGIN
                                WHILE (Pos (#9,Comment) > 0) DO
                                      Comment[Pos (#9,Comment)]:=' ';

                                Comment:=DeleteFrontSpaces (Comment);

                                P:=Pos ('/MOD',UpCaseString (Comment));
                                IF (P > 0) THEN
                                   Comment:=Copy (Comment,1,P-1);

                                P:=Pos ('/MEXP',UpCaseString (Comment));
                                IF (P > 0) THEN
                                   Comment:=Copy (Comment,1,P-1);

                                AreaData.Comment:=DeleteBackSpaces (Comment);
                           END ELSE
                               AreaData.Comment:='Requested from '+NFwdRec.UUCPName;

                           { probeer het adres aan te passen aan de zender }
                           AreaData.OriginAKA:=Config.GatewayAKA;

                           SetSingleSeenByBit (AreaData.AddSeenByAkas,AreaData.OriginAKA);

                           AddIndexValueToAreaBaseIndexTable (GetAreaNameIndexValue (AreaName));
                           WriteNewAreaBaseRecord (AreaData);

                           { sluit de leverancier aan op de area }
                           ConnectArea (AreaBaseRecCount,RecNr);

                           { sluit de klant aan op de area }
                           ConnectArea (AreaBaseRecCount,UserInfoRecNr);

                           SentFwdReq:=TRUE; { exit everything }
                           Break; { uit de while }
                      END; { while }

                      {$IFDEF LogFileIO}PreCloseT (UUCPFile);{$ENDIF}
                      Close (UUCPFile);

                      IF SentFwdReq THEN
                         Break; { uit de repeat loop }
                 END; { correct one }
           UNTIL (NOT Flex_ReadNewsfixFwd_Next (NFwdRec,ReadPos));
END;


{--------------------------------------------------------------------------}
{ FindAFixFwdRec                                                           }
{                                                                          }
{ This routine searches the AreaFix Forward Definitions for the given      }
{ address. If found, it returns the entire record and TRUE, otherwise      }
{ FALSE.                                                                   }
{                                                                          }
FUNCTION FindAFixFwdRec (Address : FidoAddrType;
                         VAR AFwdRec : AreaFixForwardRecord) : BOOLEAN;

VAR ReadPos : LONGINT;

BEGIN
     IF Flex_AreafixFwd_ReadFirst (AFwdRec,ReadPos) THEN
        REPEAT
              IF FidoCompare (Address,AFwdRec.UplinkAddress) THEN
              BEGIN
                   FindAFixFwdRec:=TRUE; { found }
                   Exit;
              END;

        UNTIL (NOT Flex_AreafixFwd_ReadNext (AFwdRec,ReadPos));

     FindAFixFwdRec:=FALSE;
END;


{---------------------------------------------------------------------------}
{ CheckIfAreaCanGoPassive                                                   }
{                                                                           }
{ Deze routine controleert of een area die zojuist door iemand afgesloten   }
{ is nu in passieve mode gezet kan worden. AreaInfo moet de data van het    }
{ record bevatten en AreaInfoRecNr het record nummer.                       }
{                                                                           }
PROCEDURE CheckIfAreaCanGoPassive (VAR AreaInfo : AreaBaseRecord; AreaInfoRecNr : AreaBaseRecordNrType);

VAR DeletePassT : SubscrSearchRecord;
    TempUser    : UserBaseRecord;
    AFwdRec     : AreaFixForwardRecord;

BEGIN
     IF (NOT AreaInfo.AllowPassive) THEN
        Exit; { ## EXIT ## }

     GetFirstUserSubscribedToThisArea (AreaInfo.UserList,DeletePassT);

     IF (NOT DeletePassT.Found) THEN
     BEGIN
          { nobody subscribed anymore! }
          LogMessage (liGeneral,'No subscribers anymore to '+AreaInfo.AreaName_F);
          Exit;
     END;

     GetNextUserSubscribedToThisArea (DeletePassT);

     IF DeletePassT.Found THEN
        Exit; { more than 1 subscriber     ## EXIT ## }

     { just one left - assume it is the uplink }

     { Lees het record in van die enige aangesloten }
     { gebruiker. Hierbij maken we gebruik van het  }
     { feit dat een NextUser actie alleen de flag   }
     { Found of False zet, en de rest van de data   }
     { intact blijft.                               }
     ReadUserBaseRecord (DeletePassT.UserBaseRecordNr,TempUser);

     IF (TempUser.System = _F) THEN
     BEGIN
          IF (NOT FindAFixFwdRec (TempUser.Address,AFwdRec)) THEN
          BEGIN
               LogMessage (liConfig,'No AreaFix Forward Definition for '+Fido2Str (TempUser.Address)+
                                    '; maybe not the uplink?');
               LogExtraMessage ('Area cannnot go passive: '+AreaInfo.AreaName_F);
               Exit;
          END;

          FidoUplinkRequest (TempUser.Address,AreaInfo.AreaName_F,'-',AreaInfo.OriginAka);
     END;

     {## support other user types?}
     IF (TempUser.System IN [_U,_SOUP]) THEN
        UUCPUplinkRequest (TempUser.UUCPName,AreaInfo.AreaName_U,'-');

     { Zet de passive vlag van de area, op die manier   }
     { hoeft niet het hele record weggegooid te worden. }
     { Als iemand de area weer aansluit dan kunnen we   }
     { gewoon een berichtje aan de uplink sturen.       }
     AreaInfo.Passive:=TRUE;
     WriteAreaBaseRecord (AreaInfoRecNr,AreaInfo);
END;


{---------------------------------------------------------------------------}
{ CheckIfAreaHasToGoNonePassive                                             }
{                                                                           }
{ Deze routine controleert of de area waar iemand zich zometeen op aan gaat }
{ sluiten uit de passieve mode gehaald moet worden. Zoja, dan wordt het     }
{ verzoek klaargezet in een van de forward lists.                           }
{                                                                           }
PROCEDURE CheckIfAreaHasToGoNonePassive (VAR AreaInfo : AreaBaseRecord; AreaInfoRecNr : AreaBaseRecordNrType);

VAR DeletePassT : SubscrSearchRecord;
    TempUser    : UserBaseRecord;
    AFwdRec     : AreaFixForwardRecord;

BEGIN
     { Als de area PASSIVE was, moeten we gaan kijken was wie er ook }
     { al aangesloten was. Die moet dan een bericht krijgen dat de   }
     { area weer aangesloten is. (De uplink dus meestal) (hopen we)  }
     IF (NOT AreaInfo.Passive) THEN
        Exit;

     { area is nu passive en moet dus non-passive gemaakt worden }
     GetFirstUserSubscribedToThisArea (AreaInfo.UserList,DeletePassT);

     IF (NOT DeletePassT.Found) THEN
     BEGIN
          LogMessage (liConfig,'Passive area has no subscribers! Where is the uplink?!');
          Exit;
     END;

     GetNextUserSubscribedToThisArea (DeletePassT);

     IF DeletePassT.Found THEN
     BEGIN
          LogMessage (liConfig,'Passive area has more than one subscribed user! Who is the uplink?!');
          Exit;
     END;

     ReadUserBaseRecord (DeletePassT.UserBaseRecordNr,TempUser);

     IF (TempUser.System = _F) THEN
     BEGIN
          IF (NOT FindAFixFwdRec (TempUser.Address,AFwdRec)) THEN
          BEGIN
               LogMessage (liConfig,'No AreaFix Forward Definition for '+Fido2Str (TempUser.Address)+
                                    '; maybe not the uplink?');
               LogExtraMessage ('Area remains passive: '+AreaInfo.AreaName_F);
               Exit;
          END;

          FidoUplinkRequest (AFwdRec.UplinkAddress,AreaInfo.AreaName_F,'+',AFwdRec.ExportAKA);
     END;

     IF (TempUser.System IN [_U,_SOUP]) THEN
        UUCPUplinkRequest (TempUser.UUCPName,AreaInfo.AreaName_U,'+');

     AreaInfo.Passive:=FALSE;
     WriteAreaBaseRecord (AreaInfoRecNr,AreaInfo);
END;


{--------------------------------------------------------------------------}
{ CommandAddAll                                                            }
{                                                                          }
{ %+ALL gevonden in het Areafix bericht, en toegestaan door de config      }
{ De huidige gebruiker wordt aangesloten op ALLE gebieden.                 }
{ Er wordt geen lijst gegeven van alle areas die aangesloten worden,       }
{ dit om laden alle area records te voorkomen.                             }
{                                                                          }
PROCEDURE CommandAddAll;

VAR AreaCount,
    AreaLp    : BaseRecordNrType;
    AreaInfo  : AreaBaseRecord;

BEGIN
     AreaCount:=AreaBaseRecCount;

     { het eigenlijke toevoegen }
     FOR AreaLp:=1 TO AreaCount DO
     BEGIN
          ReadAreaBaseRecord (AreaLp,AreaInfo);

          IF (NOT AreaInfo.Deleted) AND TestIfGroupCommon (AreaInfo.IsInGroups,UserInfo.Groups) THEN
          BEGIN
               CheckIfAreaHasToGoNonePassive (AreaInfo,AreaLp);

               AddAreaToUserSubscrToList (UserInfo,AreaLp);
               WriteUserBaseRecord (UserInfoRecNr,UserInfo);

               AddUserToAreaSubscrList (AreaInfo,UserInfoRecNr);
               WriteAreaBaseRecord (AreaLp,AreaInfo);

               IF (UserInfo.System IN [_U,_SOUP]) THEN
                  MsgsAddLineTo (Body,'  '+GetLang1 (2000,AreaInfo.AreaName_U))
               ELSE
                   MsgsAddLineTo (Body,'  '+GetLang1 (2000,AreaInfo.AreaName_F));
          END;
     END; { for }
END;


{--------------------------------------------------------------------------}
{ CommandDelAll                                                            }
{                                                                          }
{ %-ALL gevonden in het Areafix bericht, en toegestaan door de config      }
{ De huidige gebruiker wordt afgesloten van ALLE gebieden.                 }
{ Er wordt geen lijst gegeven van alle areas die aangesloten worden,       }
{ dit om laden alle area records te voorkomen.                             }
{                                                                          }
{ RWI 960121: re-write. Loop nu de lijst van aangesloten areas voor deze   }
{             user af, in plaats van alle areas en dan kijken of de user   }
{             aangesloten is.                                              }
{                                                                          }
PROCEDURE CommandDelAll;

VAR Search   : SubscrSearchRecord;
    AreaInfo : AreaBaseRecord;

BEGIN
     GetFirstAreaUserIsSubscribedTo (UserInfo.AreaList,Search);

     WHILE (Search.Found) DO
     BEGIN
          RemoveAreaFromUserSubscrToList (UserInfo,Search.AreaBaseRecordNr);

          ReadAreaBaseRecord (Search.AreaBaseRecordNr,AreaInfo);
          RemoveUserFromAreaSubscrList (AreaInfo,UserInfoRecNr);
          WriteAreaBaseRecord (Search.AreaBaseRecordNr,AreaInfo);

          CheckIfAreaCanGoPassive (AreaInfo,Search.AreaBaseRecordNr);

          IF (UserInfo.System IN [_U,_SOUP]) THEN
             MsgsAddLineTo (Body,'  '+GetLang1 (2001,AreaInfo.AreaName_U))
          ELSE
              MsgsAddLineTo (Body,'  '+GetLang1 (2001,AreaInfo.AreaName_F));

          GetNextAreaUserIsSubscribedTo (Search);
     END;

     WriteUserBaseRecord (UserInfoRecNr,UserInfo);

(* oud... wordt nu vanaf user perspectief afgesloten
VAR AreaCount,
    AreaLp    : BaseRecordNrType;
    AreaInfo  : AreaBaseRecord;

BEGIN
     AreaCount:=AreaBaseRecCount;

     { Het eigenlijke verwijderen }
     FOR AreaLp:=1 TO AreaCount DO
     BEGIN
          ReadAreaBaseRecord (AreaLp,AreaInfo);

          IF (NOT AreaInfo.Deleted) AND ((AreaInfo.IsInGroups AND UserInfo.Groups) > 0) THEN
          BEGIN
               RemoveAreaFromUserSubscrToList (UserInfo,AreaLp);
               WriteUserBaseRecord (UserInfoRecNr,UserInfo);

               RemoveUserFromAreaSubscrList (AreaInfo,UserInfoRecNr);
               WriteAreaBaseRecord (AreaLp,AreaInfo);

               IF (UserInfo.System = _U) THEN
                  AddToLineBuffer (LineBuffer,'  '+GetLang1 (2001,AreaInfo.AreaName_U))
               ELSE
                   AddToLineBuffer (LineBuffer,'  '+GetLang1 (2001,AreaInfo.AreaName_F));
          END;
     END;
*)
END;


{---------------------------------------------------------------------------}
{ InitQLWindow                                                              }
{                                                                           }
{ Deze routine tekents het window waarin de vooruitgang van de %QUERY en    }
{ %LIST opbouw routines getoond wordt.                                      }
{                                                                           }
PROCEDURE InitQLWindow (Title : STRING);

VAR Lines : BYTE;

BEGIN
     IF (StayQuiet OR NoFullScreen) THEN
        Exit;

     PushKeysLine;
     WriteKeysLine (' Please wait...');

     Lines:=Video.Rows-1{keys line}-(QLYb+QLYl+2{last line+shadow});
     IF (Lines < Log_GetWindowSize) THEN
        Log_SetWindowSize (Lines);

     WindowPush (QLXb,QLYb,QLXl,QLYl);
     BoxDraw (Double,QLXb,QLYb,QLXl,QLYl);

     WriteXY (QLXb+2,QLYb+1,Title);

     WriteXY (QLXb+2,QLYb+3,'[ ] Add header .txt file');
     WriteXY (QLXb+2,QLYb+4,'[ ] Build list of area names');
     WriteXY (QLXb+2,QLYb+5,'[ ] Sort the list');
     WriteXY (QLXb+2,QLYb+6,'[ ] Add listing to message');
     WriteXY (QLXb+2,QLYb+7,'[ ] Add footer .txt file');

     IF (Video.Color) THEN
        ModifyColor (cCustom1,cBlue*16+cWhite+cBlink)
     ELSE
         ModifyColor (cCustom1,mBlack*16+mWhite+mBlink);
END;


{---------------------------------------------------------------------------}
{ InitAreaDataTable                                                         }
{                                                                           }
{ Deze routine vraagt het geheugen aan voor de mapping table waarmee de     }
{ area records straks gesorteerd kunnen worden. Ze bestaan uit het record   }
{ nummer en een pointer naar de naam of een gedeelte daarvan. De geheugen-  }
{ blokken voor de namen worden apart aangevraagd.                           }
{                                                                           }
PROCEDURE InitAreaDataTable (RecCount : WORD; FirstRecNr : WORD; FetchNextRecNr : FetchNextRecNrFunc);

VAR BigBlocks : BYTE;
    LeftOver  : WORD;
    Lp        : WORD;
    AreaName  : STRING;
    MaxHelp   : LONGINT;
    ToCopy    : WORD;
    MaxCopy   : WORD;  { maximum aantal tekens van de AreaRec.AreaName }
                       { die gekopieerd kunnen worden. Wordt continue  }
                       { bijgesteld.                                   }
    StorePos  : WORD;
    PercDone  : BYTE;

BEGIN
     MapAreaRecCount:=RecCount;

     { bereken hoeveel volle blokken van 4096 er nodig zijn }
     { het resultaat van beide berekeningen is 0-based! }
     BigBlocks:=MapAreaRecCount DIV MapRecordsPerArray;
     LeftOver:=MapAreaRecCount MOD MapRecordsPerArray;

     { vraag deze nu allemaal aan }
     IF (BigBlocks > 0) THEN
        FOR Lp:=0 TO BigBlocks-1 DO
            GetMem (AreaDataTable[Lp],SizeOf (MapArray));

     IF (LeftOver <> 0) THEN
        GetMem (AreaDataTable[BigBlocks],SizeOf (MapRecord)*(LeftOver+1));

     NameCount:=1;
     NameLengths[NameCount]:=61440;
     IF ((_MaxAvail-5000) < NameLengths[NameCount]) THEN
        NameLengths[NameCount]:=_MaxAvail-5000;

     GetMem (NamePtrs[NameCount],NameLengths[NameCount]);
     PeekMem;

     StorePos:=1;

     { lees nu alle benodigde gegevens van de areas in }
     FOR Lp:=1 TO RecCount DO
     BEGIN
          { reken uit hoeveel tekens van de area naam van de nog te  }
          { verwerken records er maximaal opgeslagen kunnen worden,  }
          { inclusief de lengte byte. Dit wordt continue bijgesteld, }
          { zodat lange namen dit aantal omlaag brengen en korte     }
          { namen dit aantal omhoog halen.                           }

          { de berekening is als volgt: het geheugen dat nog vrij is, }
          { plus het geheugen dat we nog vrij hebben maar al wel      }
          { aangevraag hebben en dat gedeeld door het aantal records  }
          { dat we nog moeten verwerken.                              }

          { RWI 950910: mogelijke probleem veroorzaker uitgeschakeld...
                        nu wordt gewoon altijd de formule gebruikt.

          IF ((NameLengths[NameCount]-StorePos) > 256) THEN
             MaxCopy:=256
          ELSE BEGIN
          }
               MaxHelp:=((_MemAvail-5000)+(NameLengths[NameCount]-StorePos)) DIV (MapAreaRecCount-Lp+1);
               IF (MaxHelp > 256) THEN
                  MaxCopy:=256
               ELSE
                   MaxCopy:=MaxHelp;
          {
          END;
          }
          { haal de naam van het volgende record op }
          FetchNextRecNr (FirstRecNr,AreaName);

          IF (NOT (StayQuiet OR NoFullScreen)) AND ((Lp MOD 25) = 1) THEN
          BEGIN
               PercDone:=Round ((Lp/MapAreaRecCount)*100);
               WriteXYC (QLXb2,QLYb+4,cBoxData,Word2String (Lp)+'/'+Word2String (MapAreaRecCount)+
                                               ' ('+Byte2String (PercDone)+'%)');
          END;

          WITH AreaDataTable[Lp DIV MapRecordsPerArray]^[Lp MOD MapRecordsPerArray] DO
          BEGIN
               RecNr:=FirstRecNr;

               ToCopy:=Length (AreaName)+1{lengte byte};
               IF (ToCopy > MaxCopy) THEN
                  ToCopy:=MaxCopy;

               { kijk of er nog ruimte genoeg voor is }
               IF ((NameLengths[NameCount]-StorePos) < ToCopy) THEN
               BEGIN
                    { naam, vraag een nieuw geheugen blok aan, }
                    { zo groot mogelijk.                       }
                    Inc (NameCount);

                    NameLengths[NameCount]:=61440;
                    IF ((_MaxAvail-5000) < NameLengths[NameCount]) THEN
                       NameLengths[NameCount]:=_MaxAvail-5000;

                    GetMem (NamePtrs[NameCount],NameLengths[NameCount]);
                    PeekMem;

                    StorePos:=1;
               END;

               NamePtr:=Addr (NamePtrs[NameCount]^[StorePos]);

               Move (AreaName,NamePtr^,ToCopy);

               Inc (StorePos,ToCopy);
          END; { with }

     END; { for }

     IF (NOT (StayQuiet OR NoFullScreen)) THEN
        WriteXYC (QLXb2,QLYb+4,cBoxData,Word2String (MapAreaRecCount)+' records, '+
                                        Longint2String (_MemAvail DIV 1024)+'Kb free');
END;


{--------------------------------------------------------------------------}
{ DestroyAreaDataTable                                                     }
{                                                                          }
{ Deze routine ruimt de AreaDataTable en NameBlocks weer op door al het    }
{ geheugen weer vrij te gegeven.                                           }
{                                                                          }
PROCEDURE DestroyAreaDataTable;

VAR Lp,
    BigBlocks,
    LeftOver  : BYTE;

BEGIN
     { het resultaat van beide berekeningen is 0-based! }
     BigBlocks:=MapAreaRecCount DIV MapRecordsPerArray;
     LeftOver:=MapAreaRecCount MOD MapRecordsPerArray;

     IF (BigBlocks > 0) THEN
        FOR Lp:=0 TO BigBlocks-1 DO
            FreeMem (AreaDataTable[Lp],SizeOf (MapArray));

     IF (LeftOver <> 0) THEN
        FreeMem (AreaDataTable[BigBlocks],SizeOf (MapRecord)*(LeftOver+1));

     { geef nu de geheugen blokken vrij waarin de namen opgeslagen }
     { staan. Dit doen we nadat de pointers naar deze blokken      }
     { verwijderd zijn.                                            }
     FOR Lp:=1 TO NameCount DO
         FreeMem (NamePtrs[Lp],NameLengths[Lp]);

     NameCount:=0;
END;


{--------------------------------------------------------------------------}
{ SortAreaData                                                             }
{                                                                          }
{ Deze routine sorteert de lijst met areas aan de hand van de gegevens die }
{ in AreaDataTable beschikbaar zijn.                                       }
{ Hier wordt gebruik gemaakt van domme oude BubbleSort. Voornamelijk       }
{ omdat we niet zoveel geheugen vrij hebben. InsertionSort zou ook nog     }
{ kunnen, maar het is niet echt een heap structuur, dus inserten kan       }
{ nogal wat overhead veroorzaken.                                          }
{                                                                          }
PROCEDURE SortAreaData;

VAR Lp1,
    Lp2      : WORD;
    PercDone : BYTE;
    SwapRec  : MapRecord;
    SPtr,                        { smallest }
    T1Ptr,
    T2Ptr    : MapRecordPtr;
    DidRecS  : BOOLEAN;
    RecS,
    Rec2     : AreaBaseRecord;

BEGIN
     IF (MapAreaRecCount < 1) THEN
     BEGIN
          IF (NOT (StayQuiet OR NoFullScreen)) THEN
             WriteXYC (QLXb2,QLYb+5,cBoxData,'No work');
          Exit; { nothing to sort }
     END;

     { quickly check to see if the whole thing is already sorted }
     T1Ptr:=Addr (AreaDataTable[0]^[1]);
     FOR Lp1:=2 TO MapAreaRecCount DO
     BEGIN
          T2Ptr:=Addr (AreaDataTable[Lp1 DIV MapRecordsPerArray]^[Lp1 MOD MapRecordsPerArray]);

          IF (T1Ptr^.NamePtr^ >= T2Ptr^.NamePtr^) THEN
          BEGIN
               { een verschil is gevonden! }
               T1Ptr:=NIL;
               Break;
          END;
     END;

     IF (T1Ptr <> NIL) THEN
     BEGIN
          IF (NOT (StayQuiet OR NoFullScreen)) THEN
             WriteXYC (QLXb2,QLYb+5,cBoxData,'Already sorted');
          Exit;
     END;

     FOR Lp1:=1 TO MapAreaRecCount-1 DO
     BEGIN
          T1Ptr:=Addr (AreaDataTable[Lp1 DIV MapRecordsPerArray]^[Lp1 MOD MapRecordsPerArray]);
          SPtr:=T1Ptr;

          DidRecS:=FALSE; { nog niet van disk geladen }

          { ga op zoek naar het kleinste record }

          FOR Lp2:=Lp1+1 TO MapAreaRecCount DO
          BEGIN
               T2Ptr:=Addr (AreaDataTable[Lp2 DIV MapRecordsPerArray]^[Lp2 MOD MapRecordsPerArray]);

               IF (T2Ptr^.NamePtr^ <= SPtr^.NamePtr^) THEN
               BEGIN
                    IF (T2Ptr^.NamePtr^ < SPtr^.NamePtr^) THEN
                    BEGIN
                         SPtr:=T2Ptr;
                         DidRecS:=FALSE; { er is nu een nieuwe }
                    END ELSE
                    BEGIN
                         { ze zijn gelijk, dus we moeten op disk kijken }
                         { voor de zekerheid.                           }

                         IF (NOT DidRecS) THEN
                         BEGIN
                              ReadAreaBaseRecord (SPtr^.RecNr,RecS);
                              DidRecS:=TRUE;
                         END;

                         ReadAreaBaseRecord (T2Ptr^.RecNr,Rec2);

                         { Nu nog eens vergelijken of ie echt kleiner is   }
                         { PS: NOOIT vergelijken tegen wat er het geheugen }
                         {     staat, want daar zit de GroupCh bij in!!    }
                         IF (Rec2.AreaName_F < RecS.AreaName_F) THEN
                         BEGIN
                              { ja! Het is echt. deze is vanaf nu de kleinste }
                              SPtr:=T2Ptr;
                              RecS:=Rec2; { DidRecS blijft TRUE }
                         END; { echt swappen }
                    END; { disk controle }
               END; { uberhaupt mogelijk kleiner }
          END; { for 2 }

          { als we een kleinere gevonden hebben, ze die dan op deze positie }
          IF (SPtr <> T1Ptr) THEN
          BEGIN
               SwapRec:=T1Ptr^;
               T1Ptr^:=SPtr^;
               SPtr^:=SwapRec;
          END;

          IF (NOT (StayQuiet OR NoFullScreen)) THEN
          BEGIN
               PercDone:=Round (Lp1/MapAreaRecCount*100);
               WriteXYC (QLXb2,QLYb+5,cBoxData,Word2String (Lp1)+'/'+Word2String (MapAreaRecCount)+
                                               ' ('+Byte2String (PercDone)+'%)');
          END;
     END; { for 1 }

     IF (NOT (StayQuiet OR NoFullScreen)) THEN
        WriteXYC (QLXb2,QLYb+5,cBoxData,Word2String (MapAreaRecCount)+'/'+Word2String (MapAreaRecCount)+' (100%)');
END;


{---------------------------------------------------------------------------}
{ FreeUpNameTables                                                          }
{                                                                           }
{ Deze routine maakt wat geheugen vrij door de Name tables vrij te geven.   }
{ Maar... het eerste teken van de naam bevat de groep waarin deze area zit  }
{ en die moet bewaard worden. Dus, gebruiken we een variant record en       }
{ stoppen we deze group code over de pointer heen. Daarna zijn alle         }
{ pointers niet meer te gebruiken en kunnen de Name tables vrij gegeven     }
{ worden.                                                                   }
{                                                                           }
PROCEDURE FreeUpNameTables;

VAR Lp     : WORD;
    MapPtr : MapRecordPtr;

BEGIN
     FOR Lp:=1 TO MapAreaRecCount DO
     BEGIN
          MapPtr:=Addr (AreaDataTable[Lp DIV MapRecordsPerArray]^[Lp MOD MapRecordsPerArray]);

          { kopieer de groep code }
          MapPtr^.Group:=Copy (MapPtr^.NamePtr^,1,2);
     END; { for }

     { geef nu de geheugen blokken vrij waarin de namen opgeslagen staan }
     FOR Lp:=1 TO NameCount DO
         FreeMem (NamePtrs[Lp],NameLengths[Lp]);

     NameCount:=0;
END;


{---------------------------------------------------------------------------}
{ AddAreaDataTableToMessage                                                 }
{                                                                           }
{ Deze routine voegt de gesorteerde lijst met areas toe aan het bericht dat }
{ naar de user gaat.                                                        }
{                                                                           }
PROCEDURE AddAreaDataTableToMessage (AddPlus : BOOLEAN);

    {-----------------------------------------------------------------------}
    { AddArea                                                               }
    {                                                                       }
    { Deze routine voegt een area aan de output toe. Hierbij wordt de       }
    { area naam gevolgd door de area description genomen. Dit kan een of    }
    { meerdere regels innemen, afhankelijk van de lengte van de areaname en }
    { description.                                                          }
    { Nodig: AreaRec, UserInfo.System                                       }
    {                                                                       }
    PROCEDURE AddArea (AreaRecNr : AreaBaseRecordNrType);

    VAR HulpStr : STRING;
        AName   : STRING[MaxLenAreaName+1];
        ZoekPos : BYTE;
        AreaRec : AreaBaseRecord;

    BEGIN
         ReadAreaBaseRecord (AreaRecNr,AreaRec);
         HulpStr:=DeleteFrontAndBackSpaces (AreaRec.Comment);

         IF (UserInfo.System = _F) THEN
            AName:=AreaRec.AreaName_F
         ELSE
             AName:=AreaRec.AreaName_U;

         IF AddPlus THEN
         BEGIN
              IF TestIfAreaIsInUserRec_AreaList (UserInfo.AreaList,AreaRecNr) THEN
                 AName:='+'+AName
              ELSE
                  AName:=' '+AName;
         END;

         IF (HulpStr = '') THEN
            MsgsAddLineTo (Body,AName)
         ELSE BEGIN
             { commentaar erachter plaatsen als de areaname }
             { kleiner is dan 30 tekens, anders commentaar  }
             { op de volgende regel zetten.                 }
             IF (Length (AName) <= 30) THEN
             BEGIN
                  { als er een commentaar regel is, dan toevoegen }
                  HulpStr:=AddUpWithSpaces (30,AName)+' - '+HulpStr;

                  { lijn splitsen bij te lang }
                  IF (Length (HulpStr) > 75) THEN
                  BEGIN
                       ZoekPos:=75;
                       WHILE (ZoekPos > 33) AND (HulpStr[ZoekPos] <> ' ') DO
                             Dec (ZoekPos);

                       IF (ZoekPos = 33) THEN
                          ZoekPos:=75;

                       MsgsAddLineTo (Body,DeleteBackSpaces (Copy (HulpStr,1,ZoekPos)));
                       MsgsAddLineTo (Body,Spaces (33)+DeleteFrontSpaces (Copy (HulpStr,ZoekPos+1,255)));
                  END ELSE
                      MsgsAddLineTo (Body,HulpStr);
             END ELSE
             BEGIN
                  { Area Name is langer dan 30 tekens, dus }
                  { commentaar begint pas op de volgende   }
                  { regel. Als er commentaar is tenminste  }
                  MsgsAddLineTo (Body,AName);

                  HulpStr:=Spaces (31)+'- '+HulpStr;
                  IF (Length (HulpStr) > 75) THEN
                  BEGIN
                       { te lang voor op 1 regel, dus maken }
                       { we er twee regels van.             }
                       ZoekPos:=75;
                       WHILE (ZoekPos > 33) AND (HulpStr[ZoekPos] <> ' ') DO
                             Dec (ZoekPos);

                       IF (ZoekPos = 33) THEN
                          ZoekPos:=75;

                       MsgsAddLineTo (Body,DeleteBackSpaces (Copy (HulpStr,1,ZoekPos)));
                       MsgsAddLineTo (Body,Spaces (33)+DeleteFrontSpaces (Copy (HulpStr,ZoekPos+1,255)));
                  END ELSE
                      MsgsAddLineTo (Body,HulpStr);
             END; { area name langer dan 40 tekens }
         END; { commentaar toevoegen }
    END;

{AddAreaDataTableToMessage}
VAR GroupLp     : GroupNrType;
    Group       : STRING[2];
    GroupAny    : BOOLEAN; { area gevonden in deze group? }
    Lp          : WORD;
    AreaPtr     : MapRecordPtr;
    GroupRec    : GroupDescRecord;
    HulpStr     : STRING;

BEGIN
     FOR GroupLp:=1 TO MaxGroups DO
     BEGIN
          IF (NOT TestIfInGroup (UserInfo.Groups,GroupLp)) THEN
             Continue; { group mag ie niet in, sla maar over }

          Group:=BuildSingleGroupDesc (GroupLp);

          ReadGroupDescRecord (GroupLp,GroupRec);

          HulpStr:=GetLang2 (2002,Group,DeleteBackSpaces (GroupRec.GroupDesc));
          IF GroupRec.ReadOnly THEN
             HulpStr:=HulpStr+' ['+GetLang0 (2003)+']';

          MsgsAddLineTo (Body,'');
          MsgsAddLineTo (Body,HulpStr);
          MsgsAddLineTo (Body,'');

          { nu de lijst met areas toevoegen }
          GroupAny:=FALSE;
          FOR Lp:=1 TO MapAreaRecCount DO
          BEGIN
               AreaPtr:=Addr (AreaDataTable[Lp DIV MapRecordsPerArray]^[Lp MOD MapRecordsPerArray]);

               { Niet zeker of de RecNr wel gecontroleerd en op NIL gezet hoeft te worden }
               IF (AreaPtr^.Group = Group) AND
                  (AreaPtr^.RecNr <> NILRecordNr) THEN
               BEGIN
                    { deze area toevoegen aan de lijst }
                    AddArea (AreaPtr^.RecNr);

                    AreaPtr^.RecNr:=NILRecordNr; { is nu verwerkt }
                    AreaPtr^.Group:=''; { versnelt check hierboven }

                    GroupAny:=TRUE; { RWI 950910 }
               END;

          END; { areadata loop }

          IF (NOT GroupAny) THEN
             MsgsAddLineTo (Body,GetLang0 (2004));

     END; { group loop }
END;


{--------------------------------------------------------------------------}
{ ListFetchNextRecNr                                                       }
{                                                                          }
{ Deze routine geeft het volgende record nummer terug.                     }
{                                                                          }
PROCEDURE ListFetchNextRecNr (VAR RecNr : WORD; VAR AreaName : STRING); FAR;

VAR AreaRec   : AreaBaseRecord;
    Test,
    Filter    : GroupFlagType;
    GroupDesc : STRING;
    GroupLp   : GroupNrType;

BEGIN
     { cannot stop; caller knows how many records to ask for }
     REPEAT
           Inc (RecNr);
           ReadAreaBaseRecord (RecNr,AreaRec);
     UNTIL (NOT AreaRec.Deleted) AND
           (AreaRec.AreaType = Area_Echo) AND
           TestIfGroupCommon (AreaRec.IsInGroups,UserInfo.Groups);

     { welke groepen waar de area in zit zijn van belang voor deze user? }
     CreateCommonGroup (Filter,AreaRec.IsInGroups,UserInfo.Groups);

     { zit er bij deze groepen ook een read/write groep? }
     CreateCommonGroup (Test,Filter,ReadWriteGroupsFilter);
     IF (NOT TestGroupListIsEmpty (Test)) THEN
        Filter:=Test;

     { de eerste area in Filter wordt de groep waar deze area in komt }
     GroupDesc:='?'; { error etc. }
     FOR GroupLp:=1 TO MaxGroups DO
         IF TestIfInGroup (Filter,GroupLp) THEN
         BEGIN
              GroupDesc:=BuildSingleGroupDesc (GroupLp);
              Break;
         END;

     IF (UserInfo.System = _F) THEN
        AreaName:=GroupDesc+AreaRec.AreaName_F
     ELSE
         AreaName:=GroupDesc+AreaRec.AreaName_U;
END;


{--------------------------------------------------------------------------}
{ AreaCountUser_Can_Subscribe                                              }
{                                                                          }
{ Deze routine geeft het aantal records terug waar deze user toegang tot   }
{ heeft. Helaas moet de hele areabase daarvoor doorlopen worden, maar ja.. }
{                                                                          }
FUNCTION AreaCountUser_Can_Subscribe : WORD;

VAR Lp,
    Count   : WORD;
    AreaRec : AreaBaseRecord;

BEGIN
     Count:=0;

     FOR Lp:=1 TO AreaBaseRecCount DO
     BEGIN
          ReadAreaBaseRecord (Lp,AreaRec);

          IF (NOT AreaRec.Deleted) AND
             (AreaRec.AreaType = Area_Echo) AND
             TestIfGroupCommon (AreaRec.IsInGroups,UserInfo.Groups)
          THEN
              Inc (Count);
     END;

     AreaCountUser_Can_Subscribe:=Count;
END;


{--------------------------------------------------------------------------}
{ BuildList                                                                }
{                                                                          }
{ Deze routine bouwt een lijst op met daarin alle areas die de user aan    }
{ kan sluiten. Ook de al aangesloten areas staan hierin. Deze routine      }
{ wordt zowel voor Fido als voor UUCP gebruikt.                            }
{                                                                          }
PROCEDURE BuildList;
BEGIN
     IF (NoFullScreen) THEN
          WriteLn ('AreaMgr processing %LIST command');

     InitQLWindow ('%LIST progress');

     { Plaats een 'Areafix LiSt Request HeaDeR' aan het begin }
     IF (NOT (StayQuiet OR NoFullScreen)) THEN
        WriteXYC (QLXb+3,QLYb+3,cCustom1,'þ');

     IF (NOT AddFileToBody ('AFLSRHDR.TXT')) THEN
     BEGIN
          MsgsAddLineTo (Body,'You can connect to the following areas:');
          IF (NOT (StayQuiet OR NoFullScreen)) THEN
             WriteXYC (QLXb2,QLYb+3,cBoxData,'System line');
     END ELSE
         IF (NOT (StayQuiet OR NoFullScreen)) THEN
            WriteXYC (QLXb2,QLYb+3,cBoxData,'AFLSRHDR.TXT');

     IF (NOT (StayQuiet OR NoFullScreen)) THEN
        WriteXY (QLXb+3,QLYb+3,'û');

     { initialise the table with name }
     IF (NOT (StayQuiet OR NoFullScreen)) THEN
        WriteXYC (QLXb+3,QLYb+4,cCustom1,'þ');

     InitAreaDataTable (AreaCountUser_Can_Subscribe,0,ListFetchNextRecNr);

     IF (NOT (StayQuiet OR NoFullScreen)) THEN
        WriteXYC (QLXb+3,QLYb+4,cBoxData,'û');

     { sort the table }
     IF (NOT (StayQuiet OR NoFullScreen)) THEN
        WriteXYC (QLXb+3,QLYb+5,cCustom1,'þ');

     SortAreaData;

     IF (NOT (StayQuiet OR NoFullScreen)) THEN
        WriteXYC (QLXb+3,QLYb+5,cBoxData,'û');

     { add it to the message }
     IF (NOT (StayQuiet OR NoFullScreen)) THEN
        WriteXYC (QLXb+3,QLYb+6,cCustom1,'þ');

     FreeUpNameTables; { maakt ruimte voor het bericht }

     AddAreaDataTableToMessage (TRUE);

     IF (NOT (StayQuiet OR NoFullScreen)) THEN
        WriteXYC (QLXb+3,QLYb+6,cBoxData,'û');

     DestroyAreaDataTable;

     { Voeg een 'Areafix LiSt Request Footer' toe ...          }
     { MD : Hoe verklaren we die afkortingen in de manual ???? }
     { MD : Doen we niet... we laten ze raden <gna gna gna>    }
     IF (NOT (StayQuiet OR NoFullScreen)) THEN
        WriteXYC (QLXb+3,QLYb+7,cCustom1,'þ');

     IF (NOT AddFileToBody ('AFLSRFTR.TXT')) THEN
     BEGIN
          MsgsAddLineTo (Body,'');
          MsgsAddLineTo (Body,'-- All '+Word2String (MapAreaRecCount)+' available areas listed');
          MsgsAddLineTo (Body,'');

          IF (NOT (StayQuiet OR NoFullScreen)) THEN
             WriteXYC (QLXb2,QLYb+7,cBoxData,'System line');
     END ELSE
         IF (NOT (StayQuiet OR NoFullScreen)) THEN
            WriteXYC (QLXb2,QLYb+7,cBoxData,'AFLSRFTR.TXT');

     IF (NOT (StayQuiet OR NoFullScreen)) THEN
        WriteXY (QLXb+3,QLYb+7,'û');

     IF (NOT (StayQuiet OR NoFullScreen)) THEN
     BEGIN
          WindowPop;
          PopKeysLine;
     END;
END;


{--------------------------------------------------------------------------}
{ QueryFetchNextRecNr                                                      }
{                                                                          }
PROCEDURE QueryFetchNextRecNr (VAR RecNr : WORD; VAR AreaName : STRING); FAR;

VAR AreaRec   : AreaBaseRecord;
    Test,
    Filter    : GroupFlagType;
    GroupDesc : STRING;
    GroupLp   : GroupNrType;

BEGIN
     IF (RecNr = NILRecordNr) THEN
        GetFirstAreaUserIsSubscribedTo (UserInfo.AreaList,QuerySearch)
     ELSE
         GetNextAreaUserIsSubscribedTo (QuerySearch);

     RecNr:=QuerySearch.AreaBaseRecordNr;
     ReadAreaBaseRecord (RecNr,AreaRec);

     { welke groepen waar de area in zit zijn van belang voor deze user? }
     CreateCommonGroup (Filter,AreaRec.IsInGroups,UserInfo.Groups);

     { zit er bij deze groepen ook een read/write groep? }
     CreateCommonGroup (Test,Filter,ReadWriteGroupsFilter);
     IF (NOT TestGroupListIsEmpty (Test)) THEN
        Filter:=Test;

     { de eerste area in Filter wordt de groep waar deze area in komt }
     GroupDesc:='?'; { error }
     FOR GroupLp:=1 TO MaxGroups DO
         IF TestIfInGroup (Filter,GroupLp) THEN
         BEGIN
              GroupDesc:=BuildSingleGroupDesc (GroupLp);
              Break;
         END;

     { RWI 950916: added GroupCh as first character }
     IF (UserInfo.System = _F) THEN
        AreaName:=GroupDesc+AreaRec.AreaName_F
     ELSE
         AreaName:=GroupDesc+AreaRec.AreaName_U;
END;


{--------------------------------------------------------------------------}
{ BuildQuery                                                               }
{                                                                          }
{ Deze routine bouwt een lijst op met daarin alle areas die de user aan    }
{ kan sluiten. Deze routine wordt zowel voor Fido als voor UUCP gebruikt.  }
{                                                                          }
PROCEDURE BuildQuery;
BEGIN
     IF (NoFullScreen) THEN
          WriteLn ('AreaMgr processing %QUERY command');

     InitQLWindow ('%QUERY progress');

     { Plaats een 'Areafix QueRy Request HeaDeR' aan het begin }
     IF (NOT (StayQuiet OR NoFullScreen)) THEN
        WriteXYC (QLXb+3,QLYb+3,cCustom1,'þ');

     IF (NOT AddFileToBody ('AFQRRHDR.TXT')) THEN
     BEGIN
          MsgsAddLineTo (Body,'You are connected to the following areas:');

          IF (NOT (StayQuiet OR NoFullScreen)) THEN
             WriteXYC (QLXb2,QLYb+3,cBoxData,'System line');
     END ELSE
         IF (NOT (StayQuiet OR NoFullScreen)) THEN
            WriteXYC (QLXb2,QLYb+3,cBoxData,'AFQRRHDR.TXT');

     IF (NOT (StayQuiet OR NoFullScreen)) THEN
        WriteXY (QLXb+3,QLYb+3,'û');

     IF (NOT (StayQuiet OR NoFullScreen)) THEN
        WriteXYC (QLXb+3,QLYb+4,cCustom1,'þ');

     InitAreaDataTable (CountSubscribedAreas (UserInfo.AreaList),NILRecordNr,QueryFetchNextRecNr);

     IF (NOT (StayQuiet OR NoFullScreen)) THEN
        WriteXYC (QLXb+3,QLYb+4,cBoxData,'û');

     IF (NOT (StayQuiet OR NoFullScreen)) THEN
        WriteXYC (QLXb+3,QLYb+5,cCustom1,'þ');

     SortAreaData;

     IF (NOT (StayQuiet OR NoFullScreen)) THEN
        WriteXYC (QLXb+3,QLYb+5,cBoxData,'û');

     IF (NOT (StayQuiet OR NoFullScreen)) THEN
        WriteXYC (QLXb+3,QLYb+6,cCustom1,'þ');

     FreeUpNameTables; { maakt ruimte om het bericht op te bouwen }

     AddAreaDataTableToMessage (FALSE);

     IF (NOT (StayQuiet OR NoFullScreen)) THEN
        WriteXYC (QLXb+3,QLYb+6,cBoxData,'û');

     DestroyAreaDataTable;

     { Plaats een 'Areafix QueRy Request FooTeR' aan het einde }
     IF (NOT (StayQuiet OR NoFullScreen)) THEN
        WriteXYC (QLXb+3,QLYb+7,cCustom1,'þ');

     IF (NOT AddFileToBody ('AFQRRFTR.TXT')) THEN
     BEGIN
          MsgsAddLineTo (Body,'');
          MsgsAddLineTo (Body,'-- All '+Word2String (MapAreaRecCount)+' connected areas listed');
          MsgsAddLineTo (Body,'');

          IF (NOT (StayQuiet OR NoFullScreen)) THEN
             WriteXYC (QLXb2,QLYb+3,cBoxData,'System line');
     END ELSE
         IF (NOT (StayQuiet OR NoFullScreen)) THEN
            WriteXYC (QLXb2,QLYb+7,cBoxData,'AFQRRFTR.TXT');

     IF (NOT (StayQuiet OR NoFullScreen)) THEN
     BEGIN
          WriteXY (QLXb+3,QLYb+7,'û');
          WindowPop;
          PopKeysLine;
     END;
END;

{ Areafix rescanning }
VAR
    DoRescan  : BOOLEAN;                     { %RESCAN has ben found? }
    RescanDays: WORD;                        { #days to rescan        }
    RescanMsgs: WORD;                        { Max msgs to rescan     }


{---------------------------------------------------------------------------}
{ ProcessFixLine                                                            }
{                                                                           }
{ Deze routine verwerkt een areafix/newsfix regel. Eindelijk worden ze dan  }
{ door e'e'n routine verwerkt.                                              }
{                                                                           }
PROCEDURE ProcessFixLine (Regel : STRING);

    PROCEDURE SendResponse (Response : STRING);
    BEGIN
         Response:='  '+Response;

         IF Config.LogAreaFix THEN
            LogExtraMessage (Response);

         MsgsAddLineTo (Body,Response);
    END;

VAR Keyword  : STRING;
    ComprLp  : CompressionType;

    AreaLp   : AreaBaseRecordNrType;
    AreaRec  : AreaBaseRecord;

    GroupCh  : CHAR;
    GroupLp  : GroupDescBaseRecordNrType;
    GroupRec : GroupDescRecord;

    RulesPtr : ^AreaBaseRecordNrType;

    I        : ValNop;

BEGIN
     { er kunnen meerdere enters staan zodra ik in de toekomst een lege }
     { enter aan de vorige regel plak bij het importeren...             }
     WHILE (Regel <> '') AND (Regel[Length (Regel)] = #13) DO
           Delete (Regel,Length (Regel),1);

     Regel:=DeleteFrontAndBackSpaces (Regel);

     IF (Regel = '') THEN
        Exit;

     MsgsAddLineTo (Body,'--> '+Regel);

     IF Config.LogAreaFix THEN
        LogMessage (liTrivial,'--> '+Regel);

     Regel:=UpCaseString (Regel);

     { Als de regel met een % begint is het een commando optie }
     IF (Regel[1] = '%') THEN
     BEGIN
          (*
          IF (Pos ('%FROM',TempInfo) = 1) THEN
          BEGIN
               IF (NOT UserInfo.AllowFrom) THEN
               BEGIN
                    MsgsAddLineTo (Body,'  Access denied');
                    Exit;
               END;

               IF (UserInfo.System = _F) THEN
               BEGIN
                    (*
                    TempInfo:=Copy (TempInfo,6,Length (TempInfo));
                    TempInfo:=DeleteFrontSpaces (TempInfo);
                    FidoSplit (TempInfo,CurrentFromAddress);

                    { Probeer het bijbehorende record te lezen }
                    IF (NOT FindUserBaseRecordByFidoAddress (CurrentFromAddress,UserInfoRecNr)) THEN
                    BEGIN
                         MsgsAddLineTo (Body,'Unknown %FROM adress ('+TempInfo+'), ignoring commands');
                         MsgsAddLineTo (Body,'until an other %FROM command is found.');
                         IgnoreCommand:=TRUE;
                    END ELSE
                    BEGIN
                         MsgsAddLineTo (Body,'Now processing commands for '+TempInfo);
                         ReadUserBaseRecord (UserInfoRecNr,UserData);
                         IgnoreCommand:=FALSE;
                    END;
                    * )

                    AddToLineBuffer ('  Not implemented yet, sorry');
                    Exit; { ## EXIT ## }
               END ELSE
               BEGIN
                    { uucp }
                    (*
                    BadFrom:=TRUE;
                    FOR FLp:=1 TO UserBaseRecCount DO
                    BEGIN
                         ReadUserBaseRecord (FLp,FromData);

                         IF (NOT FromData.Deleted) AND (UpcaseString(FromData.UUCPName)=REGEL) THEN
                                 BadFrom:=FALSE; { found }

                         IF (NOT BadFrom) THEN Break; { for }
                    END; { for ULp }

                    IF BadFrom THEN
                    BEGIN
                         MsgsAddLineTo (Header_F,'  System '+Regel+' not found!');
                         MsgsAddLineTo (Header_F,'  Rest of newsfix will be skipped for protection reasons,');
                         MsgsAddLineTo (Header_F,'  until an other %FROM command.');
                    END ELSE
                    BEGIN
                         MsgsAddLineTo (Header_F,'  Further processing will be as '+FromData.UUCPName);

                         WriteUserBaseRecord (ULp,MgrUserData); { pff.. }
                         MgrUserData:=FromData;
                         ULp:=FLp;
                    END;
                    * )

                    AddToLineBuffer ('  Not implemented yet, sorry');
                    Exit; { ## EXIT ## }
               END;
          END;
          *)

          IF IgnoreCommand THEN
          BEGIN
               { er is een verkeerde %FROM geweest }
               SendResponse ('Ignoring');
               Exit; { ## EXIT ## }
          END;

          IF (Regel = '%HELP') THEN
          BEGIN
               {Help will follow in an other message}
               SendResponse (GetLang0 (2005));
               RequestedHelp:=TRUE;
               Exit; { ## EXIT ## }
          END;

          IF (Regel = '%QUERY') THEN
          BEGIN
               {The query listing will follow in an other message');}
               SendResponse (GetLang0 (2006));
               RequestedQuery:=TRUE;
               Exit; { ## EXIT ## }
          END;

          IF (Regel = '%LIST') THEN
          BEGIN
               {The listing will follow in an other message');}
               SendResponse (GetLang0 (2007));
               RequestedList:=TRUE;
               Exit; { ## EXIT ## }
          END;

          IF (Regel = '%+ALL') THEN
          BEGIN
               CommandAddAll;
               Exit; { ## EXIT ## }
          END;

          IF (Regel = '%-ALL') THEN
          BEGIN
               CommandDelAll;
               Exit; { ## EXIT ## }
          END;

          IF (Regel = '%LISTNEW') THEN
          BEGIN
               IF (NOT UserInfo.AllowFrom) THEN
               BEGIN
                    SendResponse ('Access denied');
                    Exit; { ## EXIT ## }
               END;

               SendResponse ('Listing of new areas in group Z1:');

               FOR AreaLp:=1 TO AreaBaseRecCount DO
               BEGIN
                    ReadAreaBaseRecord (AreaLp,AreaRec);

                    IF (UserInfo.System <> _F) THEN
                       AreaRec.AreaName_F:=AreaRec.AreaName_U;

                    IF (NOT AreaRec.Deleted) AND TestIfInGroup (AreaRec.IsInGroups,Group_NewAreas) THEN
                       SendResponse ('  '+AreaRec.AreaName_F);
               END;

               SendResponse ('End of listing');
               Exit; { ## EXIT ## }
          END;

          IF (Regel = '%GROUPS') THEN
          BEGIN
               IF (NOT UserInfo.AllowFrom) THEN
               BEGIN
                    SendResponse ('Access denied');
                    Exit; { ## EXIT ## }
               END;

               SendResponse ('Listing of all groups:');

               FOR GroupLp:=1 TO MaxGroups DO
               BEGIN
                    ReadGroupDescRecord (GroupLp,GroupRec);

                    SendResponse (BuildSingleGroupDesc (GroupLp)+' '+DeleteBackSpaces (GroupRec.GroupDesc));
                    SendResponse (' Origin AKA: '+Fido2Str (Config.NodeNrs[GroupRec.OriginAka]));

                    IF (GroupRec.Readonly) THEN
                       SendResponse ('  '+GetLang0 (2036));
               END;

               SendResponse ('End of groups listing');
               Exit; { ## EXIT ## }
          END;

          IF (Regel = '%PASSIVE') OR (Regel = '%DISABLE') THEN
          BEGIN
               IF (NOT UserInfo.Passive) THEN
               BEGIN
                    UserInfo.Passive:=TRUE;
                    WriteUserBaseRecord (UserInfoRecNr,UserInfo);

                    {Your system is now PASSIVE');}
                    SendResponse (GetLang1 (2008,'PASSIVE'));
               END ELSE
                    {Your system was PASSIVE already');}
                    SendResponse (GetLang1 (2009,'PASSIVE'));

               Exit; { ## EXIT ## }
          END;

          IF (Regel = '%ACTIVE') OR (Regel = '%ENABLE') THEN
          BEGIN
               IF UserInfo.Passive THEN
               BEGIN
                    UserInfo.Passive:=FALSE;
                    WriteUserBaseRecord (UserInfoRecNr,UserInfo);
                    {Your system is now ACTIVE');}
                    SendResponse (GetLang1 (2008,'ACTIVE'));
               END ELSE
                   {Your system was ACTIVE already');}
                   SendResponse (GetLang1 (2009,'ACTIVE'));

               Exit; { ## EXIT ## }
          END;

          IF (Regel = '%RESCAN') THEN
          BEGIN
               (*
               AreaLp:=GetAreaBaseRecordNrByAreaName_F (Regel);

               IF (AreaLp = NILRecordNr) THEN
               BEGIN
                    SendResponse ('Cannot find an area with that name');
                    Exit; { ## EXIT ## }
               END;

               SendResponse ('Rescanning area '+Regel);

               Rescan_Area (AreaLp,UserInfoRecNr,65535{maxage},20{maxmsgs});
               *)

               { Rescan all subsequent areas }
               DoRescan := TRUE;
               SendResponse ('Rescanning areas listed in message');

               Exit; { ## EXIT ## }
          END;


          IF (Pos (' ',Regel) > 0) THEN
          BEGIN
               Keyword:=Copy (Regel,1,Pos (' ',Regel)-1);
               Delete (Regel,1,Pos (' ',Regel));
          END ELSE
          BEGIN
               { unknown }
               SendResponse (GetLang0 (2010));
               Exit; { ## EXIT ## }
          END;

          IF (Keyword = '%PASSWORD') THEN
          BEGIN
               UserInfo.AreaFixPwd:=UpCaseString (DeleteBackSpaces (Copy (DeleteFrontSpaces (Regel),1,MaxLenAreafixPwd)));
               WriteUserBaseRecord (UserInfoRecNr,UserInfo);

               IF (UserInfo.System = _F) THEN
                  {Your AreaFix password is now set to "'+UserInfo.AreaFixPwd+'"')}
                  SendResponse (GetLang2 (2011,Config.AreafixNames[1],UserInfo.AreaFixPwd))
               ELSE
                   SendResponse (GetLang2 (2011,Config.NewsfixName,UserInfo.AreaFixPwd));

               Exit; { ## EXIT ## }
          END;

          IF (Keyword = '%PACKETPWD') OR (Keyword = '%PKTPWD') THEN
          BEGIN
               IF (UserInfo.System <> _F) THEN
               BEGIN
                    { unknown }
                    SendResponse (GetLang0 (2010));
                    Exit; { ## EXIT ## }
               END;

               { gebruik DeleteBackSpaces om bij een zin met woorden die }
               { afkapt wordt geen spaties over te houden.               }
               UserInfo.PacketPwd:=DeleteBackSpaces (Copy (DeleteFrontSpaces (Regel),1,8));
               WriteUserBaseRecord (UserInfoRecNr,UserInfo);

               SendResponse (GetLang1 (2012,UserInfo.PacketPwd));

               Exit; { ## EXIT ## }
          END;

          IF (Keyword = '%COMPRESS') THEN
          BEGIN
               IF (UserInfo.System = _F) THEN
               BEGIN
                    {## can no longer select no compression}
                    FOR ComprLp:=fctARC TO fctOp1 DO
                        IF (Regel = ComprDescr[ComprLp]) THEN
                        BEGIN
                             UserInfo.Compression:=ComprLp;
                             WriteUserBaseRecord (UserInfoRecNr,UserInfo);

                             { your compression program is now set to ... }
                             SendResponse (GetLang1 (2013,ComprDescr[ComprLp]));

                             Exit; { ## EXIT ## }
                        END;

                    { unknown compression program }
                    SendResponse (GetLang1 (2014,Regel));

                    Exit; { ## EXIT ## }
               END ELSE
               BEGIN
                    { uucp (of baglink, maar dat zal wel nooit) }
                    IF (Regel = 'NONE') THEN
                    BEGIN
                         UserInfo.Compress:=uctNone;
                         WriteUserBaseRecord (UserInfoRecNr,UserInfo);

                         { compression set to }
                         SendResponse (GetLang1 (2015,'NONE'));

                         Exit; { ## EXIT ## }
                    END;

                    IF (Regel = 'COMPRESS') OR (Regel = 'COMP430D') THEN
                    BEGIN
                         UserInfo.Compress:=uctCompress;
                         WriteUserBaseRecord (UserInfoRecNr,UserInfo);

                         { compression set to }
                         SendResponse (GetLang1 (2015,'COMPRESS/COMP430D'));

                         Exit; { ## EXIT ## }
                    END;

                    IF (Regel = 'GZIP') THEN
                    BEGIN
                         UserInfo.Compress:=uctGZip;
                         WriteUserBaseRecord (UserInfoRecNr,UserInfo);

                         { compression set to }
                         SendResponse (GetLang1 (2015,'GZIP'));

                         Exit; { ## EXIT ## }
                    END;

                    {Unknown compression type. Use NONE, COMPRESS or GZIP.');}
                    SendResponse (GetLang0 (2016));
                    Exit; { ## EXIT ## }
               END;
          END; { compress }

          IF (Keyword = '%CUNBATCH') THEN
          BEGIN
               IF (UserInfo.System <> _U) THEN
               BEGIN
                    { unknown }
                    SendResponse (GetLang0 (2010));
                    Exit; { ## EXIT ## }
               END;

               IF (Regel = 'ON') OR (Regel = 'YES') OR (Regel = 'ENABLE') THEN
               BEGIN
                    UserInfo.CunBatch:=TRUE;
                    WriteUserBaseRecord (UserInfoRecNr,UserInfo);

                    { Enabled cunbatch }
                    SendResponse (GetLang1 (2016,'#! '+GZipBatchLetter+'unbatch'));

                    Exit; { ## EXIT ## }
               END;

               IF (Regel = 'OFF') OR (Regel = 'NO') OR (Regel = 'DISABLE') THEN
               BEGIN
                    UserInfo.CunBatch:=FALSE;
                    WriteUserBaseRecord (UserInfoRecNr,UserInfo);

                    { disabled batch header }
                    SendResponse (GetLang0 (2017));

                    Exit; { ## EXIT ## }
               END;

               { unknown batch header option. Use ON or OFF }
               SendResponse (GetLang0 (2018));

               Exit; { ## EXIT ## }
          END;

          IF (Keyword = '%NOTIFY') THEN
          BEGIN
               IF (Regel = 'ON') OR (Regel = 'YES') OR (Regel = 'ENABLE') THEN
               BEGIN
                    IF (UserInfo.System = _F) THEN
                       UserInfo.Notify_F:=TRUE
                    ELSE
                        UserInfo.Notify_U:=TRUE;

                    WriteUserBaseRecord (UserInfoRecNr,UserInfo);

                    { Enabled notification messages}
                    SendResponse (GetLang0 (2039));

                    Exit; { ## EXIT ## }
               END;

               IF (Regel = 'OFF') OR (Regel = 'NO') OR (Regel = 'DISABLE') THEN
               BEGIN
                    IF (UserInfo.System = _F) THEN
                       UserInfo.Notify_F:=FALSE
                    ELSE
                        UserInfo.Notify_U:=FALSE;

                    WriteUserBaseRecord (UserInfoRecNr,UserInfo);

                    { Disabled notification messages }
                    SendResponse (GetLang0 (2040));

                    Exit; { ## EXIT ## }
               END;

               { unknown batch header option. Use ON or OFF }
               SendResponse (GetLang0 (2018));
               Exit; { ## EXIT ## }
          END;

          IF (Keyword = '%MOVENEW') THEN
          BEGIN
               {## need to add support for group+letter group references }
               LogMessage (liReport,'Need to update group reference handling!');

               IF (NOT UserInfo.AllowFrom) THEN
               BEGIN
                    SendResponse ('Access denied');
                    Exit; { ## EXIT ## }
               END;

               GroupCh:=UpCase (Regel[1]);
               Delete (Regel,1,1);

               IF NOT (GroupCh IN ['A'..'Z']) THEN
               BEGIN
                    SendResponse ('Invalid group ('+GroupCh+') to move to. Mind what you''re doing!');
                    Exit; { ## EXIT ## }
               END;

               IF (GroupCh = 'Z1') THEN
               BEGIN
                    SendResponse ('Why move from group Z1 to group Z1? Mind what you''re doing!');
                    Exit; { ## EXIT ## }
               END;

               Regel:=DeleteFrontSpaces (Regel);
               IF (Regel = '') THEN
               BEGIN
                    SendResponse ('Missing area name. Mind what you''re doing!');
                    Exit; { ## EXIT ## }
               END;

               IF (UserInfo.System IN [_U,_SOUP]) THEN
                  AreaLp:=GetAreaBaseRecordNrByAreaName_U (Regel)
               ELSE
                   AreaLp:=GetAreaBaseRecordNrByAreaName_F (Regel);

               IF (AreaLp = NILRecordNr) THEN
               BEGIN
                    SendResponse ('Cannot find an area with that name');
                    Exit; { ## EXIT ## }
               END;

               ReadAreaBaseRecord (AreaLp,AreaRec);
               IF (NOT AreaRec.Deleted) AND TestIfInGroup (AreaRec.IsInGroups,Group_NewAreas) THEN
               BEGIN
                    { found it! Let's move it }
                    DeleteGroupFromGroupList (AreaRec.IsInGroups,Group_NewAreas);
                    GroupLp:=Ord (GroupCh)-Ord ('A')+1;
                    AddGroupToGroupList (AreaRec.IsInGroups,GroupLp);
                    WriteAreaBaseRecord (AreaLp,AreaRec);

                    SendResponse ('Moved area '+AreaRec.AreaName_U+' to group '+GroupCh);
                    Exit; { ## EXIT ## }
               END;

               SendResponse ('Area was deleted or already moved out of group Z1');
               Exit; { ## EXIT ## }
          END;

          IF (Keyword = '%DELNEW') THEN
          BEGIN
               IF (NOT UserInfo.AllowFrom) THEN
               BEGIN
                    SendResponse ('Access denied');
                    Exit; { ## EXIT ## }
               END;

               IF (UserInfo.System IN [_U,_SOUP]) THEN
                  AreaLp:=GetAreaBaseRecordNrByAreaName_U (Regel)
               ELSE
                   AreaLp:=GetAreaBaseRecordNrByAreaName_F (Regel);

               IF (AreaLp = NILRecordNr) THEN
               BEGIN
                    SendResponse ('Cannot find an area with that name');
                    Exit; { ## EXIT ## }
               END;

               ReadAreaBaseRecord (AreaLp,AreaRec);
               IF (NOT AreaRec.Deleted) AND TestIfInGroup (AreaRec.IsInGroups,Group_NewAreas) THEN
               BEGIN
                    AreaRec.Deleted:=TRUE;
                    WriteAreaBaseRecord (AreaLp,AreaRec);

                    SendResponse ('Deleted area '+AreaRec.AreaName_U);

                    Exit; { ## EXIT ## }
               END;

               SendResponse ('Area was already deleted or moved out of group Z1');
               Exit; { ## EXIT ## }
          END;

          IF (Keyword = '%MSGS') THEN
          BEGIN
               {## maybe assume %RESCAN?}
               IF (NOT DoRescan) THEN
               BEGIN
                    SendResponse ('%RESCAN required for this function');
                    Exit; { ## EXIT ## }
               END;

               {## allow simple '*' or 'ALL'?}
               Val (Regel, RescanMsgs, I);
               IF (I <> 0) THEN
               BEGIN
                    SendResponse ('Invalid number of messages "'+Regel+'" - command ignored');
                    Exit; { ## EXIT ## }
               END;

               IF (Config.RescanMsgsLimit > 0) AND (RescanMsgs > Config.RescanMsgsLimit) THEN
               BEGIN
                    SendResponse ('Notice: The SysOp has set a maximum rescan limit of '+
                                  Integer2String (Config.RescanMsgsLimit)+ ' messages.');

                    RescanMsgs := Config.RescanMsgsLimit;
                    Regel := Integer2String (Config.RescanMsgsLimit);
               END;
               
               SendResponse ('Will rescan a maximum of '+Regel+' messages per area');
               Exit; { ## EXIT ## }
          END;

          IF (Keyword = '%DAYS') THEN
          BEGIN
               {## maybe assume %RESCAN?}
               IF (NOT DoRescan) THEN
               BEGIN
                    SendResponse ('%RESCAN required for this function');
                    Exit; { ## EXIT ## }
               END;

               Val (Regel, RescanDays, I);
               IF (I <> 0) THEN
               BEGIN
                    SendResponse ('Invalid number of days "'+Regel+'" - command ignored');
                    Exit; { ## EXIT ## }
               END;

               IF (Config.RescanDaysLimit > 0) AND (RescanDays > Config.RescanDaysLimit) THEN
               BEGIN
                    SendResponse ('Notice: The SysOp has set a maximum rescan limit of '+
                                  Byte2String (Config.RescanDaysLimit)+ ' days.');

                    RescanDays := Config.RescanDaysLimit;
                    Regel := Byte2String (Config.RescanDaysLimit);
               END;

               SendResponse ('Will NOT rescan messages more than '+Regel+' days old');
               Exit; { ## EXIT ## }
          END;

          IF (Keyword = '%PKTTYPE') THEN
          BEGIN
               IF (UserInfo.System <> _F) THEN
               BEGIN
                    {## put in lang file}
                    SendResponse ('The PKTTYPE option is only applicable to Fidonet systems.');
                    Exit; { ## EXIT ## }
               END;

               IF (Regel = 'PKT') THEN
               BEGIN
                    UserInfo.PktFormat := fptPkt;
                    WriteUserBaseRecord (UserInfoRecNr, UserInfo);

                    {## move to language file}
                    SendResponse ('Your packet type is now set to PKT.');

                    Exit; { ## EXIT ## }
               END ELSE IF (Regel = 'P2K') THEN
               BEGIN
                    UserInfo.PktFormat := fptPkt2000;
                    WriteUserBaseREcord (UserInfoRecNr, UserInfo);

                    {## move to language file}
                    SendResponse ('Your packet type is now set to P2K');

                    Exit; { ## EXIT ## }
               END;

               SendResponse ('Unknown packet type.  Please specify PKT or P2K.');
               Exit; { ## EXIT ## }
          END;
               
          { unknown }
          SendResponse (GetLang0 (2010));
          Exit; { ## EXIT ## }
     END; { Regel[1] = '%' }

     IF IgnoreCommand THEN
     BEGIN
          { ignoring }
          SendResponse (GetLang0 (2019));
          Exit; { ## EXIT ## }
     END;

     { '-' AREANAME or '!' AREANAME sluit de area effectief af ... }
     IF (Regel[1] IN ['!','-']) THEN
     BEGIN
          Delete (Regel,1,1);

          { RWI 960304: ondersteunt nu ook +<spatie>areaname }
          IF (Regel[1] = ' ') THEN
             Delete (Regel,1,1);

          { RWI 961001: we ondersteunen nu ook -areaname omschrijving }
          IF (Pos (' ',Regel) > 0) THEN
             Regel:=Copy (Regel,1,Pos (' ',Regel)-1);

          { Bestaat de area ? }
          IF (UserInfo.System IN [_U,_SOUP]) THEN
             AreaLp:=GetAreaBaseRecordNrByAreaName_U (Regel)
          ELSE
              AreaLp:=GetAreaBaseRecordNrByAreaName_F (Regel);

          IF (AreaLp = NILRecordNr) THEN
          BEGIN
               { cannot find area with that name }
               {SendResponse (GetLang0 (2020));}
               { send the 2021 message instead: not subscribed to that area }
               SendResponse (GetLang0 (2021));

               IF Config.LogAreaFix THEN
                  LogExtraMessage ('  Unknown area');

               Exit; { ## EXIT ## }
          END;

          ReadAreaBaseRecord (AreaLp,AreaRec);

          { is de gebruiker er wel op aangesloten ? }
          IF (NOT TestIfUserIsInAreaRec_UserList (AreaRec.UserList,UserInfoRecNr)) THEN
          BEGIN
               { Nee dus }
               {You are not connected to that area; no need to disconnect');}
               SendResponse (GetLang0 (2021));

               IF Config.LogAreaFix THEN
                  LogExtraMessage ('  Not connected');

               Exit; { ## EXIT ## }
          END;

          IF (AreaRec.Mandatory) THEN
          BEGIN
               { Cannot disconnect, area is mandatory! }
               SendResponse (GetLang0 (2037));
               Exit; { ## EXIT ## }
          END;

          { Alles overleeft, sluit de area nu maar af }
          RemoveUserFromAreaSubscrList (AreaRec,UserInfoRecNr);
          WriteAreaBaseRecord (AreaLp,AreaRec);

          RemoveAreaFromUserSubscrToList (UserInfo,AreaLp);
          WriteUserBaseRecord (UserInfoRecNr,UserInfo);

          { disconnected }
          SendResponse (GetLang0 (2022));

          CheckIfAreaCanGoPassive (AreaRec,AreaLp);

          Exit; { ## EXIT ## }
     END; { einde delete }

     { Add User To Area }

     { Een plusje voor een Area betekent ook Connect-me-please }
     IF (Regel[1] = '+') THEN
     BEGIN
          Delete (Regel,1,1);

          { RWI 960304: ondersteunt nu ook +<spatie>areaname }
          IF (Regel[1] = ' ') THEN
             Delete (Regel,1,1);
     END;

     { Commando's zijn boven afgevangen, alles wat er nu nog over is }
     { moeten wel Area Connect requests zijn.                        }

     {## RESCAN: Add support for "-r" to trigger rescan}

     { RWI 961001: we ondersteunen nu ook -areaname omschrijving }
     IF (Pos (' ',Regel) > 0) THEN
        Regel:=Copy (Regel,1,Pos (' ',Regel)-1);

     { Bestaat de area ? }
     IF (UserInfo.System IN [_U,_SOUP]) THEN
        AreaLp:=GetAreaBaseRecordNrByAreaName_U (Regel)
     ELSE
         AreaLp:=GetAreaBaseRecordNrByAreaName_F (Regel);

     IF (AreaLp = NILRecordNr) THEN
     BEGIN
          { Probeer 'm aan te maken }
          CASE AreaFixCheckForward (Regel) OF
               0 : BEGIN
                        {Cannot find an area with that name');}
                        { ... nor request it from an uplink }
                        SendResponse (GetLang0 (2020));
                   END;

               1 : BEGIN
                        {Connected + requested from Fido uplink');}
                        SendResponse (GetLang1 (2023,'FTN'));

                        { Rescan not possible }
                        IF (DoRescan) THEN
                              SendResponse ('Note: %RESCAN was not possible for this area!');
                   END;

               2 : BEGIN
                        {Connected + requested from UUCP uplink');}
                        SendResponse (GetLang1 (2023,'RFC'));

                        { Rescan not possible }
                        IF (DoRescan) THEN
                              SendResponse ('Note: %RESCAN was not possible for this area!');
                   END;
          END; { case }

          Exit;
     END;

     ReadAreaBaseRecord (AreaLp,AreaRec);

     { Bingo, we hebben hier dus een geldige areaname (!) en iemand  }
     { die 'm wil lezen.. wat kunnen we nog verzinnen om hem/haar te }
     { blokkeren ?                                                   }

     { is hij/zij al aangesloten? }
     IF TestIfUserIsInAreaRec_UserList (AreaRec.UserList,UserInfoRecNr) THEN
     BEGIN
          { If rescanning, just do the rescan }
          IF (DoRescan) THEN
          BEGIN
               Rescan_Area (AreaLp,UserInfoRecNr,RescanDays,RescanMsgs);
               SendResponse ('Rescanned (last '+Word2String(RescanDays)+' days, max '+Word2String (RescanMsgs)+' msgs)');
          END ELSE               
               {You are already connected to that area');}
               SendResponse (GetLang0 (2024));

          Exit; { ## EXIT ## }
     END;

     { we nemen hier de rechten van degene die het bericht verzonden heeft }
     IF (NOT TestIfGroupCommon (UserInfo.Groups,AreaRec.IsInGroups)) THEN
     BEGIN
          {You are not allowed to connect to that area');}
          SendResponse (GetLang0 (2025));
          Exit; { ## EXIT ## }
     END;

     CheckIfAreaHasToGoNonePassive (AreaRec,AreaLp);

     { Sluit de Area aan voor de user }
     AddUserToAreaSubscrList (AreaRec,UserInfoRecNr);
     WriteAreaBaseRecord (AreaLp,AreaRec);

     AddAreaToUserSubscrToList (UserInfo,AreaLp);
     WriteUserBaseRecord (UserInfoRecNr,UserInfo);

     { Connected }
     SendResponse (GetLang0 (2026));

     IF (DoRescan) THEN
     BEGIN
          Rescan_Area (AreaLp,UserInfoRecNr,RescanDays,RescanMsgs);
          SendResponse ('Rescanned (last '+Word2String(RescanDays)+' days, max '+Word2String (RescanMsgs)+' msgs)');
     END;

     { send the rules file, if any is present for this area }
     IF (AreaRec.RulesFile <> '') THEN
     BEGIN
          GetMem (RulesPtr,SizeOf (AreaBaseRecordNrType));
          RulesPtr^:=AreaLp;
          RulesToSend.Add (RulesPtr);
     END;
END;


{--------------------------------------------------------------------------}
{ AreaFix_ProcessLine                                                      }
{                                                                          }
{ Used in a MsgsForEach construction to process each line in the message   }
{ sent to areafix. This routine check for the tear-line and aborts there.  }
{                                                                          }
FUNCTION AreaFix_ProcessLine (VAR Regel : STRING) : BOOLEAN; FAR;
BEGIN
     { stop at tear-line }
     IF (Regel = '---') OR (Regel = '---'+#13) OR (Copy (Regel,1,4) = '--- ') THEN
        AreaFix_ProcessLine:=TRUE  { abort }
     ELSE BEGIN
          AreaFix_ProcessLine:=FALSE; { continue after this one }
          ProcessFixLine (Regel);
     END;
END;


{---------------------------------------------------------------------------}
{ Areafix_ProcessMessage                                                    }
{                                                                           }
{ Deze routine verwerkt een areafix fido-style areafix verzoek en kan daar  }
{ in netmail een reactie op schrijven.                                      }
{ The message is stored in Msg.BodyTop. It MUST NOT be changed.             }
{                                                                           }
PROCEDURE Areafix_ProcessMessage;

CONST ERR_REFUSED = 'Refused AreaFix request from unknown system';

VAR SenderName     : STRING[MaxLenUserName_F];
    OurPassword,
    AF_Password    : STRING[MaxLenAreaFixPwd];
    Lp             : 1..MAX_BODY_PARTS;
    RulesPtr       : ^AreaBaseRecordNrType;
    AreaRec        : AreaBaseRecord;

BEGIN
     SenderName:=Msg.FromUser_F;

     InitTokens (_F);
     RulesToSend.Clear;

     DoRescan := False;
     RescanDays := Config.RescanDaysLimit;
     RescanMsgs := Config.RescanMsgsLimit;

     IF (NOT FindUserBaseRecordByFidoAddress (Msg.FromAddr_F,UserInfoRecNr)) THEN
     BEGIN
          { verkeerde gebruiker, retour aan de SYSOP van het systeem }
          LogMessage (liFatal,ERR_REFUSED);
          LogExtraMessage ('Sender: "'+Msg.FromUser_F+'"%'+Fido2Str (Msg.FromAddr_F));

          { send a reply to the sender of this message and include }
          { a copy for the sysop.                                  }
          FTN_PushAndBuildReply (Config.AreafixNames[1]+' failure',
                                 0{automatic},
                                 Config.AreafixNames[1]);

          WITH Msg.PrevMsgPtr^ DO
          BEGIN
               Address_AddFTN ('SysOp',FromAddr_F,{Note:}FALSE,{ByFilter:}FALSE);

               MsgsAddLineTo (Body,'Original reply to "'+FromUser_F+'"%'+Fido2Str (FromAddr_F));
               MsgsAddLineTo (Body,'Copy to SysOp at '+Fido2Str (FromAddr_F));
               MsgsAddLineTo (Body,'');
          END;

          { voeg een standaard antwoord file of lijn toe aan het bericht }
          IF (NOT AddFileToBody ('UNKAFUSR.TXT')) THEN
             MsgsAddlineTo (Body,'Reason: '+ERR_REFUSED);

          FTN_CreateBounceBody;

          { copy the entire body of the original message }
          FOR Lp:=1 TO MAX_BODY_PARTS DO
              MsgsCopyNLines (Msg.PrevMsgPtr^.BodyParts[Lp],0);

          Msg.Attr_F:=Msg.Attr_F OR MSGKILL{sent};

          DeliverNow;
          MsgsPopState;

          Exit; { ## EXIT ## }
     END;

     LogMessage (liGeneral,'Processing AreaFix request from "'+Msg.FromUser_F+'"%'+Fido2Str (Msg.FromAddr_F));

     { lees het record van deze bekende gebruiker in }
     ReadUserBaseRecord (UserInfoRecNr,UserInfo);

     { nog niets aangevraagd }
     RequestedQuery:=FALSE;
     RequestedList:=FALSE;
     RequestedHelp:=FALSE;

     IgnoreCommand:=FALSE; { nodig bij invalid %FROM }

     Msg.Subj_F:=UpCaseString (Msg.Subj_F); { upcase ook voor -Q en -L }

     { Kijk of er nog 'stone age' vlaggen achter staan }
     IF (Pos ('-Q',Msg.Subj_F) > 0) THEN
        RequestedQuery:=TRUE;

     IF (Pos ('-L',Msg.Subj_F) > 0) THEN
        RequestedList:=TRUE;

     IF (Pos ('-H',Msg.Subj_F) > 0) THEN
        RequestedHelp:=TRUE;

     { snij het password uit de subject lijn }
     IF (Pos (' ',Msg.Subj_F) <> 0) THEN
        AF_Password:=Copy (Msg.Subj_F,1,Pos (' ',Msg.Subj_F)-1)
     ELSE
         AF_Password:=DeleteBackSpaces (Copy (Msg.Subj_F,1,MaxLenAreaFixPwd));

     { voeg het token 'Password' toe }
     SetToken (tokPassWord,AF_Password);

     { controleer of het password wel goed is }
     OurPassword:=UpCaseString (DeleteBackSpaces (UserInfo.AreaFixPwd));
     IF NOT ((OurPassword = '') OR (AF_Password = OurPassword)) THEN
     BEGIN
          { ongeldig password! }
          LogMessage (liFatal,'AreaFix: Bad password!');
          LogExtraMessage ('Found: "'+AF_Password+'"; User Definition: "'+OurPassword+'"');

          { send a reply to the sender of this message and include }
          { a copy for the sysop.                                  }
          FTN_PushAndBuildReply (Config.AreafixNames[1]+' failure',
                                 UserInfo.ExportAKA, {AreaMgr_MatchAKA (Msg.FromAddr_F)}
                                 Config.AreafixNames[1]);

          IF (NOT CaselessMatch (UserInfo.Sysop,SenderName)) THEN
             IF (UserInfo.Sysop = '') THEN
             BEGIN
                  LogMessage (liConfig,'Sysop not defined for '+Fido2Str (UserInfo.Address));
                  LogExtraMessage ('Cannot sent warning copy to sysop');
             END ELSE
                 WITH Msg.PrevMsgPtr^ DO
                 BEGIN
                      Address_AddFTN (UserInfo.Sysop,UserInfo.Address,FALSE,FALSE);

                      MsgsAddLineTo (Body,'Original reply to "'+FromUser_F+'" at '+Fido2Str (UserInfo.Address));
                      MsgsAddLineTo (Body,'Copy to SysOp "'+UserInfo.Sysop+'" at '+Fido2Str (UserInfo.Address));
                      MsgsAddLineTo (Body,'');
                 END;

          IF (NOT AddFileToBody ('WRNGAPWD.TXT')) THEN
          BEGIN
               {'Incorrect password "'+AF_Password+'"; refusing areafix request.');}
               MsgsAddLineTo (Body,GetLang2 (2027,AF_Password,Config.AreafixNames[1]));
               MsgsAddLineTo (Body,'');
          END;

          MsgsAddLineTo (Body,RepChar (70,'-'));
          MsgsAddLineTo (Body,GetLang0 (122)); { Original message follows below }
          MsgsAddLineTo (Body,RepChar (70,'-'));

          { copy the entire body of the original message }
          {## can't we just refer to the original body parts?}
          FOR Lp:=1 TO MAX_BODY_PARTS DO
              MsgsCopyNLines (Msg.PrevMsgPtr^.BodyParts[Lp],0);

          Msg.Attr_F:=Msg.Attr_F OR MSGKILL{sent};
          DeliverNow;
          MsgsPopState;

          Exit; { klaar }
     END;

     { start the reply }
     FTN_PushAndBuildReply (GetLang1 (2035,Config.AreafixNames[1]), { subj }
                            UserInfo.ExportAKA, {AreaMgr_MatchAKA (Msg.FromAddr_F)}
                            Config.AreafixNames[1]);                { name }

     MsgsAddLineTo (Body, 'Your message was processed by AreaFix@'+Fido2Str(Msg.FromAddr_F)+' on '+
          UnixTimeToString (GetCurrentUnixTime));
     
     { oke, toegang verleend. Verwerk nu de commando's die in de body staan }
     FOR Lp:=1 TO MAX_BODY_PARTS DO
         IF MsgsForEach (Msg.PrevMsgPtr^.BodyParts[Lp],AreaFix_ProcessLine) THEN
            Break; { from the for }

     LogMessage (liTrivial,'Sending AreaFix reply');
     MsgsAddLineTo (Body,'');

     { end of 'x response }
     MsgsAddLineTo (Body,GetLang1 (2031,Config.AreafixNames[1]));

     Msg.Attr_F:=Msg.Attr_F OR MSGKILL{/sent};
     DeliverNow;
     MsgsPopState;

     { check the flags }
     IF RequestedQuery THEN
     BEGIN
          LogMessage (liTrivial,'Writing areafix query message');
          FTN_PushAndBuildReply (GetLang1 (2028,Config.AreafixNames[1]),
                                 UserInfo.ExportAKA, {AreaMgr_MatchAKA (Msg.FromAddr_F)}
                                 Config.AreaFixNames[1]);
          BuildQuery;

          Msg.Attr_F:=Msg.Attr_F OR MSGKILL{/sent};
          DeliverNow;
          MsgsPopState;
     END;

     IF RequestedList THEN
     BEGIN
          LogMessage (liTrivial,'Writing areafix list message');
          FTN_PushAndBuildReply (GetLang1 (2029,Config.AreafixNames[1]),
                                 UserInfo.ExportAKA, {AreaMgr_MatchAKA (Msg.FromAddr_F)}
                                 Config.AreaFixNames[1]);
          BuildList;

          Msg.Attr_F:=Msg.Attr_F OR MSGKILL{/sent};
          DeliverNow;
          MsgsPopState;
     END;

     IF RequestedHelp THEN
     BEGIN
          LogMessage (liTrivial,'Writing areafix help message');
          FTN_PushAndBuildReply (GetLang1 (2030,Config.AreafixNames[1]),
                                 UserInfo.ExportAka, {AreaMgr_MatchAKA (Msg.FromAddr_F)}
                                 Config.AreaFixNames[1]);

          IF (NOT AddFileToBody ('AREAFIX.TXT')) THEN
          BEGIN
               MsgsAddLineTo (Body,'');
               MsgsAddLineTo (Body,'From: '+AddUpWithSpaces (17,'John Doe')+'2:280/802.9996');
               MsgsAddLineTo (Body,'To  : '+AddUpWithSpaces (17,Config.AreafixNames[1])+'2:280/802');
               MsgsAddLineTo (Body,'Subj: My_Areafix_Password');
               MsgsAddLineTo (Body,'');
               MsgsAddLineTo (Body,'+AREANAME       Connect an area');
               MsgsAddLineTo (Body,'-AREANAME       Disconnect an area');
               MsgsAddLineTo (Body,'%LIST           List all connected areas.');
               MsgsAddLineTo (Body,'%QUERY          List all available areas.');
               MsgsAddLineTo (Body,'%PASSWORD <pwd> Change '+Config.AreafixNames[1]+' password');
               MsgsAddLineTo (Body,'%PKTPWD <pwd>   Change .PKT password');
               MsgsAddLineTo (Body,'%PKTTYPE <type> Change .PKT type between standard and Packet2000');
               MsgsAddLineTo (Body,'                Options: PKT (Fido standard), P2K (Pkt2000)');
               MsgsAddLineTo (Body,'%COMPRESS <opt> Change archive compression program.');
               MsgsAddLineTo (Body,'                Options: ARC,ARJ,LZH,PAK,ZIP,ZOO,RAR,NON');
               MsgsAddLineTo (Body,'%NOTIFY <op>    Set notify flag. Options: ON, OFF');
               MsgsAddLineTo (Body,'%PASSIVE        Temporarily stop message flow.');
               MsgsAddLineTo (Body,'%ACTIVE         Start message flow again (used after %PASSIVE).');

               IF UserInfo.AllowFrom THEN
               BEGIN
                    MsgsAddLineTo (Body,'');
                    MsgsAddLineTo (Body,'Special commands:');
                   {MsgsAddLineTo (Body,'%FROM           Change identity');}
                    MsgsAddLineTo (Body,'%LISTNEW        List all areas in group Z');
                    MsgsAddLineTo (Body,'%MOVENEW <grp> <area>');
                    MsgsAddLineTo (Body,'                Move <area> from group Z to group <grp>');
                    MsgsAddLineTo (Body,'%DELNEW <area>  Delete <area> from group Z');
                    MsgsAddLineTo (Body,'%GROUPS         List all available groups + descriptions');
               END;
          END;

          Msg.Attr_F:=Msg.Attr_F OR MSGKILL{/sent};
          DeliverNow;
          MsgsPopState;
     END;

     { send the rules files for all subscribed areas }
     RulesPtr:=RulesToSend.GetFirstItem;
     WHILE (RulesPtr <> NIL) DO
     BEGIN
          ReadAreaBaseRecord (RulesPtr^,AreaRec);

          LogMessage (liTrivial,'Sending rules file for area '+AreaRec.AreaName_F);

          FTN_PushAndBuildReply (GetLang1 (2038,AreaRec.AreaName_F),
                                 UserInfo.ExportAKA, {AreaMgr_MatchAKA (Msg.FromAddr_F)}
                                 Config.AreaFixNames[1]);

          IF AddFileToBody (AreaRec.RulesFile) THEN
          BEGIN
               Msg.Attr_F:=Msg.Attr_F OR MSGKILL{/sent};
               DeliverNow;
          END ELSE
          BEGIN
               LogMessage (liGeneral,'Destroying message');
               MsgsEmpty; { don't send it }
          END;

          MsgsPopState;

          RulesPtr:=RulesToSend.GetNextItem;
     END;

     RulesToSend.Clear;
END;


{--------------------------------------------------------------------------}
{ Newsfix_ProcessLine                                                      }
{                                                                          }
{ Used in a MsgsForEach construction to process each line in the message   }
{ sent to areafix. This routine check for the signature tear-line and      }
{ aborts there.                                                            }
{                                                                          }
FUNCTION Newsfix_ProcessLine (VAR Regel : STRING) : BOOLEAN; FAR;
BEGIN
     IF (Copy (Regel,1,3) = '-- ') THEN
        Newsfix_ProcessLine:=TRUE  { abort }
     ELSE BEGIN
          ProcessFixLine (Regel);
          Newsfix_ProcessLine:=FALSE; { continue after this one }
     END;
END;


{---------------------------------------------------------------------------}
{ Newsfix_AddLineToBody                                                     }
{                                                                           }
{ Used in a MsgsForEach construction.                                       }
{                                                                           }
FUNCTION Newsfix_AddLineToBody (VAR Regel : STRING) : BOOLEAN; FAR;
BEGIN
     MsgsAddLineToNoEol (Body,Regel);
     Newsfix_AddLineToBody:=FALSE; { do not abort }
END;


{---------------------------------------------------------------------------}
{ Newsfix_ProcessMessage                                                    }
{                                                                           }
{ Deze routine verwerkt een newsfix verzoek van een uucp user en kan daar   }
{ in uucp mail formaat een reactie op produceren.                           }
{ The message is stored in Msg.BodyTop and it MUST NOT be changed!          }
{                                                                           }
PROCEDURE NewsFix_ProcessMessage;

    PROCEDURE AddUnprocessedMessage;

    VAR Lp : 1..MAX_BODY_PARTS;

    BEGIN
         MsgsAddLineTo (Body,'');
         MsgsAddLineTo (Body,GetLang0 (2033));

         FOR Lp:=1 TO MAX_BODY_PARTS DO
             MsgsForEach (Msg.PrevMsgPtr^.BodyParts[Lp],Newsfix_AddLineToBody);

         MsgsAddLineTo (Body,GetLang0 (2034));
    END;

{Newsfix_ProcessMessage}

VAR Found    : BOOLEAN;
    ULp      : UserBaseRecordNrType;
    DLp      : 1..MaxUserDomains;
    Hulp,
    Domain,
    HulpName : STRING;
    OurPwd,
    HisPwd   : STRING[MaxLenAreaFixPwd];
    Lp       : 1..MAX_BODY_PARTS;
    RulesPtr : ^AreaBaseRecordNrType;
    AreaRec  : AreaBaseRecord;

BEGIN
     RequestedQuery:=FALSE;
     RequestedList:=FALSE;
     RequestedHelp:=FALSE;

     IgnoreCommand:=FALSE; { nodig bij invalid %FROM }
     RulesToSend.Clear;

     { systeem naam opzoeken }
     HulpName:=UseGetAddress (Copy (Msg.FromUser_U,7,255));
     UsenetSplit (HulpName,Domain,Hulp);
     Domain:=UpCaseString (Domain);

     LogMessage (liGeneral,'Processing Newsfix request from '+HulpName);

     IF (Domain = '') THEN
     BEGIN
          RFC_PushAndBuildReply (Config.NewsfixName+' failure',
                                 '',Config.NewsfixName+'@'+Config.Domains[1]);

          LogMessage (liFatal,'NewsFix: cannot extract sending systems'' domain name');
          LogExtraMessage ('Reply address was "'+HulpName+'"');

          { Unknown system; refusing @1@ request }
          MsgsAddLineTo (Body,GetLang1 (2032,Config.NewsfixName));

          AddUnprocessedMessage;
          DeliverNow;
          MsgsPopState;
          Exit;                 { ## EXIT ## }
     END;

     { --- search for this system  }

     Found:=FALSE;
     FOR ULp:=1 TO UserBaseRecCount DO
     BEGIN
          ReadUserBaseRecord (ULp,UserInfo);

          IF (NOT UserInfo.Deleted) THEN
          BEGIN
               FOR DLp:=1 TO MaxUserDomains DO
                   IF CaselessMatch (Domain,UserInfo.Domains[DLp]) THEN
                   BEGIN
                        UserInfoRecNr:=ULp;
                        Found:=TRUE;
                        Break; { uit de DLp }
                   END;
          END;

          IF Found THEN
             Break; { uit de ULp }
     END; { for ULp }

     IF (NOT Found) THEN
     BEGIN
          { split again to get the lower case domain name }
          UsenetSplit (HulpName,Domain,Hulp);

          LogMessage (liFatal,'NewsFix: could not find a system with domain name "'+Domain+'"');

          RFC_PushAndBuildReply (Config.NewsfixName+' failure',
                                 '',Config.NewsfixName+'@'+Config.Domains[1]);

          { Unknown system; refusing @1@ request }
          MsgsAddLineTo (Body,GetLang1 (2032,Config.NewsfixName));

          AddUnprocessedMessage;
          DeliverNow;
          MsgsPopState;
          Exit;                 { ## EXIT ## }
     END;

     { --- interpret subject line }

     Hulp:=UpCaseString (Copy (Msg.Subj_U,Pos (' ',Msg.Subj_U)+1,255));

     { AreaFix flags are supported for newsfix as well }
     { should be AFTER the password.                   }
     IF (Pos ('-Q',Hulp) > 0) THEN
        RequestedQuery:=TRUE;

     IF (Pos ('-L',Hulp) > 0) THEN
        RequestedList:=TRUE;

     IF (Pos ('-H',Hulp) > 0) THEN
        RequestedHelp:=TRUE;

     IF (Pos (' ',Hulp) > 0) THEN
        HisPwd:=Copy (Hulp,1,Pos (' ',Hulp)-1)
     ELSE
         HisPwd:=Hulp;

     OurPwd:=UpCaseString (UserInfo.AreaFixPwd);

     IF (OurPwd <> ''{stupid?}) AND (HisPwd <> OurPwd) THEN
     BEGIN
          { password defined and wrong password given }
          LogMessage (liFatal,'NewsFix: Bad password. Found: "'+HisPwd+'"; UserBase: "'+OurPwd+'"');

          RFC_PushAndBuildReply (Config.NewsfixName+' failure',
                                 '',Config.NewsfixName+'@'+Config.Domains[1]);

          IF (NOT AddFileToBody ('WRNGAPWD.TXT')) THEN
             { Incorrect password "@1@"; refusing @2@ request }
             MsgsAddLineTo (Body,GetLang2 (2027,HisPwd,Config.NewsfixName));

          AddUnprocessedMessage;
          DeliverNow;
          MsgsPopState;
          Exit;                         { ## EXIT ## }
     END;

     { --- process the messsage }

     RFC_PushAndBuildReply (GetLang1 (2035,Config.NewsfixName), {subject }
                            '',Config.NewsfixName+'@'+Config.Domains[1]);

     FOR Lp:=1 TO MAX_BODY_PARTS DO
         IF MsgsForEach (Msg.PrevMsgPtr^.BodyParts[Lp],Newsfix_ProcessLine) THEN
            Break; { from the for }

     { End of @1@ response }
     MsgsAddLineTo (Body,'');
     MsgsAddLineTo (Body,GetLang1 (2031,Config.NewsfixName));
     MsgsAddLineTo (Body,'');

     { send the reply }
     DeliverNow;
     MsgsPopState;

     { --- send additional requested information }

     IF RequestedQuery THEN
     BEGIN
          LogMessage (liTrivial,'Writing newsfix query message');
          RFC_PushAndBuildReply (GetLang1 (2028,Config.NewsfixName), {subject }
                                 '',Config.NewsfixName+'@'+Config.Domains[1]);
          BuildQuery;
          DeliverNow;
          MsgsPopState;
     END;

     IF RequestedList THEN
     BEGIN
          LogMessage (liTrivial,'Writing newsfix list message');
          RFC_PushAndBuildReply (GetLang1 (2029,Config.NewsfixName), {subject }
                                 '',Config.NewsfixName+'@'+Config.Domains[1]);
          BuildList;
          DeliverNow;
          MsgsPopState;
     END;

     IF RequestedHelp THEN
     BEGIN
          LogMessage (liTrivial,'Writing newsfix help message');
          RFC_PushAndBuildReply (GetLang1 (2030,Config.NewsfixName), {subject }
                                 '',Config.NewsfixName+'@'+Config.Domains[1]);

          IF (NOT AddFileToBody ('NEWSFIX.TXT')) THEN
          BEGIN
               MsgsAddLineTo (Body,'From: '+HulpName);
               MsgsAddLineTo (Body,'To: '+Config.NewsfixName+'@'+Config.Domains[1]);
               MsgsAddLineTo (Body,'Subject: My_NewsFix_Password');
               MsgsAddLineTo (Body,'');
               MsgsAddLineTo (Body,'+AREANAME       this will connect an area');
               MsgsAddLineTo (Body,'-AREANAME       this will disconnect an area');
               MsgsAddLineTo (Body,'%LIST           this will list all areas you have connected');
               MsgsAddLineTo (Body,'%QUERY          this will list all areas available to you');
               MsgsAddLineTo (Body,'%PASSWORD <pwd> change your '+Config.NewsfixName+' password');
               MsgsAddLineTo (Body,'%COMPRESS <opt> set compression. Options: NONE, COMPRESS, GZIP');
               MsgsAddLineTo (Body,'%CUNBATCH <opt> set cunbatch. Options: ON, OFF');
               MsgsAddLineTo (Body,'%NOTIFY <op>    set notify flag. Options: ON, OFF');
               MsgsAddLineTo (Body,'%PASSIVE        Don''t distribute messages to me anymore');
               MsgsAddLineTo (Body,'%ACTIVE         Start distributing to me again');

               IF UserInfo.AllowFrom THEN
               BEGIN
                    MsgsAddLineTo (Body,'');
                    MsgsAddLineTo (Body,'Special commands:');
                   {MsgsAddLineTo (Body,'%FROM           Change identity');}
                    MsgsAddLineTo (Body,'%LISTNEW        List all areas in group Z');
                    MsgsAddLineTo (Body,'%MOVENEW <grp> <area>');
                    MsgsAddLineTo (Body,'                Move area from group Z to group <grp>');
                    MsgsAddLineTo (Body,'%DELNEW <area>  Delete area from group Z');
                    MsgsAddLineTo (Body,'%GROUPS         List available groups + names');
               END;

               MsgsAddLineTo (Body,'');
          END;

          DeliverNow;
          MsgsPopState;
     END;

     { send the rules files for all subscribed areas }
     RulesPtr:=RulesToSend.GetFirstItem;
     WHILE (RulesPtr <> NIL) DO
     BEGIN
          ReadAreaBaseRecord (RulesPtr^,AreaRec);

          LogMessage (liTrivial,'Sending rules file for area '+AreaRec.AreaName_U);

          RFC_PushAndBuildReply (GetLang1 (2038,AreaRec.AreaName_U), {subject }
                                 '',Config.NewsfixName+'@'+Config.Domains[1]);

          IF AddFileToBody (AreaRec.RulesFile) THEN
          BEGIN
               Msg.Attr_F:=Msg.Attr_F OR MSGKILL{/sent};
               DeliverNow;
          END ELSE
          BEGIN
               LogMessage (liGeneral,'Destroying message');
               MsgsEmpty; { don't send it }
          END;

          MsgsPopState;

          RulesPtr:=RulesToSend.GetNextItem;
     END;

     RulesToSend.Clear;
END;


{--------------------------------------------------------------------------}
{ Notify_AddAreaListing                                                    }
{                                                                          }
{ Deze routine bouwt een lijst met alle areas op en geeft aan op welke de  }
{ user al aangesloten is met een plusje ervoor. De areas worden daarna per }
{ group gesorteerd aan het bericht toegevoegd.                             }
{                                                                          }
PROCEDURE Notify_AddAreaListing;
BEGIN
     IF (NoFullScreen) THEN
          WriteLn ('AreaMgr processing %NOTIFY command');

     InitQLWindow ('%NOTITY progress');

     { Plaats een 'Areafix QueRy Request HeaDeR' aan het begin }
     IF (NOT (StayQuiet OR NoFullScreen)) THEN
        WriteXYC (QLXb+3,QLYb+3,cCustom1,'þ');

     IF (NOT AddFileToBody ('NTFYHDR.TXT')) THEN
     BEGIN
          MsgsAddLineTo (Body,'The following areas are available or subscribed:');
          IF (NOT (StayQuiet OR NoFullScreen)) THEN
               WriteXYC (QLXb2,QLYb+3,cBoxData,'System line');
     END ELSE
          IF (NOT (StayQuiet OR NoFullScreen)) THEN
               WriteXYC (QLXb2,QLYb+3,cBoxData,'NTFYHDR.TXT');

     IF (NOT (StayQuiet OR NoFullScreen)) THEN
          WriteXY (QLXb+3,QLYb+3,'û');

     IF (NOT (StayQuiet OR NoFullScreen)) THEN
          WriteXYC (QLXb+3,QLYb+4,cCustom1,'þ');

     InitAreaDataTable (CountAllowedEchoAreas (UserInfo.Groups),0,ListFetchNextRecNr);

     IF (NOT (StayQuiet OR NoFullScreen)) THEN
          WriteXYC (QLXb+3,QLYb+4,cBoxData,'û');

     IF (NOT (StayQuiet OR NoFullScreen)) THEN
          WriteXYC (QLXb+3,QLYb+5,cCustom1,'þ');

     SortAreaData;

     IF (NOT (StayQuiet OR NoFullScreen)) THEN
          WriteXYC (QLXb+3,QLYb+5,cBoxData,'û');

     IF (NOT (StayQuiet OR NoFullScreen)) THEN
          WriteXYC (QLXb+3,QLYb+6,cCustom1,'þ');
     FreeUpNameTables; { maakt ruimte om het bericht op te bouwen }

     AddAreaDataTableToMessage (TRUE{Add + in front of subscribed areas});
     IF (NOT (StayQuiet OR NoFullScreen)) THEN
          WriteXYC (QLXb+3,QLYb+6,cBoxData,'û');

     DestroyAreaDataTable;

     { Plaats een 'Areafix QueRy Request FooTeR' aan het einde }
     IF (NOT (StayQuiet OR NoFullScreen)) THEN
          WriteXYC (QLXb+3,QLYb+7,cCustom1,'þ');
     IF (NOT AddFileToBody ('NTFYFTR.TXT')) THEN
     BEGIN
          MsgsAddLineTo (Body,'');
          MsgsAddLineTo (Body,'-- You are connected to '+Word2String (CountSubscribedAreas (UserInfo.AreaList))+
                              ' of the '+Word2String (MapAreaRecCount)+' available areas');
          MsgsAddLineTo (Body,'');
          IF (NOT (StayQuiet OR NoFullScreen)) THEN
               WriteXYC (QLXb2,QLYb+3,cBoxData,'System line');
     END ELSE
          IF (NOT (StayQuiet OR NoFullScreen)) THEN
              WriteXYC (QLXb2,QLYb+7,cBoxData,'NTFYFTR.TXT');
     IF (NOT (StayQuiet OR NoFullScreen)) THEN
          WriteXY (QLXb+3,QLYb+7,'û');

     IF (NOT (StayQuiet OR NoFullScreen)) THEN BEGIN
          WindowPop;
          PopKeysLine;
     END;
END;


CONST NoYesStrs : ARRAY[FALSE..TRUE] OF STRING[3] = ('No','Yes');

{--------------------------------------------------------------------------}
{ AreaFix_SendNotification                                                 }
{                                                                          }
{ This routine sends a notification message to an FTN user.                }
{                                                                          }
PROCEDURE AreaFix_SendNotification (VAR UserRec : UserBaseRecord);

CONST SendStrs  : ARRAY[SendType] OF STRING[10] = ('Normal','Hold','Crash','Direct','MailTunnel','SEAT');

VAR OurAddr  : FidoAddrType;
    Lp       : 1..MaxUserDomains;
    FoundAka : 1..MaxAkas;

BEGIN
     LogMessage (liTrivial,'Sending notification to "'+UserRec.SysOp+'" '+Fido2Str (UserRec.Address));

     { Calculate Export AKA }
     FoundAKA:=UserRec.ExportAKA;
     IF (FoundAKA = 0{automatic}) THEN
        FoundAKA:=FidoMatchAdres (UserRec.Address,OurAddr{Dummy});
     OurAddr:=Config.NodeNrs[FoundAka];

     FTN_CreateNetmail (OurAddr,
                        Config.AreaFixNames[1],
                        Config.AreaFixNames[1]+' notification');

     Address_AddFTN (UserRec.SysOp,       { to }
                     UserRec.Address,     { to aka }
                     FALSE,FALSE);        { add note }

     { section with header and settings }
     { header before area listing }

     InitTokens (_F);

     {## set tokens for text file}

     IF (NOT AddFileToBody ('NOTIFY_F.TXT')) THEN
     BEGIN
          { manual FTN settings }
          MsgsAddLineTo (Body,'Address:          '+Fido2Str (UserRec.Address));
          MsgsAddLineTo (Body,'Export AKA:       '+Fido2Str (OurAddr));
          MsgsAddLineTo (Body,'Allowed groups:   '+BuildGroupListDesc (UserRec.Groups,255));
          MsgsAddLineTo (Body,'Passive:          '+NoYesStrs[UserRec.Passive]);
          MsgsAddLineTo (Body,'Notifications:    '+NoYesStrs[UserRec.Notify_F]);

          IF UserRec.AllowFrom THEN
             MsgsAddLineTo (Body,'%FROM allowed:    '+NoYesStrs[UserRec.AllowFrom]);

          MsgsAddLineTo (Body,'PKT password:     "'+UserRec.PacketPwd+'"');
          MsgsAddLineTo (Body,'Areafix password: "'+UserRec.AreaFixPwd+'"');
          MsgsAddLineTo (Body,'Send format:      '+SendStrs[UserRec.SendFormat]);
          MsgsAddLineTo (Body,'Compression:      '+ComprDescr[UserRec.Compression]);
          MsgsAddLineTo (Body,'PKT limit:        '+Longint2String (UserRec.MaxPktLength));
          MsgsAddLineTo (Body,'Archive limit:    '+Longint2String (UserRec.MaxArcLength));
          MsgsAddLineTo (Body,'');
     END;

     { area listing }
     UserInfo:=UserRec;
     Notify_AddAreaListing;

     DeliverNow;
     MsgsEmpty;
END;


{--------------------------------------------------------------------------}
{ Newsfix_SendNotification                                                 }
{                                                                          }
{ This routine sends a notification message to a UUCP user.                }
{                                                                          }
PROCEDURE Newsfix_SendNotification (VAR UserRec : UserBaseRecord);

CONST ComprDescr_U : ARRAY[UseCompressType] OF STRING[5] = ('None','Compress','GZip');

BEGIN
     RFC_StartSingleRecipientMessage ('postmaster@'+UserRec.Domains[1],
                                      Config.NewsfixName+'@'+Config.Domains[1],
                                      Config.NewsfixName,
                                      Config.NewsfixName+' notification');

     { section with header and settings }
     { header before area listing }

     InitTokens (_U);

     {## set tokens for text file}

     IF (NOT AddFileToBody ('NOTIFY_U.TXT')) THEN
     BEGIN
          { manual UUCP settings }

          MsgsAddLineTo (Body,'UUCP name:        "'+UserRec.UUCPName+'"');
          MsgsAddLineTo (Body,'Allowed groups:   '+BuildGroupListDesc (UserRec.Groups,255));
          MsgsAddLineTo (Body,'Passive:          '+NoYesStrs[UserRec.Passive]);
          MsgsAddLineTo (Body,'Notifications:    '+NoYesStrs[UserRec.Notify_U]);

          IF UserRec.AllowFrom THEN
             MsgsAddLineTo (Body,'%FROM allowed:    '+NoYesStrs[UserRec.AllowFrom]);

          MsgsAddLineTo (Body,'Newsfix password: "'+UserRec.AreaFixPwd+'"');
          MsgsAddLineTo (Body,'Compression:      '+ComprDescr_U[UserRec.Compress]);
          MsgsAddLineTo (Body,'CunBatch:         '+NoYesStrs[UserRec.CunBatch]);
          MsgsAddLineTo (Body,'MailGrade:        '+UserRec.MailGrade);
          MsgsAddLineTo (Body,'NewsGrade:        '+UserRec.NewsGrade);
          MsgsAddLineTo (Body,'');

          (*
          AllowSubDomains : BOOLEAN;
          Domains      : ARRAY[1..MaxUserDomains] OF STRING[MaxLenDomain];
          *)
     END;

     { area listing }
     UserInfo:=UserRec;
     Notify_AddAreaListing;

     DeliverNow;
     MsgsEmpty;
END;


{--------------------------------------------------------------------------}
{ SendNotificationMessages                                                 }
{                                                                          }
{ This routine sends a notification message to all users with information  }
{ about their settings and subscriptions.                                  }
{                                                                          }
PROCEDURE SendNotificationMessages;

VAR UserLp  : UserBaseRecordNrType;
    UserRec : UserBaseRecord;
    Found   : BOOLEAN;

BEGIN
     LogMessage (liTrivial,'NOTIFY start');

     Found:=FALSE;

     FOR UserLp:=1 TO UserBaseRecCount DO
     BEGIN
          ReadUserBaseRecord (UserLp,UserRec);

          IF (NotifyArgument = '') THEN
          BEGIN
               CASE UserRec.System OF
                    _F : IF UserRec.Notify_F THEN
                            AreaFix_SendNotification (UserRec);

                    _SOUP,
                    _U : IF UserRec.Notify_U THEN
                            Newsfix_SendNotification (UserRec);
               END; { case }

               Found:=TRUE;
          END ELSE
          BEGIN
               IF (UserRec.System = _F) AND
                  CaselessMatch (NotifyArgument,Fido2Str (UserRec.Address)) THEN
               BEGIN
                    AreaFix_SendNotification (UserRec);
                    Found:=TRUE;
               END;

               IF (UserRec.System IN [_U,_SOUP]) AND
                  CaselessMatch (NotifyArgument,UserRec.UUCPName) THEN
               BEGIN
                    Newsfix_SendNotification (UserRec);
                    Found:=TRUE;
               END;
          END;
     END; { for }

     IF (NOT Found) THEN
        LogMessage (liFatal,'No user matched "'+NotifyArgument+'"');

     NotifyArgument:='';

     LogMessage (liTrivial,'NOTIFY finished');
END;

{---------------------------------------------------------------------------}
{ IsAreafixName                                                             }
{                                                                           }
{ Returns TRUE if the specified string matches any of the Areafix names     }
{ set in Wtrconf.                                                           }
{                                                                           }
FUNCTION IsAreafixName (Name: STRING): BOOLEAN;
VAR
     Lp   : INTEGER;

BEGIN
     FOR Lp := 1 TO MaxAreafixNames DO
          IF (CaselessMatch (Name, Config.AreafixNames [Lp])) THEN
          BEGIN
               IsAreafixName := TRUE;
               Exit;          { ## EXIT ## }
          END;

     IsAreafixName := FALSE;
     Exit;
END;

{--------------------------------------------------------------------------}
{ Unit Initialisation                                                      }
{                                                                          }
BEGIN
     RulesToSend.Init (SizeOf (AreaBaseRecordNrType),NIL);
     NotifyArgument:='';
END.
