UNIT Fido;

{ Routines voor Fido }

{ History:

MD   30-01-93 Eerste werkende versie.

}


{ Verwijder de $ als je niet wilt dat gecomprimeerde fido pakketen }
{ verwijderd worden door WtrGate                                   }

{$i platform.inc}

{$DEFINE DeleteFidoArchives}

INTERFACE

USES Ramon,
     Database,
     Msgs;

CONST OurFidoProductCode = 254;  { "Product without code" }
      OurFidoRevLevel    = 1;

      MSGPRIVATE = $0001;            { private message,        }
      MSGCRASH   = $0002;            { accept for forwarding   }
      MSGREAD    = $0004;            { read by addressee       }
      MSGSENT    = $0008;            { sent OK (remote)        }
      MSGFILE    = $0010;            { file attached to msg    }
      MSGFWD     = $0020;            { being forwarded         }
      MSGORPHAN  = $0040;            { unknown dest node       }
      MSGKILL    = $0080;            { kill after mailing      }
      MSGLOCAL   = $0100;            { FidoNet vs. local       }
      MSGHOLD    = $0200;            { Hold for pickup         }
      MSGXX2     = $0400;            { STRIPPED by FidoNet<tm> }
      MSGFRQ     = $0800;            { file request            }
      MSGRRQ     = $1000;            { receipt requested       }
      MSGCPT     = $2000;            { is a return receipt     }
      MSGARQ     = $4000;            { audit trail requested   }
      MSGURQ     = $8000;            { update request          }

      { FSC - 0053 proposal extended flags }

      EXTMSGPVT  = $00000001;     { Private }
      EXTMSGHLD  = $00000002;     { Hold }
      EXTMSGCRA  = $00000004;     { Crash }
      EXTMSGK_S  = $00000008;     { Kill/Sent }
      EXTMSGSNT  = $00000010;     { Sent }
      EXTMSGRCV  = $00000020;     { Received }
      EXTMSGA_S  = $00000040;
      EXTMSGDIR  = $00000080;     { Direct }
      EXTMSGZON  = $00000100;
      EXTMSGHUB  = $00000200;
      EXTMSGFIL  = $00000400;
      EXTMSGFRQ  = $00000800;     { FREQ }
      EXTMSGIMM  = $00001000;
      EXTMSGXMA  = $00002000;
      EXTMSGKFS  = $00004000;     { Kill File/Sent }
      EXTMSGTFS  = $00008000;
      EXTMSGLOK  = $00010000;     { Locked }
      EXTMSGRRQ  = $00020000;
      EXTMSGCFM  = $00040000;
      EXTMSGHIR  = $00080000;
      EXTMSGCOV  = $00100000;
      EXTMSGSIG  = $00200000;
      EXTMSGLET  = $00400000;

CONST NullAdres : FidoAddrType = (Zone   : 0;
                                  Net    : 0;
                                  Node   : 0;
                                  Point  : 0;
                                  Domain : '');

TYPE FidoAddrString = STRING[MaxLenFidoAddrString];
     FidoDateType   = STRING[20];

     KludgesType   = (klNone,
                      klArea{deze moet de tweede zijn},
                      klSeenby,klOrigin,klTear,
                      { above: not starting with #1;   }
                      {        klArea should be first! }
                      {        klTear should be last!  }
                      { below: starting with #1;       }
                      {        klPath should be first! }
                      {        klUnknownCtrlA should be last! }
                      klPath,klMsgId,
                      klIntl,klToPt,klFmPt,klVia,
                      klFlags,klPid,klTid,klReply,
                      klWtrBadArea,klWtrBadReason,
                      klReplyAddr,klReplyTo,
                      klChrs,klCharset,klChars,
                      klGatedOrigin,
                      klGwPath,
                      klUnknownCtrlA{deze moet de laatste zijn});

     FidoMsgStatus = (FidoMsgNormal,FidoMsgCrash);

CONST Extensions : ARRAY[0..6] OF STRING[2] = ('SU','MO','TU','WE','TH','FR','SA');

VAR FidoTear       : STRING;
    PrevKludgeID   : KludgesType;
    PrevWhereTo    : WhereToType;
    Found_Path,
    Found_SeenBy,
    Found_Origin,
    Found_Tear     : BOOLEAN;
    OurAkaIndex    : 0..MaxAkas;  { set by FidoOurAdres }

{ Fido hoofd routines }
PROCEDURE FidoToss;

{ Fido Adres functies }
FUNCTION  Fido2Str (Adres : FidoAddrType) : FidoAddrString;
FUNCTION  Fido23DStr (Adres : FidoAddrType ) : FidoAddrString;
FUNCTION  FidoCompare (Adres1,Adres2 : FidoAddrType) : BOOLEAN;
PROCEDURE FidoSplit (Adres : FidoAddrString; VAR FAdr : FidoAddrType);
PROCEDURE FidoMergeAdres (FillAdres : FidoAddrType ; VAR Adres : FidoAddrType );
FUNCTION  FidoMinimal (One , Two : FidoAddrType ) : String;
FUNCTION  FidoOurAdres (Adres : FidoAddrType) : BOOLEAN;
FUNCTION  FidoOurPoint (User : FidoAddrType) : BOOLEAN;
PROCEDURE FidoMatch (Adres1 : FidoAddrType; VAR Adres2 : FidoAddrType);
FUNCTION  FidoMatchAdres (Adres1 : FidoAddrType; VAR Adres2 : FidoAddrType) : AkaIndexType;
FUNCTION  FidoMatchAKA (Adres : FidoAddrType) : AkaIndexType;
FUNCTION  FidoGetZoneDomain (Zone : WORD) : STRING;
FUNCTION  FidoGetOtherPointAdres (Search : FidoAddrType; VAR Search2 : FidoAddrType) : BOOLEAN;
FUNCTION  FidoMapPoint (VAR Adres : FidoAddrType; ToUserName : STRING) : BOOLEAN;

{ Fido Tijd functies  }
FUNCTION  FidoCorrectDate (Date : FidoDateType) : FidoDateType;
FUNCTION  FidoCurrTime2Str : FidoDateType;
FUNCTION  FidoTime2Str (Day,Months,Year,Hours,Minutes,Seconds : WORD) : FidoDateType;

{ Fido bericht functies }
PROCEDURE FTN_CreateNetmail (FromAddr : FidoAddrType; FromUser,Subject : STRING);
PROCEDURE FTN_PushAndBuildReply (Subject : STRING; FromAka : BYTE; FromName : STRING);
PROCEDURE FTN_CreateBounceBody;
PROCEDURE FTN_Bounce (Reason : STRING; FromName, WasAddressedTo : STRING);
PROCEDURE FTN_BounceTo (Reason : STRING; FromName, WasAddressedTo : STRING;
                        RemoteGW : BOOLEAN; ToName : STRING; ToAka : FidoAddrType; ToEmail : STRING);

{ Fido Kludge functies }
PROCEDURE FidoGetPntNr (Kludge : STRING; VAR PointNr : WORD);
FUNCTION  FidoBuildOrigin (Tekst : STRING; Adres : FidoAddrType) : STRING;
FUNCTION  FidoCreateSplitLine (SplitCurrent, SplitParts : WORD) : STRING;
PROCEDURE FidoIntl2Adres (Kludge : STRING; VAR AdresTo,AdresFm : FidoAddrType);
FUNCTION  FidoMsgId2Adres (Kludge : STRING; VAR Addr : FidoAddrType) : STRING;

{ FTC-0053 Flag support }
PROCEDURE FidoAddToExtFlag (Flag : LONGINT);
PROCEDURE FidoExportExtFlag;
PROCEDURE FidoImportExtFlag (Invoer : STRING);

PROCEDURE FidoAddLineToMessage (Regel : STRING; VAR LastRegel : STRING);
PROCEDURE FidoAddLastLine (VAR LastRegel : STRING);
PROCEDURE FidoAddPath (Old : STRING; VAR AreaBase : AreaBaseRecord);
FUNCTION  FidoGetKludgeID (Regel : STRING) : KludgesType;
FUNCTION  GetFidoPktName : HexLongString;
PROCEDURE FidoCreateRegTearLine;
FUNCTION  FidoGetExtension (ArchiveName : STRING; UserBaseRecNr : UserBaseRecordNrType; OutboundDir : STRING) : STRING;

FUNCTION  FidoCheckNetmail (IsPrimaryNetmailArea : BOOLEAN; ToUser : STRING; ToAka : FidoAddrType) : BOOLEAN;
PROCEDURE FidoFinishEchomailExport (VAR AreaData : AreaBaseRecord);

PROCEDURE FidoMakeNormalAdres (VAR Ad : FidoAddrType);


IMPLEMENTATION

USES Globals,
     Cfg,
     Dos,
     Squish,
     Crt,
     FBuffer,
     DupeChk,
     AreaBase,
     Strings,
     ReadRout,
     Routing,
     NewExec,
     {Stats,}
     AreaMgr,
     MsgUtil,
     {Translat,}
     Usenet,
     TextFile,
     UUCPRout,
     FidoMsg,
     FD,
     ListSrv,
     Gateway,
     Logs,
     SwapMem,
     UserBase,
     JAM,
     {PCBoard,}
     Decode,
     Start,
     Language,
     UU,
     BBSUsers,
     {WildCat,}
     BBS_if,
     SeenBy,
     RunCfg,
     Address,
     Deliver,
     CharSets,
     FidoPkt,
     FlexTdb;

CONST MaxSeenByInMemory = 100;   { Maximum seenby regels dat in het geheugen }
                                 { wordt bewaard.                            }

      KludgeNames : ARRAY[KludgesType] OF STRING[10] =
                    {None}   ('',

                             { LET OP: volgende kludges hebben geen #1 }
                             { LET OP: klArea moet de eerste zonder #1 zijn }
                    {Area}    'AREA:',
                    {Seenby}  'SEEN-BY:',
                    {Origin}  ' * Origin:',
                    {Tear}    '---',
                             { LET OP: klTear moet de laatste zonder #1 zijn }
                    {Path}    #1'PATH:',
                    {MsgId}   #1'MSGID:',
                    {Intl}    #1'INTL',
                    {ToPt}    #1'TOPT',
                    {FmPt}    #1'FMPT',
                    {Via}     #1'VIA',    { RvdW 31-03-93 uit MD's FIDO.PAS }
                    {Flags}   #1'FLAGS',  { FTS-0053         }
                    {PID}     #1'PID:',
                    {TID}     #1'TID:',
                    {Reply}   #1'REPLY:',
                    {WtrBad}  #1'WTRBAD_AREA:',
                              #1'WTRBAD_REASON:',
                              #1'REPLYADDR',
                              #1'REPLYTO',
                              #1'CHRS:',
                              #1'CHARSET:',
                              #1'CHARS:',
                              ' # Origin:',
                              #1'GPTH:',
                    {Unknown} #1);        { onbekende CTRL-A }

VAR FidoPktNaamTeller : LONGINT;

{--------------------------------------------------------------------------}
{ FidoMatchAdres                                                           }
{                                                                          }
{ Zoekt ons AKA adres dat het dichtst bij Adres1 ligt en geeft dat terug   }
{ in Adres2.                                                               }
{
{ RWI 950816: toevoeging van controle op domain. Als een domain in Adres1  }
{             zit, dan worden eerst alle AKA's bekeken die ook dat domain  }
{             hebben en daaruit wordt daarna de beste genomen. Als dat     }
{             niets oplevert, dan wordt alsnog gewoon gezocht.             }
{             Bij het gewone zoeken moet minimaal de zone overeen komen en }
{             eventueel ook het net nummer, node nummer en point nummer.   }
{             De AKA met de meeste matches wordt het.                      }
{                                                                          }
{ Concluderend:                                                            }
{                                                                          }
{ Level   Matches                                                          }
{   0     geen                                                             }
{   1     zone                                                             }
{   2     zone+pointnet                                                    }
{   3     zone+net                                                         }
{   4     zone+net+node                                                    }
{   5     zone+net+node+point                                              }
{   6     domain                <-- die is belangrijk!                     }
{   7     domain+zone                                                      }
{   8     domain+zone+pointnet                                             }
{   9     domain+zone+net                                                  }
{   10    domain+zone+net+node                                             }
{   11    domain+zone+net+node+point                                       }
{                                                                          }
FUNCTION FidoMatchAdres (Adres1 : FidoAddrType; VAR Adres2 : FidoAddrType) : AkaIndexType;

VAR AkaLp,
    AkaSelect : AkaIndexType;
    Level,
    Level_C   : BYTE;

BEGIN
     Level:=0;

     IF (Adres1.Domain <> '') THEN
     BEGIN
          Adres1.Domain:=UpCaseString (Adres1.Domain);

          FOR AkaLp:=1 TO MaxAKAs DO
              WITH Config.NodeNrs[AkaLp] DO
                   IF (UpCaseString (Domain) = Adres1.Domain) THEN
                   BEGIN
                        Level_C:=6;

                        { domain match }
                        IF (Adres1.Zone = Zone) OR (Adres1.Zone = 0) THEN
                        BEGIN
                             Level_C:=7;

                             IF ((Adres1.Net = Config.PointNets[AkaLp]) AND (Adres1.Net <> 0)) THEN
                                Level_C:=8;

                             IF (Adres1.Net = Net) THEN
                             BEGIN
                                  Level_C:=9;

                                  IF (Adres1.Node = Node) THEN
                                  BEGIN
                                       Level_C:=10;

                                       IF (Adres1.Point = Point) THEN
                                          Level_C:=11;
                                  END; { node }
                             END; { net }
                        END; { zone }

                        IF (Level_C > Level) THEN
                        BEGIN
                             Level:=Level_C;
                             AkaSelect:=AkaLp;
                        END;

                   END; { if, with, for }

     END; { adres1 has a domain name }

     { loop al onze AKAs af }
     FOR AkaLp:=1 TO MaxAkas DO
         WITH Config.NodeNrs[AkaLp] DO
         BEGIN
              Level_C:=0;

              IF (Adres1.Zone = Zone) OR (Adres1.Zone = 0) THEN
              BEGIN
                   Level_C:=1;

                   { als nu ook het Fakenet adres nog klopt zijn we er }
                   IF ((Adres1.Net = Config.PointNets[AkaLp]) AND (Adres1.Net <> 0)) THEN
                      Level_C:=2;

                  { meestal zal het niet zo mooi gaan }
                  IF (Adres1.Net = Net) THEN
                  BEGIN
                       Level_C:=3;

                       IF (Adres1.Node = Node) THEN
                       BEGIN
                            Level_C:=4;

                            { Point ook? }
                            { RWI 950514: Yep. Nodig voor pakket afzender }
                            IF (Adres1.Point = Point) THEN
                               Level_C:=5;

                       END; { node }
                  END; { net }
              END; { zone }

              IF (Level_C > Level) THEN
              BEGIN
                   Level:=Level_C;
                   AkaSelect:=AkaLp;
              END;
         END; { with, for }

     IF (Level = 0) THEN
        AkaSelect:=1; { use the default }

     Adres2:=Config.NodeNrs[AkaSelect];
     FidoMatchAdres:=AkaSelect;
END;


{--------------------------------------------------------------------------}
{ FidoMatch                                                                }
{                                                                          }
{ Zoekt ons AKA adres dat het dichtst bij Adres1 ligt en geeft dat terug   }
{ in Adres2.                                                               }
{                                                                          }
PROCEDURE FidoMatch (Adres1 : FidoAddrType; VAR Adres2 : FidoAddrType);
BEGIN
     FidoMatchAdres (Adres1,Adres2);
END;


{--------------------------------------------------------------------------}
{ FidoMatchAKA                                                             }
{                                                                          }
{ Zoekt ons AKA adres dat het dichtst bij Adres1 ligt en geeft dat terug.  }
{                                                                          }
FUNCTION FidoMatchAKA (Adres : FidoAddrType) : AkaIndexType;

VAR Dummy : FidoAddrType;

BEGIN
     FidoMatchAKA:=FidoMatchAdres (Adres,Dummy);
END;


{--------------------------------------------------------------------------}
{ FidoGetZoneDomain                                                        }
{                                                                          }
{ This routine searches in our AKAs for the first matching zone and        }
{ returns the domain belonging to that zone, or empty if there is no aka   }
{ with the given zone.                                                     }
{                                                                          }
FUNCTION FidoGetZoneDomain (Zone : WORD) : STRING;

VAR Lp : 1..MaxAkas;

BEGIN
     FOR Lp:=1 TO MaxAkas DO
         IF (Config.NodeNrs[Lp].Zone = Zone) THEN
         BEGIN
              FidoGetZoneDomain:=Config.NodeNrs[Lp].Domain;
              Exit;
         END;

     FidoGetZoneDomain:='';
END;


{--------------------------------------------------------------------------}
{ Fido2Str                                                                 }
{                                                                          }
{ Converteert een FidoAdres type naar een string.                          }
{                                                                          }
{ Minimum is : NODE                                                        }
{ Maximum is : ZONE:NET/NODE.POINT@DOMAIN                                  }
{ 2,512,17,6,'fidonet.org' wordt "2:512/17.6@Fidonet.org"                  }
{                                                                          }
FUNCTION Fido2Str (Adres : FidoAddrType) : FidoAddrString;

VAR StrI : FidoAddrString;

BEGIN
     StrI:='';

     IF (Adres.Zone > 0) THEN { Zone: }
        StrI:=Word2String (Adres.Zone)+':';

     IF (Adres.Net > 0) THEN { Net/ }
        StrI:=StrI+Word2String (Adres.Net)+'/';

     StrI:=StrI+Word2String (Adres.Node);

     IF (Adres.Point > 0) THEN { .Point }
        StrI:=StrI+'.'+Word2String (Adres.Point);

     IF (Adres.Domain <> '') AND (Adres.Domain <> #1#2#3{special internal indication}) THEN
        StrI:=StrI+'@'+Adres.Domain;

     Fido2Str:=StrI;
END;


{--------------------------------------------------------------------------}
{ Fido2/3DString                                                           }
{                                                                          }
{ Deze routine laadt alle Domain gedoe achterwege, voor de rest gelijkt    }
{ aan de vorige. Voor het exporteren naar nodes die geen domainen onder    }
{ steunen, (ook export naar externe configs)                               }
{                                                                          }
FUNCTION Fido23DStr (Adres : FidoAddrType) : FidoAddrString;

VAR StrI : FidoAddrString;

BEGIN
     StrI:='';

     IF (Adres.Zone > 0) THEN { Zone: }
        StrI:=StrI+Word2String (Adres.Zone)+':';

     IF (Adres.Net > 0) THEN { Net/ }
        StrI:=StrI+Word2String (Adres.Net)+'/';

     StrI:=StrI+Word2String (Adres.Node);

     Fido23DStr:=StrI;
END;


{--------------------------------------------------------------------------}
{ FidoSplit                                                                }
{                                                                          }
{ Deze procedure splits een volledige Fidonet adres string in partjes      }
{ uiteen. '2:512/17.6@Fidonet.org' wordt (2,512,17,6,'Fidonet.org')        }
{                                                                          }
{ ":" missing, then Zone 0                                                 }
{ "@" missing, then empty Domain                                           }
{ "." missing, then Point 0                                                }
{ "/" missing, then Net 0                                                  }
{ Rest: Node                                                               }
{                                                                          }
PROCEDURE FidoSplit (Adres : FidoAddrString; VAR FAdr : FidoAddrType);

VAR P     : BYTE;
    Error : ValNop;

BEGIN
     Adres:=DeleteBackSpaces (Adres);

     { zone }
     P:=Pos (':',Adres);
     IF (P > 0) THEN
     BEGIN
          Val (Copy (Adres,1,P-1),FAdr.Zone,Error);
          Delete (Adres,1,P);
     END ELSE
         FAdr.Zone:=0;

     { domain naam }
     P:=Pos ('@',Adres);
     IF (P > 0) THEN
     BEGIN
          FAdr.Domain:=Copy (Adres,P+1,Length (Adres)-P);
          Delete (Adres,P,Length (Adres)-P+1);
     END ELSE
         FAdr.Domain:='';

     { point }
     P:=Pos ('.',Adres);
     IF (P > 0) THEN
     BEGIN
          Val (Copy (Adres,P+1,Length (Adres)-P),FAdr.Point,Error);
          Delete (Adres,P,Length (Adres)-P+1);
     END ELSE
         FAdr.Point:=0;

     { net }
     P:=Pos ('/',Adres);
     IF (P > 0) THEN
     BEGIN
          Val (Copy (Adres,1,P-1),FAdr.Net,Error);
          Delete (Adres,1,P);

          { Val (Copy (Adres,P+1,Length (Adres)-P),FAdr.Node,Error);
            Delete (Adres,P,Length (Adres)-P+1); }
     END ELSE
         FAdr.Net:=0;

     { node }
     Val (Adres,FAdr.Node,Error);
END;


{--------------------------------------------------------------------------}
{ FidoCompare                                                              }
{                                                                          }
{ Deze routine vergelijkt 2 fido adressen en, geeft TRUE bij gelijk en     }
{ FALSE bij verschil. De domain namen worden niet vergeleken.              }
{                                                                          }
{ RvdW 04-04-93 Uitgebreid met vergelijking op 0 in zone, node en point.   }
{               Hierdoor zijn 280/802 en 2:280/802 ook gelijk.             }
{                                                                          }
{ MD   18-06-93 Bugfix, door de vergelijking met 0 was voor Wtrgate        }
{               2:280/802 == 2:280/802.6 , wat enige problemen gaf...      }
{ MD   10-09-93 Vergelijk ook domain adres, als beide adressen een domain  }
{               hebben.                                                    }
{ MD   14-05-94 Vergelijking van NODE=0 ging niet op bij 60:100/0 :)       }
{                                                                          }
FUNCTION FidoCompare (Adres1,Adres2 : FidoAddrType) : BOOLEAN;
BEGIN
     FidoCompare:=(Adres1.Zone  = Adres2.Zone) AND
                  (Adres1.Net   = Adres2.Net) AND
                  (Adres1.Node  = Adres2.Node) AND
                  (Adres1.Point = Adres2.Point);
END;


{--------------------------------------------------------------------------}
{ FidoTime2Str                                                             }
{                                                                          }
{ Deze routine zet de opgegeven dag,maand,jaar,uur,minuut en seconde om in }
{ een tijd/datum string volgens fido conventies: "01 jan 93  19:15:50"     }
{                                                                          }
FUNCTION FidoTime2Str (Day,Months,Year,Hours,Minutes,Seconds : WORD) : FidoDateType;

TYPE Pre0sString = STRING[2];

   { Pre0s                                      }
   {                                            }
   { Zorgt dat '1' vertaald wordt in '01'       }

   FUNCTION Pre0s (Getal : BYTE) : Pre0sString;

   VAR Tmp : Pre0sString;

   BEGIN
        Tmp:=Byte2String (Getal);
        IF (Getal < 10) THEN
           Tmp:='0'+Tmp;
        Pre0s:=Tmp;
   END;

{FidoTime2Str}
BEGIN
     Year:=Year MOD 100;   { remove "19xx" or "20xx", etc. }

     FidoTime2Str:=Pre0s (Day)+' '+
                   Month[Months]+' '+
                   Pre0s (Year)+'  '+ { RvdW 02-04-93 twee spaties van gemaakt }
                   Pre0s (Hours)+':'+
                   Pre0s (Minutes)+':'+
                   Pre0s (Seconds);
END;


{--------------------------------------------------------------------------}
{ FidoCurrTime2Str                                                         }
{                                                                          }
{ Deze routine haalt de huidige systeem datum en tijd op en geeft die      }
{ terug in het Fido formaat.                                               }
{                                                                          }
FUNCTION FidoCurrTime2Str : FidoDateType;

VAR Hours,Mins,Secs,
    Year,Month,Day,
    Nop             : WordLong;

BEGIN
     GetTime (Hours,Mins,Secs,Nop);
     GetDate (Year,Month,Day,Nop);
     FidoCurrTime2Str:=FidoTime2Str (Day,Month,Year,Hours,Mins,Secs);
END;


VAR FVLIP_LineNr,
    FVLIP_LastVIAorRECD : WORD;

{--------------------------------------------------------------------------}
{ ViaLine_FindInsertPosition                                               }
{                                                                          }
{ This routine is called for each line in the footer. It tries to find the }
{ last VIA or RECD line and keeps track of it by counting the lines.       }
{                                                                          }
FUNCTION ViaLine_FindInsertPosition (VAR OrigRegel : STRING) : BOOLEAN; FAR;
BEGIN
     ViaLine_FindInsertPosition:=FALSE; { don't stop calling me }

     Inc (FVLIP_LineNr);

     IF CaselessStartMatch (OrigRegel,#1+'VIA: ') OR
        CaselessStartMatch (OrigRegel,#1+'RECD: ')
     THEN
         FVLIP_LastVIAorRECD:=FVLIP_LineNr;
END;


{--------------------------------------------------------------------------}
{ AddViaLineNow                                                            }
{                                                                          }
{ This routine creates and adds the VIA line to the Footer_F block.        }
{                                                                          }
PROCEDURE AddViaLineNow;

VAR U,M,S,H      : WordLong;
    Ye,Mo,Da,Dow : WordLong;
    Via          : STRING;
    MatchAddr    : FidoAddrType;

BEGIN
     { find our AKA closest to the From aka }
     FidoMatchAdres (Msg.FromAddr_F,MatchAddr);

     { do not add a Via kludge when the message originated here }
     { what the hell! FastEcho does it too! I can image that FD
       wouldn't add one when the msg is written with FM. We always
       add it, no matter what!
     IF FidoCompare (Msg.FromAddr_F,MatchAddr) THEN
        Exit;
     }

     { Via 1:320/42@fidonet @19970803.063220 FrontDoor 2.12.SW }
     { Via 1:320/119@fidonet @19970803.104529.UTC O/T-Track+ 2.63 }
     { Via 1:320/119 @19970803.104532.UTC FastEcho 1.46.1 10045 }
     { Via 2:200/111.15 @19970824.203000 WtrGate 0.94.p1 657 }

     GetTime (H,M,S,U);
     GetDate (Ye,Mo,Da,Dow);

     Via:=#1+'Via '+
          Fido2Str (MatchAddr)+
          ' @'+AddUpWithPre0s (4,Word2String (Ye))+
               AddUpWithPre0s (2,Byte2String (Mo))+
               AddUpWithPre0s (2,Byte2String (Da))+
          '.'+AddUpWithPre0s (2,Byte2String (H))+
              AddUpWithPre0s (2,Byte2String (M))+
              AddUpWithPre0s (2,Byte2String (S))+
          ' '+ProgramShortName+
          ' '+MainRevisionNr;

     IF (RegKeyNumber < $FFFE) THEN
        Via:=Via+' '+Word2String (RegKeyNumber);

     MsgsAddLineTo (Footer_F,Via);
END;


{--------------------------------------------------------------------------}
{ ViaLine_InsertLine                                                       }
{                                                                          }
{ This routine is called for each line in the footer.                      }
{                                                                          }
FUNCTION ViaLine_InsertLine (VAR OrigRegel : STRING) : BOOLEAN; FAR;
BEGIN
     ViaLine_InsertLine:=FALSE; { don't stop calling me }

     MsgsAddLineToNoEOL (Footer_F,OrigRegel);
     Inc (FVLIP_LineNr);

     IF (FVLIP_LineNr >= FVLIP_LastVIAorRECD) THEN
     BEGIN
          FVLIP_LastVIAorRECD:=65535;  { avoid the if from triggering again }
          AddViaLineNow;
     END;
END;


{--------------------------------------------------------------------------}
{ AddViaLine                                                               }
{                                                                          }
{ This routine checks if it is a good idea to add a Via kludge to this     }
{ message and then builds and adds it. Adding is done directly after the   }
{ last VIA or RECD line.                                                   }
{                                                                          }
PROCEDURE AddViaLine;

VAR OldTop : TopRegelRecordPtr;

BEGIN
     IF NOT (Msg.Ready_F IN [NotReady,Netmail,Local_Netmail]) THEN
        Exit;

     FVLIP_LineNr:=0;
     FVLIP_LastVIAorRECD:=0;

     MsgsForEach (Msg.FooterTop_F,ViaLine_FindInsertPosition);

     IF (FVLIP_LastVIAorRECD = 0) THEN
        FVLIP_LastVIAorRECD:=FVLIP_LineNr;

     {
     LogMessage (liDebug,'AddViaLine: LineCount='+Word2String (FVLIP_LineNr)+
                         ', LastVIAorRCVD='+Word2String (FVLIP_LastVIAorRECD));
     }

     OldTop:=Msg.FooterTop_F;
     Msg.FooterTop_F:=NIL;
     FVLIP_LineNr:=0;
     MsgsForEachKill (OldTop,ViaLine_InsertLine);

     { if not added yet (happens in case of empty footer), then add now }
     IF (FVLIP_LastVIAorRECD <> 65535) THEN
        AddViaLineNow;
END;


{--------------------------------------------------------------------------}
{ FidoMsgId2Adres                                                          }
{                                                                          }
{ Deze routine vertaalt de opgegeven regel waarop de volgende kludge staat }
{    ^AMSGID <orig adr> <ID>                                               }
{ <orig adr> is het adres van de node waarvan het bericht af komstig is.   }
{ <ID> moet voor die node lange tijd uniek zijn! (??)                      }
{                                                                          }
{ Deze routine haalt <orig adr> uit de kludgelijn en slaat het op in het   }
{ universele bericht waarvan het veld moet zijn opgegeven.                 }
{                                                                          }
{ RWI 950605: Het ID zelf wordt nu terug gegeven, zodat deze opgeslagen    }
{             kan worden in de Msg structuur en gebruikt kan worden om in  }
{             een vertaald bericht te stoppen.                             }
{                                                                          }
{ RWI 960604: <orig adr> is no longer interpreted and used / returned.     }
{ RWI 960822: restored. Now tries to extract the Zone ONLY!                }
{ RWI 961102: MSGID is belangrijk in geval van ECHOMAIL. Dat is in dat     }
{             geval soms de enige source voor de ZONE en POINT info. We    }
{             controleren daarom de net en node combinatie en voegen dan   }
{             de zone en point info toe.                                   }
{                                                                          }
FUNCTION FidoMsgId2Adres (Kludge : STRING; VAR Addr : FidoAddrType) : STRING;

VAR P    : BYTE;
    Nr   : WORD;
    Nop  : ValNop;
    Fad  : FidoAddrType;

BEGIN
     { haal de kludge weg }
     Delete (Kludge,1,Pos (' ',Kludge));

     P:=Pos (' ',Kludge);

     IF (P > 0) THEN
     BEGIN
          FidoSplit (Copy (Kludge,1,P-1),Fad);
          IF (Fad.Net = Addr.Net) AND (Fad.Node = Addr.Node) THEN
          BEGIN
               IF (Addr.Zone = 0) THEN
                  Addr.Zone:=Fad.Zone;

               IF (Addr.Point = 0) THEN
                  Addr.Point:=Fad.Point;

               IF (Addr.Domain = '') THEN
                  Addr.Domain:=Fad.Domain;
          END;
     END;

     (*
     { RWI 960821: volgende toegevoegd om zone nummer te krijgen voor }
     {             het geval de INTL er niet was.                     }
     IF (Addr.Zone = 0) AND (Kludge[1] IN ['0'..'9']) AND (Pos (':',Kludge) > 0) THEN
     BEGIN
          Val (Copy (Kludge,1,Pos (':',Kludge)-1),Nr,Nop);
          IF (Nop = 0) THEN
             Addr.Zone:=Nr;
     END;
     *)

     (*
     VAR Back : FidoAddrString;
         Part : STRING;

     IF (Kludge[1] IN ['0'..'9']) THEN
     BEGIN
          Part:=Copy (Kludge,1,P-1);

          FidoSplit (Part,AdresFm);
          Back:=Fido2Str (AdresFm);

          IF (Part <> Back) AND (Part <> Back+'.0') THEN
          BEGIN
               LogExtraMessage ('Suspected "'+Fido2Str (AdresFm)+'" wrong (from "'+Kludge+'")');
               AdresFm.Zone:=0;
               AdresFm.Net:=0;
               AdresFm.Node:=0;
               AdresFm.Point:=0;
               AdresFm.Domain:='';
          END;
     END ELSE
     BEGIN
          { waarschijnlijk geen Fido style adres }
          AdresFm.Zone:=0;
          AdresFm.Net:=0;
          AdresFm.Node:=0;
          AdresFm.Point:=0;
          AdresFm.Domain:='';
     END;
     *)

     { haal eventuele enters aan het einde van de regel weg, want die }
     { willen we niet in het ID hebben.                               }
     WHILE (Kludge[Length (Kludge)] = #13) DO
           Delete (Kludge,Length (Kludge),1);

     { if P=0, returns entire string }
     FidoMsgId2Adres:=Copy (Kludge,P+1,255);
END;


{--------------------------------------------------------------------------}
{ FidoIntl2Adres                                                           }
{                                                                          }
{ Deze routine vertaalt de opgegeven regel waarop de volgende kludge staat }
{    ^AINTL <dest Z:N/N> <orig Z:N/N>                                      }
{                                                                          }
{ Used for interzone and standard trafic. Deze routine haalt de Orig en    }
{ Dest adressen uit de kludge lijn en geeft deze terug.                    }
{                                                                          }
{ Bug solve: 31-03-93. Overgenomen uit MD zijn FIDO.PAS: Bij de eerste     }
{ FidoSplit moest achter de Pos () een "-1" komen te staan.                }
{                                                                          }
PROCEDURE FidoIntl2Adres (Kludge : STRING; VAR AdresTo,AdresFm : FidoAddrType);
BEGIN
     Delete (Kludge,1,Pos (' ',Kludge)); { ^AINTL }

     FidoSplit (Copy (Kludge,1,Pos (' ',Kludge)-1),AdresTo);
     Delete (Kludge,1,Pos (' ',Kludge));

     FidoSplit (Kludge,AdresFm);
END;


{--------------------------------------------------------------------------}
{ FidoGetPntNr                                                             }
{                                                                          }
{ Deze routine haalt point nummers uit de opgegeven regel met de volgende  }
{ kludges:                                                                 }
{    ^ATOPT xx                                                             }
{    ^AFMPT xx                                                             }
{                                                                          }
PROCEDURE FidoGetPntNr (Kludge : STRING; VAR PointNr : WORD);

VAR Nop : ValNop;

BEGIN
     Delete (Kludge,1,Pos (' ',Kludge));
     Val (Kludge,PointNr,Nop);
END;


{--------------------------------------------------------------------------}
{ FidoPktNameInit                                                          }
{                                                                          }
{ Creert een nieuwe unieke fido naam, goeie vraag... een 32-bits getal     }
{ uniek ... (zucht). Dit getal wordt bij het opstarten bepaald en daarna   }
{ bij iedere vraag om een nieuwe naam met 1 verhoogd. Het initiele getal   }
{ bestaat uit de Dag,Maand en de computer timer die 24 uur kan tellen.     }
{                                                                          }
PROCEDURE FidoPktNameInit;

VAR Maand,Dag,Nop : WordLong;
    InFile        : TEXT;
    IORes         : BYTE;

BEGIN
     Assign (InFile,'WGSETNR.TST');
     {$I-} Reset (InFile); {$I+} IORes:=IOResult;
     IF (IORes = 0) THEN
     BEGIN
          ReadLn (InFile,FidoPktNaamTeller);
          Close (InFile);
          Exit;
     END;

     GetDate (Nop,Maand,Dag,Nop);

     FidoPktNaamTeller:=GetTimer AND ((1 SHL 22) -1) SHL 2; { 18.2 keer/sec ++ }
     FidoPktNaamTeller:=FidoPktNaamTeller OR (Longint (Dag) SHL 23);
     FidoPktNaamTeller:=FidoPktNaamTeller OR (Longint (Maand) SHL 28);
END;


{--------------------------------------------------------------------------}
{ GetFidoPktName                                                           }
{                                                                          }
{ Deze routine bepaald de naam van het volgende .PKT / .DAT file. De bij   }
{ het opgestarten van het programma bepaalde teller wordt hier met een     }
{ verhoogd en omgezet in een hexadecimale string.                          }
{                                                                          }
{ Functie uitgebreid om unieke 32-bits ^AMSGID's te maken                  }
{ Eigenlijk zou de naam veranderd moeten worden... ik gebruik de routine   }
{ nu voor elk uniek 32-bits getal...                                       }
{ RvdW 31-03-93: Bovenstaande wijziging niet kunnen vinden, alleen opmerk- }
{                ing erbij gezet.                                          }
{ MD   25-06-93: Je keek ook verkeerd, nog nooit naar de code voor de MsgId}
{                routine gekeken <grinnik>                                 }
{                                                                          }
FUNCTION GetFidoPktName : HexLongString;
BEGIN
     Inc (FidoPktNaamTeller);
     { RWI960225: added LoCaseString (ziet er beter uit) }
     GetFidoPktName:=LoCaseString (Long2HexString (FidoPktNaamTeller));
END;


{--------------------------------------------------------------------------}
{ DaysInMonth                                                              }
{                                                                          }
{ The year is in the range 00..99, the month in the range 1..12. We must   }
{ return the number of days in the month for that year. This is rather     }
{ straightforward except for number 2. February has 28 days except when    }
{ the year can be divided by 4. There is an exception for years divideable }
{ by 100 (28 days) but not 400 (29 days). The only year this applies to is }
{ 00 and since we don't know the century, we must assume 2000 and return   }
{ 29 days.                                                                 }
{                                                                          }
FUNCTION DaysInMonth (M,Y : WORD) : BYTE;
BEGIN
     IF (M IN [1,3,5,7,8,10,12]) THEN
     BEGIN
          DaysInMonth:=31;
          Exit;
     END;

     IF (M <> 2) THEN
     BEGIN
          DaysInMonth:=30;
          Exit;
     END;

     IF ((Y MOD 4) = 0) THEN
        DaysInMonth:=29
     ELSE
         DaysInMonth:=28;
END;


{--------------------------------------------------------------------------}
{ FidoCorrectDate                                                          }
{                                                                          }
{ This routine checks and corrects the text-format fido date string. It    }
{ handles errors in the format and errors in the content. The output       }
{ format is guaranteed in the form "dd mmm yy  hh:mm:ss" with the month in }
{ textual format and the spaces and colons as shown.                       }
{                                                                          }
FUNCTION FidoCorrectDate (Date : FidoDateType) : FidoDateType;

VAR S   : STRING;
    P   : BYTE;
    ND  : WORD;
    NM  : BYTE;
    NY  : WORD;
    Nop : ValNop;

BEGIN
     { convert SEADog format "Sat 19 Mar 93 10:45" }
     IF (NOT (Date[1] IN ['0'..'9',' '])) AND (Date[4] = ' ') THEN
        Delete (Date,1,3);    { remove day of week }

     Date:=DeleteFrontAndBackSpaces (Date);

     { if no date at all then take momento now }
     IF (Date = '') THEN
     BEGIN
          FidoCorrectDate:=FidoCurrTime2Str;
          Exit;   { ## EXIT ## }
     END;

     { day }
     P:=Pos (' ',Date);
     IF (P = 0) THEN
     BEGIN
          FidoCorrectDate:=FidoCurrTime2Str;
          Exit;   { ## EXIT ## }
     END;

     Val (Copy (Date,1,P-1),ND,Nop);
     IF (Nop <> 0) THEN
        ND:=1;

     Delete (Date,1,P);
     Date:=DeleteFrontSpaces (Date);

     IF (ND = 0) THEN
        ND:=1;

     IF (ND > 31) THEN
        ND:=31;

     { month }
     S:='';
     FOR NM:=1 TO 12 DO
         IF CaselessStartMatch (Date,Month[NM]) THEN
         BEGIN
              S:=Month[NM];
              Delete (Date,1,3);
              Date:=DeleteFrontSpaces (Date);
              Break;
         END;

     IF (S = '') THEN
     BEGIN
          FidoCorrectDate:=FidoCurrTime2Str;
          Exit; {  ## EXIT ## }
     END;

     { year }
     P:=Pos (' ',Date);
     IF (P = 0) THEN
     BEGIN
          FidoCorrectDate:=FidoCurrTime2Str;
          Exit; {  ## EXIT ## }
     END;

     Val (Copy (Date,1,P-1),NY,Nop);
     IF (Nop <> 0) THEN
     BEGIN
          { try the overflow-date case: 2000-1900=100. }
          { First digit is 10, stored as ":0" because ":" follows the "9". }
          NY:=Ord (Date[1])-Ord ('0');
          Delete (Date,1,1);

          WHILE (Date[1] IN ['0'..'9']) DO
          BEGIN
               NY:=NY*10 + Ord (Date[1])-Ord ('0');
               Delete (Date,1,1);
          END;
     END ELSE
         Delete (Date,1,P);

     Date:=DeleteFrontSpaces (Date);

     NY:=NY MOD 100;

     { check for valid d,m,y combination }
     P:=DaysInMonth (NM,NY);
     IF (ND > P) THEN
        ND:=P;

     S:=AddUpWithPre0s (2,Byte2String (ND))+' '+
        S+' '+  { month }
        AddUpWithPre0s (2,Word2String (NY))+'  ';

     { hours }
     P:=Pos (':',Date);
     IF (P = 0) THEN
     BEGIN
          FidoCorrectDate:=FidoCurrTime2Str;
          Exit; {  ## EXIT ## }
     END;

     Val (Copy (Date,1,P-1),ND,Nop);
     Delete (Date,1,P);
     IF (Nop <> 0) OR (ND > 23) THEN
        ND:=0;

     S:=S+AddUpWithPre0s (2,Word2String (ND))+':';

     { minutes }
     P:=Pos (':',Date);
     IF (P = 0) THEN
     BEGIN
          { support cut-off date or SEADog date when minutes are last }
          P:=Length (Date)+1;
     END;

     Val (Copy (Date,1,P-1),ND,Nop);
     Delete (Date,1,P);
     IF (Nop <> 0) OR (ND > 59) THEN
        ND:=0;

     S:=S+AddUpWithPre0s (2,Word2String (ND))+':';

     { seconds }

     { short seconds should be padded with zeros to correct from }
     { cut-off date                                              }
     Val (Copy (Date+'00',1,2),ND,Nop);
     IF (Nop <> 0) OR (ND > 59) THEN
        ND:=0;

     S:=S+AddUpWithPre0s (2,Word2String (ND));

     FidoCorrectDate:=S;
(*
     {## add support for ">" in date!}

     { RWI 960127: "Sat  01 Jan.." -> "Sat 01 Jan..." }
     IF (Length (Date) = 20) AND (Date[4] = ' ') AND (Date[5] = ' ') THEN
        Delete (Date,5,1);

     { RWI 960127: delete trailing space }
     IF (Length (Date) = 20) AND (Date[20] = ' ') THEN
        Delete (Date,20,1);

     { check for SEADOG format: Sat 19 Mar 93 10:45 }
     IF (Length (Date) = 19) AND (Date[4] =  ' ') AND (Date[7] = ' ') AND
        (Date[11] = ' ') AND (Date[14] = ' ')  AND (Date[17] = ':') THEN
     BEGIN
          { Convert to "19 Mar 93  10:45:00" }
          Delete (Date,1,4);    { dag van de week eraf slopen }
          Insert (' ',Date,10); { dubbele spatie tussen date en time }
          Date:=Date+':00';     { seconden toevoegen }
     END;

     { check for day preceeded by space instead of zero }
     IF (Date[1] = ' ') AND (Date[2] IN ['0'..'9']) THEN
        Date[1]:='0';

     { check for correct date }
     IF (Length (Date) = 19) AND (Date[3] = ' ') AND (Date[7] = ' ') AND
        (Date[10] = ' ') AND (Date[11] = ' ') AND (Date[14] = ':') AND
        (Date[17] = ':') THEN
     BEGIN
          FidoCorrectDate:=Date;
          Exit;   { ## EXIT ## }
     END;

     IF (Pos (':',Copy (Date,Pos (':',Date)+1,255)) = 0) THEN
        Date:=Date+':00'; { seconden toevoegen }

     IF (Date[13] = ':') AND (Date[16] = ':') AND (Date[11] = ' ') THEN
        Date[11]:='0'; { voorloop spatie bij uur }

     IF (Length (Date) = 18) AND (Date[13] = ':') AND (Date[16] = ':') THEN
     BEGIN
          { extra spatie tussen datum en tijd }
          FidoCorrectDate:=Copy (Date,1,10)+' '+Copy (Date,11,8);
          {Inc (FidoProcessStatus.CorrectedCount);}
          {FidoProcessStatusShow;}
          Exit;
     END;

     {LogBad ('Date format error: '+Date);}
     FidoCorrectDate:=Date;
*)
END;


{--------------------------------------------------------------------------}
{ ProcessInboundArchives                                                   }
{                                                                          }
{ Deze routine zoekt in alle inbound directories totdat er een archive     }
{ gevonden wordt met de extensie .SU?,.MO?,.TU? etc. Deze wordt daarna     }
{ uitgepakt en alle .PKT's ervan verwerkt.                                 }
{                                                                          }
PROCEDURE ProcessInboundArchives;

VAR InDirLp     : 1..MaxInboundDirs;
    AnyInbound  : BOOLEAN;
    Search      : SearchRec;
    ReScan,
    Quit        : BOOLEAN;
    Ext         : STRING[3];
    Destination : STRING;
    ArchiveFile : FILE;
    Buffer      : ARRAY[0..6] OF BYTE;
    LastByte    : BYTE;
    IORes       : BYTE;
    Archiver    : CompressionType;
    GoExecHulp  : STRING[MaxLenComprPrgDescr];
    OldDir      : STRING[100];

BEGIN
     AnyInbound:=FALSE;

     FOR InDirLp:=1 TO MaxInboundDirs DO
     BEGIN
          { Optie wel actief ? }
          IF (Config.Inbound_F[InDirLp] = '') THEN
             Continue;

          AnyInbound:=TRUE;

          { eerst de nog aanwezige .PKT's verwerken }
          ProcessInboundPkts (Config.Inbound_F[InDirLp],'PKT',Config.Security_F[InDirLp],NILRecordNr);

          REPEAT
                IF (NOT CheckMinDiskFree) THEN
                   Exit;

                FindFirst (Config.InBound_F[InDirLp]+'*.*',saJustFiles,Search);

                Quit:=TRUE;
                ReScan:=FALSE;
                WHILE (DosError = 0) AND (NOT ReScan) DO
                BEGIN
                     IF (Pos ('.',Search.Name) > 0) THEN
                        Ext:=UpCaseString (Copy (Search.Name,Pos ('.',Search.Name)+1,2))
                     ELSE
                         Ext:='';

                     (* everything is now allowed
                     CASE Config.FidoArcmailExtension OF
                          ArcArc : IF (Ext[Length (Ext)] IN ['0'..'9']) THEN
                                      Delete (Ext,Length (Ext),1);
                          ArcHex : IF (Ext[Length (Ext)] IN ['0'..'9','A'..'F']) THEN
                                      Delete (Ext,Length (Ext),1);
                          ArcAll : IF (Ext[Length (Ext)] IN ['0'..'9','A'..'Z']) THEN
                                      Delete (Ext,Length (Ext),1);
                     END; { case }
                     *)

                     IF (Ext = 'SU') OR (Ext = 'MO') OR (Ext = 'TU') OR
                        (Ext = 'WE') OR (Ext = 'TH') OR (Ext = 'FR') OR
                        (Ext = 'SA') THEN
                     BEGIN
                          {archive detectie}
                          IF (ArchiversPtr^.Unarchive[fctGUS] <> '') THEN
                             Archiver:=fctGUS
                          ELSE
                              Archiver:=fctNone;

                          Assign (ArchiveFile,Config.Inbound_F[InDirLp]+Search.Name);
                          {$I-} Reset (ArchiveFile,1); {$I+} IORes:=IOResult;
                          IF (IORes <> 0) THEN
                             LogDiskIOError (IORes,'Cannot re-open archive '+Config.Inbound_F[InDirLp]+Search.Name)
                          ELSE BEGIN
                               {$IFDEF LogFileIO}PostOpenF (ArchiveFile);{$ENDIF}
                               {$I-}
                               BlockRead (ArchiveFile,Buffer[0],6);
                               Seek (ArchiveFile,FileSize (ArchiveFile)-1);
                               BlockRead (ArchiveFile,LastByte,1);
                               {$IFDEF LogFileIO}PreCloseF (ArchiveFile);{$ENDIF}
                               Close (ArchiveFile);
                               {$I+}
                               IORes:=IOResult;
                               IF (IORes = 0) THEN
                               BEGIN
                                    IF (Buffer[0] = $1A) THEN
                                       Archiver:=fctARC;

                                    IF (LastByte = $FE) THEN
                                       Archiver:=fctPAK;

                                    IF (Buffer[0] = $50) AND (Buffer[1] = $4B) AND
                                       (Buffer[2] = $03) AND (Buffer[3] = $04) THEN
                                       Archiver:=fctZIP;

                                    IF (Buffer[2] = $2D) AND (Buffer[3] = $6C) AND
                                       (Buffer[4] = $68) THEN
                                       Archiver:=fctLZH;

                                    IF (Buffer[0] = $5A) AND (Buffer[1] = $4F) AND
                                       (Buffer[2] = $4F) THEN
                                       Archiver:=fctZOO;

                                    IF (Buffer[0] = $60) AND (Buffer[1] = $EA) THEN
                                       Archiver:=fctARJ;

                                    IF (Buffer[0] = 82{R}) AND (Buffer[1] = 97{a}) AND
                                       (Buffer[2] = 114{r}) AND (Buffer[3] = 33{!}) AND
                                       (Buffer[4] = $1A) AND (Buffer[5] = 7) THEN
                                       Archiver:=fctRAR;
                               END; { if error }
                          END;

                          { Als GUS niet gedefinieerd , en we kennen het formaat niet }
                          IF (Archiver = fctNone) THEN
                          BEGIN
                               LogMessage (liFatal,'Cannot detect archive method for '+Config.Inbound_F[InDirLp]+
                                           Search.Name+', renaming to .UNK');
                               Destination:=ReplaceExtension (Config.Inbound_F[InDirLp]+Search.Name,'.UNK');
                               IF (NOT RenameSerial (Config.InBound_F[InDirLp]+Search.Name,Destination)) THEN
                               BEGIN
                                    LogExtraMessage ('Rename failed!');
                                    Exit;      { ## EXIT ## }
                               END;
                          END ELSE
                          BEGIN
                               { uitpakken }
                               GoExecHulp:=ArchiversPtr^.Unarchive[Archiver];
                               GetDir (0,OldDir);
                               ChDir (Config.Inbound_F[InDirLp]+'.');

                               IF Config.LogFidoExtract THEN
                                  LogMessage (liTrivial,'Extracting archive '+Config.Inbound_F[InDirLp]+Search.Name);

                               GoExec (GoExecHulp,Search.Name,'Extracting FTN archive file');
                               ChDir (OldDir);

                               { BugFix 3/11 - Niet deleten van archive na  }
                               {               unpack error.                }
                               { * We gaan er hier vanuit dat elke unpacker }
                               {   een '0' geeft bij succes !               }

                               IF (ExecRes = 0) THEN
                               BEGIN
                                    {$IFDEF DeleteFidoArchives}
                                    {$I-} Erase (ArchiveFile); {$I+} IORes:=IOResult;
                                    IF (IORes <> 0) THEN
                                       LogDiskIOError (IORes,'Error deleting archive '+Search.Name);
                                    {$ENDIF}
                               END ELSE
                               BEGIN
                                    { RWI 950312 }
                                    { er is een fout opgetreden bij het }
                                    { uitpakken. Hernoem deze archive   }
                                    { naar .ERR, anders blijven we      }
                                    { proberen.                         }
                                    LogMessage (liFatal,'Cannot unpack inbound archive '+Config.InBound_F[InDirLp]+
                                                Search.Name+', renaming to .ERR');
                                    Destination:=ReplaceExtension (Config.Inbound_F[InDirLp]+Search.Name,'.ERR');
                                    IF NOT RenameSerial (Config.InBound_F[InDirLp]+Search.Name,Destination) THEN
                                    BEGIN
                                         LogExtraMessage ('Rename failed!');
                                         Exit;    { ## EXIT ## }
                                    END;
                               END;
                          END;

                          ProcessInboundPkts (Config.Inbound_F[InDirLp],'PKT',Config.Security_F[IndirLp],NILRecordNr);

                          { zoek opnieuw naar een archive, beginnende aan }
                          { de top van de directory. Verlaat de directory }
                          { nog niet                                      }
                          ReScan:=TRUE; { RWI 950220: weer toegevoegd! }
                          Quit:=FALSE;
                     END;

                     { als het geen archive was, dan de volgende file zoeken }
                     IF (NOT ReScan) THEN
                     BEGIN
                          FindNext (Search);
                          IF (DosError <> 0) THEN
                             Quit:=TRUE; { while kapt, repeat nu ook }
                     END;
                END; { while }

                FindClose (Search);

          UNTIL Quit;
     END; { for }

     IF (NOT AnyInbound) THEN
        LogMessage (liConfig,'No inbound configured!');
END;


{--------------------------------------------------------------------------}
{ FidoToss                                                                 }
{                                                                          }
{ Deze routines tosst alle pakketjes die in de fido inbound directories    }
{ staan.                                                                   }
{                                                                          }
{ <MD> Uitbreiding met SCAN routine                                        }
{ <MD> Last Minute TearLine Creation                                       }
{                                                                          }
PROCEDURE FidoToss;
BEGIN
     LogMessage (liTrivial,'TOSS FTN inbound(s) started');

     UpdateAction ('Scanning FTN inbound');
     ProcessInboundArchives;   { verwerk alle archives in de inbound dirs }

     BBS_TossInbounds;

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


{--------------------------------------------------------------------------}
{ FidoBuildOrigin                                                          }
{                                                                          }
{ Bouwt een standaard Fido stijl origin lijn.                              }
{  * Origin: This telephone thing will never be of importance (2:512/17)   }
{                                                                          }
FUNCTION FidoBuildOrigin (Tekst : STRING; Adres : FidoAddrType) : STRING;

VAR Lijn : STRING;

BEGIN
     Lijn:=' ('+Word2String (Adres.Zone)+':'+Word2String(Adres.Net)+'/'+Word2String (Adres.Node);

     IF (Adres.Point > 0) THEN
        Lijn:=Lijn+'.'+Word2String (Adres.Point);

     Lijn:=Lijn+')';

     { RWI 960904: nu nooit meer langer dan 79 tekens }
     FidoBuildOrigin:=' * Origin: '+Copy (DeleteFrontAndBackSpaces (Tekst),1,79-11-Length (Lijn))+Lijn;
END;


{--------------------------------------------------------------------------}
{ LastNetInLine                                                            }
{                                                                          }
{ Deze routine kijkt wat het laatste net is dat in de opgegeven regel      }
{ voorkomt en geeft die terug. Als er meerdere in staan, dan wordt dus de  }
{ laatste terug gegeven. Wordt gebruikt voor zowel de PATH als SEEN-BY     }
{ regels. De slash achter het net wordt ook terug gegeven.                 }
{                                                                          }
{ RWI 951111: positie achter dat net nummer wordt nu terug gegeven in P.   }
{                                                                          }
FUNCTION LastNetInLine (Line : STRING; VAR FoundAt : BYTE) : STRING;

VAR Part : STRING[20];
    P,F  : BYTE;

BEGIN
     LastNetInLine:='';
     FoundAt:=0;

     P:=0;

     { splits de line steeds in stukje van 1 net/node combinatie zolang   }
     { die er nog zijn. Als er in zo'n stukje daarna een net/ zit, dan    }
     { wordt die terug gegeven. De laatste is die we willen. Niet het     }
     { snelste zo, maar ach, zo vaak wordt ie nou ook weer niet gebruikt. }
     WHILE (Line <> '') DO
     BEGIN
          F:=Pos (' ',Line);

          IF (F > 0) THEN
          BEGIN
               Part:=Copy (Line,1,F-1);
               Delete (Line,1,F);
               P:=P+F;
          END ELSE
          BEGIN
               Part:=Line;
               P:=P+Length (Line);
               Line:='';
          END;

          IF (Pos ('/',Part) > 0) THEN
          BEGIN
               LastNetInLine:=Copy (Part,1,Pos ('/',Part));
               { zet FoundAt precies achter de / }
               FoundAt:=P-(Length (Part)-Pos ('/',Part));
          END;
     END; { while }
END;


{--------------------------------------------------------------------------}
{ FoundNodeNr                                                              }
{                                                                          }
{ Deze routine kijkt of het opgegeven node nummer in de string voorkomt.   }
{ zonee, dan wordt FALSE terug gegeven, anders TRUE.                       }
{                                                                          }
FUNCTION FoundNodeNr (Line : STRING; Node : STRING) : BOOLEAN;

VAR Part : STRING[20];
    F    : BYTE;

BEGIN
     { splits de line steeds in stukje van 1 node zolang die er nog zijn. }
     IF (Line[1] = '/') THEN
        Delete (Line,1,1);

     WHILE (Line <> '') DO
     BEGIN
          F:=Pos (' ',Line);

          IF (F > 0) THEN
          BEGIN
               Part:=Copy (Line,1,F-1);
               Delete (Line,1,F);
          END ELSE
          BEGIN
               Part:=Line;
               Line:='';
          END;

          IF (Part = Node) THEN
          BEGIN
               FoundNodeNr:=TRUE;
               Exit;
          END;
     END; { while }

     FoundNodeNr:=FALSE;
END;


{--------------------------------------------------------------------------}
{ FidoAddPath                                                              }
{                                                                          }
{ Deze regelt breekt te lange Path regels (80 tekens) af, en stuurt        }
{ steeds de rest naar Fido Footer van de Universele Msg.                   }
{                                                                          }
{ RWI 950628: AreaBase record VAR gemaakt...                               }
{                                                                          }
PROCEDURE FidoAddPath (Old : STRING; VAR AreaBase : AreaBaseRecord);

VAR TempNet,
    TempNode : STRING[10];
    Temp,
    Path     : STRING;
    Loc      : WORD;
    P        : BYTE;

BEGIN
     { Voeg het (restant?) van de oude path lijn samen met ons huidige adres }
     IF (Config.PointNets[AreaBase.OriginAka] > 0) AND
        (Config.NodeNrs[AreaBase.OriginAka].Point > 0) THEN
     BEGIN
          { ipv net/node moeten we pointnet/point toevoegen }
          TempNet:=Word2String (Config.PointNets[AreaBase.OriginAka])+'/';
          TempNode:=Word2String (Config.NodeNrs[AreaBase.OriginAka].Point);
     END ELSE
     BEGIN
          { net/node toevoegen }
          TempNet:=Word2String (Config.NodeNrs[AreaBase.OriginAka].Net)+'/';
          TempNode:=Word2String (Config.NodeNrs[AreaBase.OriginAka].Node);
     END;

     { CR van de oude regel afsnoepen, als die er was tenminste }
     IF (Old <> '') AND (Old[Length (Old)] = #13) THEN
        Delete (Old,Length (Old),1);

     { RWI 960601: Path variable kon not-assigned blijven!! }
     Path:=Old;

     { RWI 950506: net niet toevoegen als het niet nodig is }
     { RWI 951111: dirty fix om dubbele node nummers te voorkomen.    }
     {             Werkt alleen op de laatste path line, maar is goed }
     {             genoeg als een node nummer lokaal door twee apps   }
     {             gebruikt wordt (Flame die exporteert uit TBBS en   }
     {             daarna WG die hetzelfde node nummer gebruikt).     }
     IF (LastNetInLine (Path,P) <> TempNet) THEN
        Path:=Path+' '+TempNet+TempNode
     ELSE BEGIN
          { kijk of het node nummer dat we toe moeten voegen al in }
          { het path stuk staat, na de positie waar het net nummer }
          { gevonden was. En dat was het laatste net nummer, dus   }
          { kunnen we tot het einde zoeken.                        }
          IF (NOT FoundNodeNr (Copy (Path,P,255),TempNode)) THEN
             Path:=Path+' '+TempNode;
     END;

     { kan het in 1 keer weggeschreven worden? }
     IF (Length (Path) < 70{was 80}) THEN
     BEGIN
          MsgsAddLineTo (Footer_F,Path)
     END ELSE
     BEGIN
          { zoniet breek het spulletje in 2'en }
          { Dit gebeurt in principe alleen bij de laatste regel, dus we }
          { hoeven niet te optimaliseren met de volgende regels ofzo.   }
          FOR Loc:=72 DOWNTO 1 DO
              IF (Path[Loc] = ' ') THEN
              BEGIN
                   Temp:=Copy (Path,Loc+1,Length (Path));
                   Path:=Copy (Path,1,Loc-1);
                   MsgsAddLineTo (Footer_F,Path);

                   { RWI 950506: Laatste net/ overnemen }

                   { als temp nu met een net/ begint, dan hebben we heel  }
                   { er veel mazzel en hoeft het laatste net/ uit de Path }
                   { regel er niet aan toegevoegd te worden, want dan     }
                   { krijgen we net/net/node...                           }

                   Temp:=Temp+' '; { zekerheidje, anders Pos(' ',Temp) = 0 }

                   { er moet dus een / staan voordat er een spatie staat,   }
                   { want anders zou er een node nummer voor de net/ kunnen }
                   { staan. Examples OK: "200/111", "200/111 112"           }
                   {                BAD: "801 200/111", "111"               }
                   IF (Pos ('/',Temp) > Pos (' ',Temp)) THEN
                      { temp begint niet met een net }
                      Temp:=LastNetInLine (Path,P)+Temp;

                   { verwijder de extra spatie weer }
                   Delete (Temp,Length (Temp),1);

                   { RWI 960329: net werd hier alsnog toegevoegd!! Bad! }
                   MsgsAddLineTo (Footer_F,#1'PATH: '+{LastNetInLine (Path,P)+}Temp);
                   Break; { uit de for }
              END; { if, for }
     END; { past ie in een keer? }
END;


{--------------------------------------------------------------------------}
{ FidoOurPoint                                                             }
{                                                                          }
{ Deze routine bekijkt of een gegeven fidoadres van een van onze points is }
{ Dit is waar als OF <zone:net/node.?> overeenkomen met een van onze AKA's }
{ OF <zone:fakenet/?.0> overeen komt.                                      }
{                                                                          }
{ Bugfix : Points hebben geen points!                                      }
{                                                                          }
FUNCTION FidoOurPoint (User : FidoAddrType) : BOOLEAN;

VAR AkaLp : AkaIndexType;

BEGIN
     FOR AkaLp:=1 TO MaxAkas DO
     BEGIN
          IF (User.Zone = Config.NodeNrs[AkaLp].Zone) THEN
          BEGIN
               { 4D Point }
               IF (User.Net = Config.NodeNrs[AkaLp].Net) AND
                  (User.Node = Config.NodeNrs[AkaLp].Node) AND
                  (Config.NodeNrs[AkaLp].Point = 0) THEN
               BEGIN
                    FidoOurPoint:=TRUE;
                    Exit;
               END ELSE
                   { 3D Point }
                   IF (User.Net = Config.PointNets[AkaLp]) AND
                      (User.Point = 0) THEN
                   BEGIN
                        FidoOurPoint:=TRUE;
                        Exit;
                   END;
          END; { if zone }
     END; { for }

     FidoOurPoint:=FALSE;
END;


{--------------------------------------------------------------------------}
{ FidoOurAdres                                                             }
{                                                                          }
{ Geeft TRUE terug als het gegeven adres een van onze AKA's is. Als geen   }
{ van onze AKA's toepasselijk is, dan wordt FALSE terug gegeven.           }
{                                                                          }
{ Controleer nu of het aka waarop we testen niet toevallig een leeg adres  }
{ is.                                                                      }
{                                                                          }
{ Toevoegen van checken op pointnet (!)                                    }
{                                                                          }
FUNCTION FidoOurAdres (Adres : FidoAddrType) : BOOLEAN;

VAR AkaLp : AkaIndexType;
    Temp  : FidoAddrType;

BEGIN
     FOR AkaLp:=1 TO MaxAkas DO
         IF (NOT FidoCompare (Config.NodeNrs[Akalp],NullAdres)) THEN
         BEGIN
              { check op pointnet }
              IF (Config.PointNets[AkaLp] > 0) AND
                 (Config.NodeNrs[AkaLp].Point > 0) THEN
              BEGIN
                   Temp.Zone:=Config.NodeNrs[AkaLp].Zone;
                   Temp.Net:=Config.PointNets[AkaLp];
                   Temp.Node:=Config.NodeNrs[AkaLp].Point;
                   Temp.Point:=0;
                   Temp.Domain:=''; {Config.NodeNrs[AkaLp].Domain;}

                   IF FidoCompare (Adres,Temp) THEN
                   BEGIN
                        OurAkaIndex:=AkaLp;
                        FidoOurAdres:=TRUE;
                        Exit;
                   END;
              END;

              { check op gewoon netadres }
              IF FidoCompare (Adres,Config.NodeNrs[AkaLp]) THEN
              BEGIN
                   OurAkaIndex:=AkaLp;
                   FidoOurAdres:=TRUE;
                   Exit;
              END;
         END; { if, for }

     OurAkaIndex:=0;
     FidoOurAdres:=FALSE;
END;


{--------------------------------------------------------------------------}
{ FidoMergeAdres                                                           }
{                                                                          }
{ Deze routine vult de gaten in een adres aan met informatie uit een 2e    }
{ adres. Bijvoorbeeld: 2:280/802.6 + 0:0/18.0  ->  2:280/18.0              }
{                                                                          }
PROCEDURE FidoMergeAdres (FillAdres : FidoAddrType;
                          VAR Adres : FidoAddrType);
BEGIN
     IF (Adres.Zone = 0) THEN
        Adres.Zone:=FillAdres.Zone
     ELSE
         Exit;

     IF (Adres.Net = 0) THEN
        Adres.Net:=FillAdres.Net
     ELSE
         Exit;

     IF (Adres.Node = 0) THEN
        Adres.Node:=FillAdres.Node;
END;


(*
{--------------------------------------------------------------------------}
{ RemoveSeenByListFromMemory                                               }
{                                                                          }
{ Geeft het geheugen dat in beslag genomen wordt door de SeenBy lijst weer }
{ vrij.                                                                    }
{                                                                          }
PROCEDURE RemoveSeenByListFromMemory;

VAR SeenByLocal: SeenByMemPtr;

BEGIN
     WHILE (SeenByList <> NIL) DO
     BEGIN
          SeenByLocal:=SeenByList;
          SeenByList:=SeenByList^.NextSeenBy;

          { geef de string vrij }
          FreeMem (SeenByLocal^.SeenBy,Length (SeenByLocal^.SeenBy^)+1);
          FreeMem (SeenByLocal,SizeOf (SeenByMem));
     END;
END;
*)

{--------------------------------------------------------------------------}
{ FidoCreateSeenBy                                                         }
{                                                                          }
{ Deze routine maakt een SeenBy regel aan voor alle nodes die aangesloten  }
{ zijn op de opgegeven area, waarvan het UserList veld is meegegeven als   }
{ argument.                                                                }
{                                                                          }
PROCEDURE FidoCreateSeenBy (WeSend : BOOLEAN; VAR AreaData : AreaBaseRecord; VAR SeenByLine : STRING);
BEGIN
     LogMessage (liReport,'FidoCreateSeenBy not implemented yet!');
END;


(*
PROCEDURE FidoCreateSeenBy (WeSend : BOOLEAN; VAR AreaData : AreaBaseRecord; VAR SeenByLine : STRING);

TYPE SeenByRecordPtr = ^SeenByRecord;
     SeenByRecord    = RECORD
                             Net,Node   : WORD;
                             NextSeenBy : SeenByRecordPtr;
                       END;

VAR Search      : SubscrSearchRecord;
    NewSeenBy,
    HulpSeenBy,
    PrevSeenBy,
    FirstSeenBy : SeenByRecordPtr;
    CurrNet     : WORD;
    AddSeenBy   : STRING[11]; { maximaal 12345/12345 }
    Lp          : 1..MaxAkas;

BEGIN
     FirstSeenBy:=NIL;
     SeenByLine:='';

     { voorkom fouten met areas die nog niet bestaan }
     IF (AreaData.AreaName_F = '') THEN
        Exit;

     { Onze namen alleen toevoegen als we de ZENDER van het bericht zijn }
     IF WeSend THEN
     BEGIN
          FOR Lp:=1 TO MaxAKAs DO
              IF (Config.NodeNrs[Lp].Net <> 0) AND HasSeenByBit (AreaData,Lp) THEN
              BEGIN
                   GetMem (NewSeenBy,SizeOf (SeenByRecord));
                   PeekMem;

                   { Als we POINT zijn, dan is het belangrijk om te kijken }
                   { of er sprake is van een point net.                    }
                   IF (Config.PointNets[Lp] > 0) AND
                      (Config.NodeNrs[Lp].Point > 0) THEN
                   BEGIN
                        WITH NewSeenBy^ DO
                        BEGIN
                             Net:=Config.PointNets[Lp];
                             Node:=Config.NodeNrs[Lp].Point;
                             NextSeenBy:=NIL;
                        END; { with }
                   END ELSE
                       { Geen pointnet om ons druk over te maken }
                       WITH NewSeenBy^ DO
                       BEGIN
                            Net:=Config.NodeNrs[Lp].Net;
                            Node:=Config.NodeNrs[Lp].Node;
                            NextSeenBy:=NIL;
                       END; { with }

                   IF (FirstSeenBy = NIL) THEN
                      { als eerste toevoegen }
                      FirstSeenBy:=NewSeenBy
                   ELSE BEGIN
                        HulpSeenBy:=FirstSeenBy;
                        PrevSeenBy:=NIL;

                        WHILE (HulpSeenBy <> NIL) AND
                              (NewSeenBy^.Net >= HulpSeenBy^.Net) AND
                              (NewSeenBy^.Node > HulpSeenBy^.Node) DO
                        BEGIN
                             PrevSeenBy:=HulpSeenBy;
                             HulpSeenBy:=HulpSeenBy^.NextSeenBy;
                        END;

                        { RWI 950313: controle op NIL toegevoegd }
                        IF NOT ((HulpSeenBy <> NIL) AND
                                (NewSeenBy^.Net = HulpSeenBy^.Net) AND
                                (NewSeenBy^.Node = HulpSeenBy^.Node)) THEN
                        BEGIN
                             IF (HulpSeenBy = NIL) THEN
                                { aan het eind toevoegen }
                                PrevSeenBy^.NextSeenBy:=NewSeenBy
                             ELSE
                                 IF (PrevSeenBy = NIL) THEN
                                 BEGIN
                                      { voor de eerste toevoegen }
                                      NewSeenBy^.NextSeenBy:=FirstSeenBy;
                                      FirstSeenBy:=NewSeenBy;
                                 END ELSE
                                 BEGIN
                                      { in het midden tussenvoegen }
                                      PrevSeenBy^.NextSeenBy:=NewSeenBy;
                                      NewSeenBy^.NextSeenBy:=HulpSeenBy;
                                 END;
                        END ELSE
                            { net/node combinatie bestaat al, deze niet opnemen }
                            FreeMem (NewSeenBy,SizeOf (SeenByRecord));
                   END; { niet de eerste }
              END; { for }
     END; { SeenByAkas > 0 }

     GetFirstUserSubscribedToThisArea (AreaData.UserList,Search);
     WHILE (Search.Found) DO
     BEGIN
          ReadUserBaseRecord (Search.UserBaseRecordNr,UserData);

          { voorkom dat we de nodes noemen die het bericht verstuurd hebben }
          IF (NOT UserData.Deleted) AND (UserData.System = _F) AND
             (NOT UserData.Passive) AND (NOT (Search.UserBaseRecordNr = UserDataRecNr)) THEN
          BEGIN
               GetMem (NewSeenBy,SizeOf (SeenByRecord));
               PeekMem;

               WITH NewSeenBy^ DO
               BEGIN
                    Net:=UserData.Address.Net;
                    Node:=UserData.Address.Node;

                    { als dit een point is en we hebben een pointnet, dan }
                    { het adres veranderen in het pointnet adres.         }
                    IF (UserData.Address.Point <> 0) THEN
                    BEGIN
                         FOR Lp:=1 TO MaxAkas DO
                             IF (Config.PointNets[Lp] <> 0) AND
                                (Config.NodeNrs[Lp].Zone = UserData.Address.Zone) AND
                                (Config.NodeNrs[Lp].Net  = UserData.Address.Net) AND
                                (Config.NodeNrs[Lp].Node = UserData.Address.Node) THEN
                             BEGIN
                                  Net:=Config.PointNets[Lp];
                                  Node:=UserData.Address.Point;
                                  Break;
                             END;
                    END;

                    NextSeenBy:=NIL;
               END; { with }

               IF (FirstSeenBy = NIL) THEN
                  { als eerste toevoegen }
                  FirstSeenBy:=NewSeenBy
               ELSE BEGIN
                    HulpSeenBy:=FirstSeenBy;
                    PrevSeenBy:=NIL;

                    { RWI 950612: added extra braces after the <> NIL check }
                    WHILE (HulpSeenBy <> NIL) AND
                          ((NewSeenBy^.Net > HulpSeenBy^.Net) OR
                           ((NewSeenBy^.Net = HulpSeenBy^.Net) AND
                            (NewSeenBy^.Node > HulpSeenBy^.Node))) DO
                    BEGIN
                         PrevSeenBy:=HulpSeenBy;
                         HulpSeenBy:=HulpSeenBy^.NextSeenBy;
                    END;

                    IF (NOT ((HulpSeenBy <> NIL) AND { RWI 950221: toegevoegd }
                             (NewSeenBy^.Net = HulpSeenBy^.Net) AND
                             (NewSeenBy^.Node = HulpSeenBy^.Node))) THEN
                    BEGIN
                         IF (HulpSeenBy = NIL) THEN
                            { aan het eind toevoegen }
                            PrevSeenBy^.NextSeenBy:=NewSeenBy
                         ELSE
                             IF (PrevSeenBy = NIL) THEN
                             BEGIN
                                  { voor de eerste toevoegen }
                                  NewSeenBy^.NextSeenBy:=FirstSeenBy;
                                  FirstSeenBy:=NewSeenBy;
                             END ELSE
                             BEGIN
                                  { in het midden tussenvoegen }
                                  PrevSeenBy^.NextSeenBy:=NewSeenBy;
                                  NewSeenBy^.NextSeenBy:=HulpSeenBy;
                             END;
                    END ELSE
                    BEGIN
                         { net/node combinatie bestaat al, deze niet opnemen }
                         FreeMem (NewSeenBy,SizeOf (SeenByRecord));
                    END;
               END; { niet de eerste }
          END; { fido user }

          GetNextUserSubscribedToThisArea (Search);
     END;

     { als we nu een lijst hebben, dan stellen we een string op }
     { Merk op dat hier maar ongeveer 30 adressen in gaan!!!    }
     IF (FirstSeenBy <> NIL) THEN
     BEGIN
          SeenByLine:='';

          WHILE (FirstSeenBy <> NIL) DO
          BEGIN
               IF (SeenByLine = '') THEN
                  CurrNet:=FirstSeenBy^.Net+1;

               AddSeenBy:=Word2String (FirstSeenBy^.Node);
               IF (CurrNet <> FirstSeenBy^.Net) THEN
               BEGIN
                    CurrNet:=FirstSeenBy^.Net;
                    AddSeenBy:=Word2String (CurrNet)+'/'+AddSeenBy;
               END;

               IF (SeenByLine <> '') THEN
                  SeenByLine:=SeenByLine+' '+AddSeenBy
               ELSE
                   SeenByLine:=AddSeenBy;

               HulpSeenBy:=FirstSeenBy;
               FirstSeenBy:=FirstSeenBy^.NextSeenBy;
               FreeMem (HulpSeenBy,SizeOf (SeenByRecord));
          END; { while }
     END; { first <> nil }
END;

{------------------------------------------------------------------------- }
{ FidoAddSeenBy                                                            }
{                                                                          }
{ Loop door de lijst met areas die zich in het geheugen bevinden en kijk   }
{ of er al een kant en klare SeenBy regel is. Zoniet bouw er eentje.       }
{                                                                          }
{ Er wordt een maximum aantal in het geheugen gehouden, dit om te          }
{ voorkomen dat een node met erg veel areas zijn geheugen dicht ziet       }
{ slippen.                                                                 }
{                                                                          }
{ De seen-bys worden daarna aan SeenByLine toegevoegd en aan het bericht   }
{ toegevoegd.                                                              }
{                                                                          }
PROCEDURE FidoAddSeenBy (WeSend : BOOLEAN; AreaData : AreaBaseRecord; AreaRecNr : AreaBaseRecordNrType; SeenByLine : STRING);

VAR SeenByNumb  : INTEGER;
    SeenByLast,
    SeenByLocal : SeenByMemPtr;
    SeenByRegel : STRING;
    X           : BYTE;
    Found       : BOOLEAN;
    RegelPart   : STRING[20];
    P           : BYTE;

BEGIN
     { leg een verwijzing naar de seenby list in het geheugen }
     IF (SeenByLine <> '') AND (SeenByLine[Length (SeenByLine)] = #13) THEN
        Delete (SeenByLine,Length (SeenByLine),1);

     SeenByNumb:=0;
     SeenByLocal:=SeenByList;
     SeenByLast:=SeenByList;
     Found:=FALSE;

     { doorloop de lijst op zoek naar de seenby regel voor deze area. }
     WHILE (SeenByLocal <> NIL) DO
     BEGIN
          IF (SeenByLocal^.AreaID = AreaRecNr) THEN
          BEGIN
               SeenByRegel:=SeenByLocal^.SeenBy^;
               Found:=TRUE;
               {Moet hier een break ?}
               Break;
          END;

          Inc (SeenByNumb);
          SeenByLast:=SeenByLocal;
          SeenByLocal:=SeenByLocal^.NextSeenBy;
     END; { while }

     { Niet gevonden. Als er nog ruimte is zorg dan dat er aan }
     { het einde een nieuw record wordt toegevoegd.            }
     IF (NOT Found) THEN
     BEGIN
          FidoCreateSeenBy (WeSend,AreaData,SeenByRegel);
          GetMem (SeenByLocal,SizeOf (SeenByMem));
          PeekMem;

          IF (SeenByLast <> NIL) THEN
             SeenByLast^.NextSeenBy:=SeenByLocal
          ELSE
              SeenByList:=SeenByLocal;

          WITH SeenByLocal^ DO
          BEGIN
               AreaId:=AreaRecNr;
               NextSeenBy:=NIL;
               GetMem (SeenByLocal^.SeenBy,Length (SeenByRegel)+1);
               PeekMem;
               SeenByLocal^.SeenBy^:=SeenByRegel;
          END; { with }

          { Als er nu teveel records zijn, verwijder degene aan het }
          { begin, op deze manier hebben we een lopende ketting     }
          { die steeds de meest gevraagde seenby's in het geheugen  }
          { heeft.                                                  }
          IF (SeenByNumb > MaxSeenByInMemory) THEN
          BEGIN
               SeenByLocal:=SeenByList;
               SeenByList:=SeenByList^.NextSeenBy;
               { Geef de string vrij }
               FreeMem (SeenByLocal^.SeenBy,Length (SeenByLocal^.SeenBy^)+1);
               FreeMem (SeenByLocal,SizeOf (SeenByMem));
          END;

          { Niet netjes, niet mooi,... maar &^&^ snel }
     END;

     IF (SeenByLine = '') THEN
        SeenByLine:='SEEN-BY:';

     { RWI 950506 }
     { we hebben nu een SeenByLine die de laatste regel uit het bericht  }
     { bevat, of gewoon 'SEEN-BY:'. In SeenByRegel staan alle (net/)node }
     { nummers die hieraan toegevoegd moeten worden. Als SeenByLine vol  }
     { wordt, dan schrijven we em naar de footer van het bericht, anders }
     { gaat er steeds e'e'n (net/)node nummer uit SeenByRegel by. Dit    }
     { gaat zo door totdat alle (net/)node nummers uit SeenByRegel er    }
     { aan toegevoegd zijn. Onderweg optimaliseren we nog even voor      }
     { net nummers die niet nodig zijn, of voegen we ze juiste toe aan   }
     { het begin van een nieuwe regel.                                   }

     { mogelijke situaties:

       Line is vol
            Regel begint met een net
                  -> Geen net zetten in nieuwe Line
            Regel begint niet met een net
                  -> Laatste net zetten in nieuwe Line

       Line is niet vol
            Regel begint met een net
                  -> Als gelijk aan laatste net in Line, dan verwijderen
            Regel begint niet met een net
                  -> gewoon toevoegen
     }

     WHILE (SeenByRegel <> '') DO
     BEGIN
          { pak een stuk van SeenByRegel }
          IF (Pos (' ',SeenByRegel) > 0) THEN
          BEGIN
               RegelPart:=Copy (SeenByRegel,1,Pos (' ',SeenByRegel)-1);
               Delete (SeenByRegel,1,Pos (' ',SeenByRegel));
          END ELSE
          BEGIN
               RegelPart:=SeenByRegel;
               SeenByRegel:='';
          END;

          IF (Length (SeenByLine) < 70{was 78}) THEN
          BEGIN
               { Line is niet vol }

               { heeft RegelPart een net? }
               IF (Pos ('/',RegelPart) > 0) THEN
               BEGIN
                    { RegelPart bevat een net! }
                    { Als ie gelijk is aan het laatste net in Line, dan kan ie weg }
                    IF (LastNetInLine (SeenByLine,P) = Copy (RegelPart,1,Pos ('/',RegelPart))) THEN
                       { gelijk -> verwijder dubbele net }
                       Delete (RegelPart,1,Pos ('/',RegelPart));
               END;

               SeenByLine:=SeenByLine+' '+RegelPart;
          END ELSE
          BEGIN
               { line is vol }
               MsgsAddLineTo (Footer_F,SeenByLine);

               { als RegelPart geen net bevat, dan het laatste net van de }
               { vorige regel overnemen.                                  }
               IF (Pos ('/',RegelPart) = 0) THEN
                  RegelPart:=LastNetInLine (SeenByLine,P)+RegelPart;

               SeenByLine:='SEEN-BY: '+RegelPart;
          END;
     END; { while }

     { kan dit een lege 'SEEN-BY:' regel opleveren??? }
     { RWI 950506 niet meer na aanpassingen aan bovenstaande deel }
     MsgsAddLineTo (Footer_F,SeenByLine);
END;
*)


VAR SplitDateTime : FidoDateType;

{--------------------------------------------------------------------------}
{ FidoCreateSplitLine                                                      }
{                                                                          }
{ Aangezien er een echte fido semi standaard is voor split line's is er    }
{ natuurlijk niets leukers dan ons daaraan te houden. Dat het eigenlijk    }
{ een belachelijk dom formaat is mag de pret niet drukken.                 }
{                                                                          }
FUNCTION FidoCreateSplitLine (SplitCurrent,SplitParts : WORD) : STRING;

CONST SplitKludge = #1+'SPLIT: ';

VAR SplitLine : STRING;

BEGIN
     { FSC-0047 gegenereerde ^ASplit lijn }
     { ^ASPLIT: 30 Mar 90 11:12:34 @100/1         0   02/03 +++++++++++ }

     { make sure all parts get the same date/time in all the split parts }
     IF (SplitCurrent = 1) THEN
        SplitDateTime:=FidoCurrTime2Str;

     SplitLine:=AddUpWithSpaces (40,SplitKludge+SplitDateTime+
                ' @' + Word2String (Msg.FromAddr_F.Net) +
                '/'+   Word2String (Msg.FromAddr_F.Node)) +
                ' 0     ' + AddUpWithPre0s (2,Word2String (SplitCurrent))+
                '/'       + AddUpWithPre0s (2,Word2String (SplitParts))+
                ' +++++++++++';
     Delete (SplitLine,18,1);

     FidoCreateSplitLine:=SplitLine;
END;


{--------------------------------------------------------------------------}
{ FTN_CreateNetmail                                                        }
{                                                                          }
{ This routine build a new, compliant, FTN netmail message sent from the   }
{ given information and with the given subject, todays time, a MSGID,      }
{ PID and CHRS kludge. Any message present in memory is erased (no push).  }
{ The caller must add a destination when this function has returned.       }
{                                                                          }
PROCEDURE FTN_CreateNetmail (FromAddr : FidoAddrType; FromUser,Subject : STRING);
BEGIN
     MsgsEmpty;

     { fill in the sender info }
     Msg.FromUser_F:=FromUser;
     Msg.FromAddr_F:=FromAddr;

     { fill in the rest }
     Msg.Subj_F:=Subject;
     Msg.Attr_F:=MSGPRIVATE OR MSGLOCAL;
     Msg.Date_F:=FidoCurrTime2Str;

     { MSGID kludge }
     Msg.MsgID_F:=Fido2Str (Msg.FromAddr_F)+' '+GetFidoPktName;
     MsgsAddLineTo (Header_F,#1'MSGID: '+Msg.MsgID_F);

     { PID and CHRS kludge }
     MsgsAddLineTo (Header_F,BuildPIDKludge);
     MsgsAddLineTo (Header_F,BuildCHRSKludge (''));

     { note: no tear line anymore }

     Msg.Ready_F:=Netmail;
END;


{--------------------------------------------------------------------------}
{ FTN_PushAndBuildReply                                                    }
{                                                                          }
{ This routine builds a reply netmail based on the sender information in   }
{ the current message. If the user is behind a remote gateway, the reply   }
{ will be set to point there.                                              }
{ The FromAka and FromName are used in the new message. The FromAka is an  }
{ index in the list of system node numbers. Set to 0 for automatic         }
{ selection (based on the destination).                                    }
{ MsgsPushState is used to store the current state. MsgsPopState must thus }
{ be called when the deliver has completed.                                }
{                                                                          }
PROCEDURE FTN_PushAndBuildReply (Subject : STRING; FromAka : BYTE; FromName : STRING);
BEGIN
     MsgsPushState;   { performs a MsgsEmptyKeepSwapfile }

     { build the reply address based on the sender info from the }
     { original message.                                         }
     WITH Msg.PrevMsgPtr^ DO
     BEGIN
          { the ReplyAka, ReplyUser and ReplyEmail fields indicate   }
          { a remote gateway user.                                   }
          { Otherwise, the FromUser_F and FromAddr_F should be used. }

          IF (ReplyEMail <> '') AND (ReplyUser <> '') THEN
          BEGIN
               LogMessage (liTrivial,'Building reply for '+ReplyEMail+' via "'+ReplyUser+'"%'+Fido2Str (ReplyAKA));

               Address_AddRemoteGW (ReplyUser,ReplyAKA,ReplyEmail,FALSE,FALSE);
               IF (FromAka = 0) THEN
                  FromAka:=FidoMatchAKA (ReplyAKA);
          END ELSE
          BEGIN
               LogMessage (liTrivial,'Building reply for "'+FromUser_F+'"%'+Fido2Str (FromAddr_F));

               Address_AddFTN (FromUser_F,FromAddr_F,FALSE,FALSE);
               IF (FromAka = 0) THEN
                  FromAka:=FidoMatchAKA (FromAddr_F);
          END;
     END;

     { fill in the From information }
     Msg.FromUser_F:=FromName;
     Msg.FromAddr_F:=Config.NodeNrs[FromAka];

     { fill in the rest }
     Msg.Subj_F:=Subject;
     Msg.Attr_F:=MSGPRIVATE OR MSGLOCAL; {## Kill?}
     Msg.Date_F:=FidoCurrTime2Str;

     { MSGID kludge }
     Msg.MsgID_F:=Fido2Str (Msg.FromAddr_F)+' '+GetFidoPktName;
     MsgsAddLineTo (Header_F,#1'MSGID: '+Msg.MsgID_F);

     { REPLY kludge }
     Msg.ReplyID_F:=Msg.PrevMsgPtr^.MsgID_F;
     IF (Msg.ReplyID_F <> '') THEN
        MsgsAddLineTo (Header_F,#1'REPLY: '+Msg.ReplyID_F);

     { PID and CHRS kludge }
     MsgsAddLineTo (Header_F,BuildPIDKludge);
     MsgsAddLineTo (Header_F,BuildCHRSKludge (''));

     { note: no tear line anymore }

     Msg.Ready_F:=Netmail;
END;


{--------------------------------------------------------------------------}
{ FTN_CreateBounceBody                                                     }
{                                                                          }
{ This routine create the body for the bounce message by adding either the }
{ entire or only the first 20 lines of the original message that is one    }
{ down the stack.                                                          }
{                                                                          }
PROCEDURE FTN_CreateBounceBody;

VAR N         : WORD;
    Lp        : 1..MAX_BODY_PARTS;
    Truncated : BOOLEAN;
    DestPtr2,
    DestPtr   : DestRecordPtr;
    Regel     : STRING;

BEGIN
     MsgsAddLineTo (Body,'');

     IF Config.BounceSmall THEN
        { Start of original message follows below }
        MsgsAddLineTo (Body,GetLang0 (120))
     ELSE
         { Original message follows below: }
         MsgsAddLineTo (Body,GetLang0 (122));

     MsgsAddLineTo (Body,RepChar (70,'-'));
     MsgsAddLineTo (Body,'From: "'+Msg.PrevMsgPtr^.FromUser_F+'" at '+
                                  Fido2Str (Msg.PrevMsgPtr^.FromAddr_F));

     DestPtr:=Msg.PrevMsgPtr^.FirstDest;
     WHILE (DestPtr <> NIL) DO
     BEGIN
          CASE DestPtr^.ToType OF
               destCc :
                   Regel:='Cc:   ';

               destBcc :
                   Regel:='Bcc:  ';

               ELSE
                   Regel:='To:   ';
          END; { case }

          IF (DestPtr^.To_U <> '') AND (DestPtr^.ToUser_F = '') THEN
          BEGIN
               { e-mail address only }
               { suppress it if there is an FTN record with exactly this }
               { in the name part.                                       }

               DestPtr2:=Msg.PrevMsgPtr^.FirstDest;
               WHILE (DestPtr2 <> NIL) AND (NOT CaselessMatch (DestPtr2^.ToUser_F,DestPtr^.To_U)) DO
                     DestPtr2:=DestPtr2^.NextDest;

               IF (DestPtr2 <> NIL) THEN
               BEGIN
                    { found! }
                    DestPtr:=DestPtr^.NextDest;
                    Continue;                    { ## CONTINUE ## }
               END;

               Regel:=Regel+DestPtr^.To_U;
          END ELSE
          BEGIN
               Regel:=Regel+'"'+DestPtr^.ToUser_F+'" at '+
                                 Fido2Str (DestPtr^.ToAddr_F);
               IF (DestPtr^.To_U <> '') THEN
                  Regel:=Regel+' ('+DestPtr^.To_U+')';
          END;

          MsgsAddLineTo (Body,Regel);
          DestPtr:=DestPtr^.NextDest;
     END; { while }

     MsgsAddLineTo (Body,'Subj: '+Msg.PrevMsgPtr^.Subj_F);
     MsgsAddLineTo (Body,'Date: '+Msg.PrevMsgPtr^.Date_F);
     MsgsAddLineTo (Body,RepChar (70,'-'));
     MsgsAddLineTo (Body,'');

     IF Config.BounceSmall THEN
     BEGIN
          Truncated:=FALSE;
          N:=20;
          FOR Lp:=1 TO MAX_BODY_PARTS DO
          BEGIN
               IF (N = 0) THEN
               BEGIN
                    Truncated:=TRUE;
                    Break; { from the for }
               END;

               Dec (N,MsgsCopyNLines (Msg.PrevMsgPtr^.BodyParts[Lp],N));
          END; { for }

          IF Truncated THEN
          BEGIN
               {*** truncated rest of message ***}
               MsgsAddLineTo (Body,'');
               MsgsAddLineTo (Body,GetLang0 (121));
          END;
     END ELSE
         FOR Lp:=1 TO MAX_BODY_PARTS DO
             MsgsCopyNLines (Msg.PrevMsgPtr^.BodyParts[Lp],0);
END;


{--------------------------------------------------------------------------}
{ FTN_Bounce                                                               }
{                                                                          }
{ This routine bounces a message to its sender. This can either be a plain }
{ netmail recipient or a RFC user behind a remote gateway.                 }
{ Arguments:                                                               }
{  Reason: The text included in the bounce message.                        }
{  FromName: Internal name of unit bouncing the message.                   }
{  WasAddressedTo: Part of the bounce reason.                              }
{                                                                          }
PROCEDURE FTN_Bounce (Reason : STRING; FromName : STRING; WasAddressedTo : STRING);

VAR ReplyDesc : STRING;

BEGIN
     IF (Msg.ReplyEMail <> '') AND (Msg.ReplyUser <> '') THEN
        ReplyDesc:=Msg.ReplyEMail+' via "'+Msg.ReplyUser+'" at '+Fido2Str (Msg.ReplyAKA)
     ELSE
         ReplyDesc:='"'+Msg.FromUser_F+'" at '+Fido2Str (Msg.FromAddr_F);

     LogMessage (liGeneral,'Bouncing FTN message');
     LogExtraMessage ('Was addressed to: '+WasAddressedTo);
     LogExtraMessage ('Reason: '+Reason);
     LogExtraMessage ('Back to: '+ReplyDesc);

     FTN_PushAndBuildReply (GetLang1 (123,WasAddressedTo),0{automatic aka},FromName);

     { avoid looping on bounce filters }
     Msg.IsBounceMsg:=TRUE;

     { xxx bounced a message back to yyy }
     MsgsAddLineTo (Body,GetLang2 (124,Fido2Str (Msg.FromAddr_F),ReplyDesc));
     MsgsAddLineTo (Body,'');
     MsgsAddLineTo (Body,GetLang1 (100,Reason));

     FTN_CreateBounceBody;

     DeliverNow;
     MsgsPopState;
END;


{--------------------------------------------------------------------------}
{ FTN_BounceTo                                                             }
{                                                                          }
{ This routine bounces a message to a specific return address. This can be }
{ used to inform a SysOp about a user doing things they shouldn't.         }
{                                                                          }
PROCEDURE FTN_BounceTo (Reason : STRING; FromName, WasAddressedTo : STRING;
                        RemoteGW : BOOLEAN; ToName : STRING; ToAka : FidoAddrType; ToEmail : STRING);

VAR ReplyDesc : STRING;

BEGIN
     IF RemoteGW THEN
        ReplyDesc:=ToEMail+' via "'+ToName+'" at '+Fido2Str (ToAka)
     ELSE
         ReplyDesc:='"'+ToName+'" at '+Fido2Str (ToAka);

     LogMessage (liGeneral,'Bouncing FTN message to specified address');
     LogExtraMessage ('Was addressed to: '+WasAddressedTo);
     LogExtraMessage ('Reason: '+Reason);
     LogExtraMessage ('Sending to: '+ReplyDesc);

     { modified copy from PushAndBuildReply }

     MsgsPushState;   { performs a MsgsEmptyKeepSwapfile }

     { avoid looping on bounce filters }
     Msg.IsBounceMsg:=TRUE;

     { Add the recipient }
     IF RemoteGW THEN
        Address_AddRemoteGW (ToName,ToAka,ToEmail,FALSE{No Note},FALSE)
     ELSE
         Address_AddFTN (ToName,ToAka,FALSE,FALSE);

     { fill in the From information }
     Msg.FromUser_F:=FromName;
     Msg.FromAddr_F:=Config.NodeNrs[FidoMatchAKA (ToAka)];

     { fill in the rest }
     Msg.Subj_F:=GetLang1 (123,WasAddressedTo);
     Msg.Attr_F:=MSGPRIVATE OR MSGLOCAL;
     Msg.Date_F:=FidoCurrTime2Str;

     Msg.MsgID_F:=Fido2Str (Msg.FromAddr_F)+' '+GetFidoPktName;
     MsgsAddLineTo (Header_F,#1'MSGID: '+Msg.MsgID_F);
     MsgsAddLineTo (Header_F,BuildPIDKludge);
     MsgsAddLineTo (Header_F,BuildCHRSKludge (''));

     { note: no tear line anymore }

     Msg.Ready_F:=Netmail;

     { xxx bounced a message back to yyy }
     MsgsAddLineTo (Body,GetLang2 (124,Fido2Str (Msg.FromAddr_F),ReplyDesc));
     MsgsAddLineTo (Body,'');
     MsgsAddLineTo (Body,GetLang1 (100,Reason));

     FTN_CreateBounceBody;

     DeliverNow;
     MsgsPopState;
END;


{--------------------------------------------------------------------------}
{ FidoMinimal                                                              }
{                                                                          }
{ Bouwt een zo klein mogenlijk difference adres van 2 adressen, bijv.      }
{                                                                          }
{ 2:280/802 & 2:280/803.6   geeft 803.6 terug als string                   }
{                                                                          }
{ Deze routine is voornamelijk van belang voor het exporteren van cfg      }
{ files, zoals die van Squish, Areas.BBS etc.                              }
{                                                                          }
FUNCTION FidoMinimal (One,Two : FidoAddrType) : STRING;

VAR Regel : STRING;

BEGIN
     Regel:='';

     IF (One.Zone <> Two.Zone) THEN
     BEGIN
          FidoMinimal:=Fido2Str (Two);
          Exit;
     END;

     IF (One.Net <> Two.Net) THEN
        Regel:=Word2String (Two.Net)+'/'+Word2String (Two.Node)
     ELSE
         IF (One.Node <> Two.Node) THEN
            Regel:=Word2String (Two.Node);

     IF (Two.Point > 0) THEN
        Regel:=Regel+'.'+Word2String (Two.Point);

     FidoMinimal:=Regel;
END;


{--------------------------------------------------------------------------}
{ FidoGetKludgeID                                                          }
{                                                                          }
{ Identificeerd een regel en geeft een KludgeIDType terug.                 }
{                                                                          }
FUNCTION FidoGetKludgeID (Regel : STRING) : KludgesType;

VAR KludgeLp : KludgesType;

BEGIN
     { RWI 951117: de nog meer vernieuwde nog meer turbo versie }
     IF (Regel[1] = #1) THEN
     BEGIN
          { RWI970101: "Via" werd niet gedetecteerd omdat we zoeken naar }
          {            "VIA". Vanaf nu case-insensitive.                 }
          Regel:=UpCaseString (Regel);

          { omdat deze lus tot en met UnknownCtrlA loopt, en de regel }
          { zowiezo met die tekst begint, is er altijd een match.     }
          FOR KludgeLp:=klPath TO klUnknownCtrlA DO
              IF (Pos (KludgeNames[KludgeLp],Regel) = 1) THEN
              BEGIN
                   FidoGetKludgeID:=KludgeLp;
                   Exit;
              END;

          { wordt nooit bereikt }
     END ELSE
     BEGIN
          FOR KludgeLp:=klArea TO klTear DO
              IF (Pos (KludgeNames[KludgeLp],Regel) = 1) THEN
              BEGIN
                   FidoGetKludgeID:=KludgeLp;
                   Exit;
              END;
     END;

     FidoGetKludgeID:=klNone;

     (*
     { De vernieuwde turbo versie ... }
     FOR KludgeLp:=Area TO UnknownCtrlA DO
         IF (Pos (KludgeNames[KludgeLp],Regel) = 1) THEN
         BEGIN
              FidoGetKludgeID:=KludgeLp;
              Break; { uit de FOR loop }
         END;
     *)
END;


{--------------------------------------------------------------------------}
{ FidoAddLineToMessage                                                     }
{                                                                          }
{ Aangezien de code van deze routine op 3 verschillende plekken werd       }
{ gebruikt, nu samengevoegd op een plek.                                   }
{                                                                          }
{ De routine kijkt of een regel tot de Fido Kludges behoord en plaats de   }
{ de regel in de goed buffer.                                              }
{                                                                          }
PROCEDURE FidoAddLineToMessage (Regel : STRING; VAR LastRegel : STRING);

VAR KludgeID,
    KludgeLp  : KludgesType;
    WhereTo   : WhereToType;
    TmpFrom,
    TmpTo     : FidoAddrType;
    RegelNoCR : STRING;
    Hulp      : STRING; { was [90], didn't work for long origin lines }
    BadARec   : AreaBaseRecord; { voor BAD area }

BEGIN
     KludgeID:=FidoGetKludgeID (Regel);

     { RWI 970410: SEEN-BY and PATH in body are now ignored }
     {             when not preceeded by a tear line.       }
     { RAWI 980929: added option for Origin without tear    }
     IF (KludgeID IN [klPath,klSeenBy]) THEN
        IF ((NOT (Found_Tear OR Found_Origin)) OR (Msg.Ready_F IN [Netmail,Local_Netmail])) THEN
        BEGIN
             {LogMessage (liDebug,'Ignoring SEEN-BY or PATH before tear or Origin');}
             KludgeID:=klNone;
        END;

     IF (KludgeID = klNone) THEN
        WhereTo:=Body                        { gewone tekstregel }
     ELSE BEGIN
          RegelNoCR:=Regel;
          IF (RegelNoCR[Length (RegelNoCR)] = #13) THEN
             Delete (RegelNoCR,Length (RegelNoCR),1);

          CASE KludgeID OF

               klPid,
               klTid,
               klUnknownCtrlA : { Onbekende CTRL-A lijn, komt in de header }
                   WhereTo:=PrevWhereTo;

               klArea :
                   BEGIN
                        {RAWI 971012: keep the AREA: kludge from the message }
                        {             body. The PKT export routine will add  }
                        {             it again. This gives simplified xpost  }
                        {             handling.                              }
                        {WhereTo:=Header_F;}
                        WhereTo:=BittenBak;

                        IF (PrevKludgeID <> klNone) THEN
                           LogMessage (liFatal,'AREA kludge is not first kludge!');
                   END;

               klSeenby,
               klGwPath,
               klPath :
                   WhereTo:=Footer_F;

               klGatedOrigin :
                   { can be used in the tear, gatedorigin, origin check to validate an origin line }
                   WhereTo:=Footer_F;

               klOrigin :
                   BEGIN
                        { we hoeven er later geen meer toe te voegen }
                        Found_Origin:=TRUE;
                        WhereTo:=Footer_F;

                        IF (Msg.Ready_F = Echomail) THEN
                        BEGIN
                             { interpreteer het adres in de Origin }
                             IF (Pos ('(',Regel) = 0) THEN
                             BEGIN
                                  LogMessage (liFatal,'Cannot parse AKA from follow (invalid) Origin line:');
                                  LogExtraMessage (Regel);
                             END ELSE
                             BEGIN
                                  { neem de regel en haal de data die als    }
                                  { laatste tussen haakjes staat. Sla andere }
                                  { haakjes over.                            }

                                  Hulp:=Regel;

                                  WHILE (Pos ('(',Hulp) > 0) DO
                                        Hulp:=Copy (Hulp,Pos ('(',Hulp)+1,255);

                                  IF (Hulp[Length (Hulp)] = #13) THEN
                                     Delete (Hulp,Length (Hulp),1);

                                  IF (Hulp[Length (Hulp)] = ')') THEN
                                     Delete (Hulp,Length (Hulp),1);

                                  {LogMessage ('Origin hulp = "'+Hulp+'"');}

                                  IF (Hulp <> '') THEN
                                     FidoSplit (Hulp,Msg.FromAddr_F);
                             END;
                        END; { if echomail }
                   END; { klOrigin }

               klMsgId :
                   BEGIN
                        { Uit de MsgId kludge kan het gehele adres   }
                        { van verzending worden gehaald in geval van }
                        { een echomail. Maar mag ook in netmail voor }
                        { komen.                                     }

                        { tijdelijk nog even }
                        { RAWI 971006: removed..
                        Msg.MsgIDOnly_F:=FidoMsgId2Adres (Regel,Msg.FromAddr_F);
                        }

                        { Strip "^AMSGID: " }
                        IF (Length (Regel) < 8) THEN
                           Msg.MsgID_F:=''
                        ELSE
                            Msg.MsgID_F:=DeleteFrontSpaces (Copy (Regel,9,255));

                        IF (Msg.MsgID_F[Length (Msg.MsgID_F)] = #13) THEN
                           Delete (Msg.MsgID_F,Length (Msg.MsgID_F),1);

                        WhereTo:=Header_F;
                   END;

               klReply :
                   BEGIN
                        { Strip "^AREPLY: " }
                        IF (Length (Regel) < 8) THEN
                           Msg.ReplyID_F:=''
                        ELSE
                            Msg.ReplyID_F:=Copy (Regel,9,255);

                        IF (Msg.ReplyID_F[Length (Msg.ReplyID_F)] = #13) THEN
                           Delete (Msg.ReplyID_F,Length (Msg.ReplyID_F),1);

                        {LogExtraMessage ('ReplyID_F = "'+Msg.ReplyID_F+'"');}
                        WhereTo:=Header_F;
                   END;

               klIntl :
                   BEGIN
                        { Hieruit kan een gedeeltelijk adres     }
                        { worden gehaald. Volledig in combinatie }
                        { met TOPT en FMPT                       }
                        FidoIntl2Adres (RegelNoCR,TmpTo,TmpFrom);
                        FidoMergeAdres (TmpFrom,Msg.FromAddr_F);
                        FidoMergeAdres (TmpTo,Msg.Stored_ToAddr);

                        { RAWI 971012: not in the header anymore.    }
                        {              netmail export adds it again. }
                        {WhereTo:=Header_F;}
                        WhereTo:=BittenBak;
                   END;

               klToPt :
                   BEGIN
                        { Geeft het TO Point adres nummer      }
                        FidoGetPntNr (RegelNoCR,Msg.Stored_ToAddr.Point);

                        { RAWI 971012: not in the header anymore.    }
                        {              netmail export adds it again. }
                        {WhereTo:=Header_F;}
                        WhereTo:=BittenBak;
                   END;

               klFmPt :
                   BEGIN
                        { Geeft het FROM Point adres nummer    }
                        FidoGetPntNr (RegelNoCR,Msg.FromAddr_F.Point);

                        { RAWI 971012: not in the header anymore.    }
                        {              netmail export adds it again. }
                        {WhereTo:=Header_F;}
                        WhereTo:=BittenBak;
                   END;

               klVia :
                   BEGIN
                        { Mag alleen voorkomen in een Netmail bericht }
                        IF (Msg.Ready_F IN [NotReady,Netmail,Local_Netmail]) THEN
                           WhereTo:=Footer_F
                        ELSE
                            WhereTo:=Bittenbak;
                   END;

               klTear :
                   BEGIN
                        { TearLine }

                        { Controleer of de tearline correct is }
                        { Accepteer '---' & '--- WaterGate'    }
                        IF (Length (Regel) > 3) AND (Regel[4] IN [' ',#13,#10]) THEN
                        BEGIN
                             { tear gaat in de footer zodat we em kunnen }
                             { strippen.                                 }
                             WhereTo:=Bittenbak; { wachten tot origin/eom }
                        END ELSE
                        BEGIN
                             { not a kludge after all! }
                             { RWI970108: added KludgeID:=None to prevent }
                             { duplicate dashed lines!                    }
                             KludgeID:=klNone;
                             WhereTo:=Body;
                        END;
                   END;

               klFlags :
                   BEGIN
                        WhereTo:=Header_F;
                        FidoImportExtFlag (RegelNoCR);
                   END;

               klReplyAddr :
                   BEGIN
                        { #1REPLYADDR szarka@brazerko.com#13 }
                        { #1REPLYADDR: szarka@brazerko.com#13 }

                        { "Regel" zelf niet aanpassen!! }
                        Hulp:=Regel;

                        { weghalen zodat de dubbele punt ook mee gaat. Als }
                        { die er niet staat dan wordt de eerste spatie     }
                        { weggehaald, maar dat is ook geen probleem.       }

                        Delete (Hulp,1,11);
                        Hulp:=DeleteFrontAndBackSpaces (Hulp);

                        IF (Pos (#13,Hulp) > 0) THEN
                           Hulp:=Copy (Hulp,1,Pos (#13,Hulp)-1);

                        Msg.ReplyEMail:=Hulp;

                        WhereTo:=Header_F;
                   END;

               klReplyTo :
                   BEGIN
                        { #1REPLYTO 2:200/112 UUCP#13 }
                        { #1REPLYTO: 2:200/112 UUCP#13 }

                        Hulp:=Regel;

                        { kludge weghalen, eventueel met dubbele punt, }
                        { anders met de spatie.                        }
                        Delete (Hulp,1,9);
                        Hulp:=DeleteFrontSpaces (Hulp);

                        IF (Pos (#13,Hulp) > 0) THEN
                           Hulp:=Copy (Hulp,1,Pos (#13,Hulp)-1);

                        Hulp:=Hulp+' ';
                        FidoSplit (Copy (Hulp,1,Pos (' ',Hulp)-1),Msg.ReplyAka);
                        Delete (Hulp,1,Pos (' ',Hulp));

                        Msg.ReplyUser:=DeleteFrontAndBackSpaces (Hulp);

                        WhereTo:=Header_F;
                   END;

               klChrs,
               klChars,
               klCharset:
                   BEGIN
                        { #1CHARSET: IBM-PC#13 }
                        { #1CHARSET: IBM-PC 1#13 }

                        { verwijder tot en met dubbele punt }
                        Msg.Chrs_F:=Copy (Regel,Pos (':',Regel)+1,255);

                        { RAWI980927: was not checking for #13, so nr-less }
                        { kludge variant was never detected because of the #13 }
                        IF (Pos (#13,Msg.Chrs_F) > 0) THEN
                           Msg.Chrs_F:=Copy (Msg.Chrs_F,1,Pos (#13,Msg.Chrs_F)-1);

                        { add space in case number part is missing }
                        Msg.Chrs_F:=DeleteFrontSpaces (Msg.Chrs_F)+' ';

                        { delete number }
                        Msg.Chrs_F:=Copy (Msg.Chrs_F,1,Pos (' ',Msg.Chrs_F)-1);

                        WhereTo:=Header_F;
                   END;

               { deze (kunnen?) worden gebruikt tijdens het re-tossen van een BAD }
               klWtrBadArea :
                   BEGIN
                        WhereTo:=BittenBak;
                        Delete (Regel,1,13{@WTRBAD_AREA:});
                        Regel:=DeleteFrontSpaces (Regel);
                        IF (Regel[Length (Regel)] = #13) THEN
                           Delete (Regel,Length (Regel),1);
                        Msg.BadAreaRecNr:=GetAreaBaseRecordNrByAreaName_F (Regel);

                        { als ie nu wel bestaan, dan een AREA: kludge  }
                        { toevoegen en het bericht type zetten. Dit is }
                        { mooi centraal voor alle message base types.  }
                        IF (Msg.BadAreaRecNr <> NILRecordNr) THEN
                        BEGIN
                             ReadAreaBaseRecord (Msg.BadAreaRecNr,BadARec);
                             Msg.Area_F:=BadARec.AreaName_F ;
                             { Stop de AREA: kludge in de eerste regel van het bericht }
                             {MsgsAddLineTo (Header_F,'AREA:'+Msg.Area_F);}

                             { do not set this one to Local_Echomail,    }
                             { or it won't be imported into the attached }
                             { area!!                                    }
                             Msg.Ready_F:=Local_Echomail; {RAWI980501: was "Echomail"}
                        END ELSE
                            LogMessage (liConfig,'Area '+Regel+' not defined yet');
                   END;

               klWtrBadReason :
                   WhereTo:=BittenBak;

          END; { case }
     END; { is kludge }

     { #### let op: in sync houden met FidoAddLastLine #### }

     IF (PrevKludgeID = klTear) THEN
     BEGIN
          IF (KludgeID <> klNone{Origin/GwOrigin/GwPath/Seen-by/Path}) AND
             (KludgeID <> klTear{tear followed by tear}) THEN
          BEGIN
               IF Config.ReplaceTear AND
                  (Msg.Ready_F IN [Local_Netmail,Local_Echomail]) {="WeSend"}
               THEN
                   LastRegel:=FidoTear+#13; { RWI 941214: +#13 toegevoegd }

               Found_Tear:=TRUE;
               MsgsAddLineToNoEOL (Footer_F,LastRegel)
          END ELSE
              MsgsAddLineToNoEOL (Body,LastRegel);
     END;

     { voeg de huidige regel toe aan het bericht }
     MsgsAddLineToNoEOL (WhereTo,Regel);

     PrevKludgeID:=KludgeID;
     LastRegel:=Regel;

     { remember where the last kludge went, but not BittenBak or Body }
     IF (WhereTo IN [Header_F,Footer_F]) THEN
        PrevWhereTo:=WhereTo;
END;


{--------------------------------------------------------------------------}
{ FidoAddLastLine                                                          }
{                                                                          }
{ Deze routine moet aangeroepen worden als alle regels ingelezen zijn en   }
{ aan FidoAddLineToMessage gevoerd is. Hier wordt de laatste regel die     }
{ eventueel nog niet toegevoegd was, alsnog toegevoegd.                    }
{                                                                          }
PROCEDURE FidoAddLastLine (VAR LastRegel : STRING);
BEGIN
     IF (PrevKludgeID = klTear) THEN
     BEGIN
          { laatste regel, is dus de tear }
          IF Config.ReplaceTear AND
             (Msg.Ready_F IN [Local_Netmail,Local_Echomail]) {="WeSend"}
          THEN
              LastRegel:=FidoTear+#13; { RWI 941214: +#13 toegevoegd }

          Found_Tear:=TRUE;
          MsgsAddLineToNoEOL (Footer_F,LastRegel)
     END;

     IF (Msg.ReplyUser <> '') AND (Msg.ReplyEmail = '') THEN
     BEGIN
          { found a REPLYTO kludge but not a REPLYADDR kludge }
          { see if the From: heaer contains an e-mail address }
          IF (Pos ('@',Msg.FromUser_F) > 0) OR
             (Pos ('!',Msg.FromUser_F) > 0) THEN
             Msg.ReplyEmail:=Msg.FromUser_F;
     END;

     PrevKludgeID:=klNone;
     PrevWhereTo:=Header_F;
     LastRegel:='';

     AddViaLine;
END;


{--------------------------------------------------------------------------}
{ FidoExportExtFlag                                                        }
{                                                                          }
{ Plaats een FTC-0053 flag veld in het bericht.                            }
{ Dit voorstel is een uitbreiding op het 16-bits flag veld van de fido     }
{ standaard.                                                               }
{                                                                          }
CONST FlagNames : ARRAY[1..23] OF STRING[3] = ('PVT','HLD','CRA','K/S','SNT',
                                               'RCV','A/S','DIR','ZON','HUB',
                                               'FIL','FRQ','IMM','XMA','KFS',
                                               'TFS','LOK','RRQ','CFM','HIR',
                                               'COV','SIG','LET');

{--------------------------------------------------------------------------}
{ FidoAddToExtFlag                                                         }
{                                                                          }
{ Voegt een vlag toe aan het flag veld in het geheugen.                    }
{                                                                          }
PROCEDURE FidoAddToExtFlag (Flag : LONGINT);
BEGIN
     Msg.ExtAttr_F:=Msg.ExtAttr_F OR Flag;
END;


{--------------------------------------------------------------------------}
{ FidoExportExtFlag                                                        }
{                                                                          }
{ Bouwt op basis van informatie in het geheugen een FTSC-0053 type flag    }
{ file ala #1'FLAGS PVT HLD K/S'                                           }
{                                                                          }
PROCEDURE FidoExportExtFlag;

CONST FLAGS_KLUDGE = #1'FLAGS';

VAR Lp       : BYTE;
    FlagLine : STRING;

BEGIN
     FlagLine:=FLAGS_KLUDGE;

     FOR Lp:=0 TO 22 DO
         IF (((Msg.ExtAttr_F SHR Lp) AND 1) = 1) THEN
            FlagLine:=FlagLine+' '+FlagNames[Lp+1];

     IF (FlagLine <> FLAGS_KLUDGE) THEN
        MsgsAddLineTo (Header_F,FlagLine);
END;


{--------------------------------------------------------------------------}
{ FidoImportExtFlag                                                        }
{                                                                          }
{ Leest een FSC-0053 #1FLAG regel in, en vult het ExtFlag veld met de      }
{ gegevens.                                                                }
{                                                                          }
PROCEDURE FidoImportExtFlag (Invoer : STRING);

VAR P,
    Lp   : BYTE;
    Flag : STRING[10];

BEGIN
     { Verwijder de "#1FLAGS "}
     Delete (Invoer,1,7);
     Invoer:=DeleteFrontAndBackSpaces (Invoer);

     WHILE (Invoer <> '') DO
     BEGIN
          { RAWI 971206: revised }
          P:=Pos (' ',Invoer);
          IF (P > 0) THEN
          BEGIN
               Flag:=Copy (Invoer,1,P-1);
               Delete (Invoer,1,P);
               Invoer:=DeleteFrontSpaces (Invoer);
          END ELSE
          BEGIN
               Flag:=Invoer;
               Invoer:='';
          END;

          FOR Lp:=1 TO 23 DO
              IF (Flag = FlagNames[Lp]) THEN
              BEGIN
                   Msg.ExtAttr_F:=Msg.ExtAttr_F OR (Longint (1) SHL (Lp-1));
                   Break; { RAWI 971206: added }
              END;
     END; { while }
END;


{--------------------------------------------------------------------------}
{ FidoCreateSpecialTearline                                                }
{                                                                          }
{ Creer een tearline voor geregisteerde gebruikers.                        }
{                                                                          }
PROCEDURE FidoCreateRegTearLine;
BEGIN
     FidoTear:=KludgeNames[klTear];

     IF (NOT Config.EmptyTear) THEN
        FidoTear:=FidoTear+' '+DesktopProgramName+'+'+' v'+MainRevisionNr;
END;


{--------------------------------------------------------------------------}
{ FidoCreateUnRegTearLine                                                  }
{                                                                          }
PROCEDURE FidoCreateUnRegTearLine;
BEGIN
     FidoTear:=KludgeNames[klTear]+' '+DesktopProgramName+' v'+MainRevisionNr+' ';
     FidoTear:=FidoTear+Char (Byte (Month[6][2])-32)+Month[6][3]+Month[4][3]+Month[2][2]+Month[8][3]; { Unreg }
END;


{-----------------------------------------------------------------------}
{ FidoGetOtherPointAdres                                                }
{                                                                       }
{ Deze routine zoekt bij het opgegeven adres het 'andere' adres. Dit is }
{ nodig om bij netmailtjes die aan 60:100/1.33 gestuurd moeten worden   }
{ de gedefinieerd user als 60:1017/33 (pointnet) op te kunnen zoeken.   }
{ Deze routine zoekt bij 60:100/1.33 dus 60:1017/33 en andersom. Als er }
{ geen pointnet gedefinieerd is, dan wordt 0:0/0.0 terug gegeven.       }
{                                                                       }
FUNCTION FidoGetOtherPointAdres (Search : FidoAddrType; VAR Search2 : FidoAddrType ) : BOOLEAN;

VAR AkaNr : AkaIndexType;

BEGIN
     FidoGetOtherPointAdres:=TRUE; { assume found }

     AkaNr:=FidoMatchAdres (Search,Search2);

     IF (Search.Zone = Config.NodeNrs[AkaNr].Zone) AND
        (Search.Net = Config.PointNets[AkaNr]) AND
        (Search.Point = 0) AND
        (Config.NodeNrs[AkaNr].Point = 0) THEN
     BEGIN
          { nu heb ik een pointnet, ombouwen naar echt adres }
          { Search  heeft nu 60:1017/33 }
          { Search2 heeft nu 60:100/1 }
          Search2.Point:=Search.Net;
          Exit;
     END;

     IF (Search.Zone = Config.NodeNrs[AkaNr].Zone) AND
        (Search.Net = Config.NodeNrs[AkaNr].Net) AND
        (Search.Node = Config.NodeNrs[AkaNr].Node) AND
        (Search.Point <> 0) AND
        (Config.NodeNrs[AkaNr].Point = 0) THEN
     BEGIN
          { Ik heb nu een echt adres, ombouwen naar pointnet }
          { Search  heeft nu 60:100/1.33 }
          { Search2 heeft nu 60:100/1 }

          Search2.Net:=Config.PointNets[AkaNr];
          Search2.Node:=Search.Point;
          Search2.Point:=0;
          Exit;
     END;

     { not found }
     FidoSplit ('0',Search2);
     FidoGetOtherPointAdres:=FALSE;
END;


{--------------------------------------------------------------------------}
{ FidoMapPoint                                                             }
{                                                                          }
{ Geeft TRUE terug als het adres en de naam overeen komen met die van een  }
{ van onze points, zoals gedefinieerd in de userbase.                      }
{                                                                          }
FUNCTION FidoMapPoint (VAR Adres : FidoAddrType; ToUserName : STRING) : BOOLEAN;

VAR UserBaseLp : UserBaseRecordNrType;
    UserRecord : UserBaseRecord;

BEGIN
     { is het een van onze points? }
     FOR UserBaseLp:=1 TO UserBaseRecCount DO
     BEGIN
          ReadUserBaseRecord (UserBaseLp,UserRecord);

          WITH UserRecord DO
               IF (NOT Deleted) AND
                  (System = _F) AND
                  FidoOurPoint (Address) AND
                  (UpCaseString (Sysop) = UpCaseString (ToUserName)) THEN
               BEGIN
                    Adres:=UserRecord.Address;
                    FidoMapPoint:=TRUE;
                    Exit;
               END;

     END; { for }

     FidoMapPoint:=FALSE;
END;


{-------------------------------------------------------------------------}
{ FidoGetExtension                                                        }
{                                                                         }
{ Zoekt een bijpassende extensie voor een archive, na op de dag van de    }
{ week gelet te hebben, zoekt ie er ook nog een nummertje bij.            }
{ UserBaseRecNr is het userbase record nummer van de user waar het pakket }
{ naartoe moet. In dit record worden de tellers voor .SU0, .SU1, etc.     }
{ bijgehouden. Het record wordt hier ingelezen en eventueel weer naar     }
{ disk geschreven.                                                        }
{ There is always a return value, consisting of ".XXn"                    }
{                                                                         }
{ RWI 960219: Target outbound directory (voor Binkley) wordt nu mee       }
{             gegeven. De existentie van de archive wordt daarna in die   }
{             directory bekeken.                                          }
{                                                                         }
{ RAWI980521: New design:                                                 }
{                                                                         }
{ 1 - Regardless of known/unknown system                                  }
{ 2 - Take inventory of existing archives                                 }
{ 3 - Remember highest extension in use                                   }
{ 4 - Delete all zero-length archives (TFS case)                          }
{     and inc highest found so we will start a new archive.               }
{ 5 - If the archive with the highest extension exists, then check        }
{     if it has passed the max. size limit. If so, inc highest found      }
{     extension so we will start a new.                                   }
{ 6 - For known users: if stored latest used extension > latest found     }
{     then use stored number+1 instead (KFS case).                        }
{ 7 - Make sure new extension number is within limits.                    }
{ 8 - For known users: write new highest extension + dow to record.       }
{ 9 - Return new extension to use.                                        }
{                                                                         }
FUNCTION FidoGetExtension (ArchiveName   : STRING;
                           UserBaseRecNr : UserBaseRecordNrType;
                           OutboundDir   : STRING) : STRING;

CONST LastChars : ARRAY[0..35] OF CHAR = ('0','1','2','3','4','5','6','7',
                                          '8','9','A','B','C','D','E','F',
                                          'G','H','I','J','K','L','M','N',
                                          'O','P','Q','R','S','T','U','V',
                                          'W','X','Y','Z');
VAR Nop,DOW     : WordLong;
    Lp          : BYTE;
    Limit       : BYTE;
    Highest     : BYTE;
    Teken       : CHAR;
    UserRec     : UserBaseRecord;
    Search      : SearchRec;
    MaxArcLen   : LONGINT;
    DelFile     : FILE;
    IORes       : BYTE;
    Filename    : STRING;

BEGIN
     { Zoek uit welke dag van de week we op dit moment hebben }
     GetDate (Nop,Nop,Nop,DOW);

     { Controleer wat voor soort extensies we ondersteunen }
     CASE Config.FidoArcMailExtension OF
          ArcArc : Limit:=9;       { 0..9       }
          ArcHex : Limit:=15;      { 0..9, A..F }
          ArcAll : Limit:=35;      { 0..9, A..Z }
     END;

     { 1 - Regardless of defined user or not }

     IF (UserBaseRecNr <> NILRecordNr) THEN
     BEGIN
          ReadUserBaseRecord (UserBaseRecNr,UserRec);
          MaxArcLen:=UserRec.MaxArcLength;
     END ELSE
     BEGIN
          MaxArcLen:=0; { unlimited }
     END;

     { 2 - Taken an inventory of the existing archives }

     Highest:=255;
     FOR Lp:=0 TO Limit DO
     BEGIN
          { check if this archive exists }
          Filename:=OutboundDir+ArchiveName+'.'+Extensions[DOW]+LastChars[Lp];

          FindFirst (Filename,saJustFiles,Search);

          IF (DosError = 0) THEN
          BEGIN
               { found! }

               { 3 - Remember highest found extension }
               Highest:=Lp;

               { 4 - Delete all zero-length archives }
               IF (Search.Size = 0) THEN
               BEGIN
                    IF Config.LogDebug THEN
                       LogMessage (liGeneral,'Deleteing zero-length archive '+Filename);

                    { try to delete it }
                    Assign (DelFile,Filename);
                    {$I-} Erase (DelFile); {$I+} IORes:=IOResult;
                    IF (IORes <> 0) THEN
                       LogDiskIOError (IORes,'Error deleting zero-length archive '+Filename);

                    { continue anyway }
               END ELSE
                   { 5 - Check if archive has reached limit }
                   IF (MaxArcLen <> 0) AND (Search.Size > MaxArcLen) THEN
                   BEGIN
                        { yes, so use the next highest instead }
                        Inc (Highest);

                        LogMessage (liGeneral,'Archive '+Filename+' has reached limit');
                   END;

          END; { if found }

          FindClose (Search);

     END; { for }

     { 6 - Check record contents for known users }

     IF (UserBaseRecNr <> NILRecordNr) THEN
     BEGIN
          { if stored latest used extension > latest found then }
          { use stored number+1 instead.                        }

          { see if stored admin relates to correct DOW }
          IF (UserRec.LastArchDow <> (DOW+1)) THEN
          BEGIN
               UserRec.LastArchDow:=DOW+1;
               UserRec.LastArchNr:=255; { no useful info }
          END;

          { do compare if something useful is stored }
          IF (UserRec.LastArchNr <> 255) THEN
             IF (Highest = 255) OR (UserRec.LastArchNr > Highest) THEN
                { this number was not found, so it must have been sent }
                { and deleted (KFS). Good thing we have this admin! ;) }
                Highest:=UserRec.LastArchNr+1;
     END;

     { 7 - Make sure new extension number is within limits }

     IF (Highest > Limit) THEN     { fixes Highest == 255 case as well }
        Highest:=0; { loop around }

     { 8 - write new highest extension + dow to record }

     IF (UserBaseRecNr <> NILRecordNr) THEN
     BEGIN
          UserRec.LastArchNr:=Highest;
          WriteUserBaseRecord (UserBaseRecNr,UserRec);
     END;

     { 9 - Return new extension to use }

     Filename:='.'+Extensions[DOW]+LastChars[Highest];
     FidoGetExtension:=Filename;

     Filename:=OutboundDir+ArchiveName+Filename;

     IF Config.LogDebug THEN
        LogMessage (liDebug,'Archive to use: '+Filename);

     (*
     IF (UserBaseRecNr <> NILRecordNr) THEN
     BEGIN
          ReadUserBaseRecord (UserBaseRecNr,UserRec);

          IF (UserRec.LastArchDow <> (DOW+1)) THEN
          BEGIN
               UserRec.LastArchDow:=(DOW+1);
               UserRec.LastArchNr:=255; { eerste moet nog }
          END;

          { kijk of deze laatste archive er nog staat. Zoniet, dan }
          { moeten we een nieuwe aanmaken.                         }
          IF (UserRec.LastArchNr = 255) THEN
             Teken:='0'
          ELSE
              IF (UserRec.LastArchNr < 10) THEN
                 Teken:=Char (UserRec.LastArchNr+48)
              ELSE
                  Teken:=Char (UserRec.LastArchNr+55);

          { Kijk of deze file bestaat }
          { OutboundDir bevat een \ aan het einde }
          FindFirst (OutboundDir+ArchiveName+Teken,$3C,ZoekFile);
          IF (DosError = 0) THEN
          BEGIN
               { file bestaat al }

               { controleer of de file leeg is }
               IF (ZoekFile.Size = 0) THEN
               BEGIN
                    FindClose (ZoekFile);

                    Assign (DeleteFile,OutboundDir+ArchiveName+Teken);
                    {$I-} Erase (DeleteFile); {$I+} IORes:=IOResult;
                    IF (IORes <> 0) THEN
                       LogDiskIOError (IORes,'Error removing empty archive '+OutboundDir+ArchiveName+Teken);

                    IF (UserRec.LastArchNr = 255) THEN
                    BEGIN
                         UserRec.LastArchNr:=0;
                         WriteUserBaseRecord (UserBaseRecNr,UserRec);
                    END;

                    {## fout??!! Alle 0-byte files verwijderen!}
                    { en doorgaan met zoeken. Als UserRec.LastArchNr < seq.nr }
                    { dan updaten (ander programma heeft archive aangemaakt). }

                    FidoGetExtension:='.'+Extensions[DOW]+Teken;

                    Exit;     { ## EXIT ## }
               END;

               { file is niet leeg. Kijk of er nog ruimte in is }
               IF (UserRec.MaxArcLength = 0) OR (ZoekFile.Size < UserRec.MaxArcLength) THEN
               BEGIN
                    { er is nog ruimte. Neem deze }

                    IF (UserRec.LastArchNr = 255) THEN
                    BEGIN
                         UserRec.LastArchNr:=0;
                         WriteUserBaseRecord (UserBaseRecNr,UserRec);
                    END;

                    FindClose (ZoekFile);

                    FidoGetExtension:='.'+Extensions[DOW]+Teken;
                    Exit;
               END;
          END; { if }

          FindClose (ZoekFile);

          { file niet gevonden; dan is ie al verstuurd. Maak een nieuwe aan }
          IF (UserRec.LastArchNr = 255) THEN
             UserRec.LastArchNr:=0 { eerste file }
          ELSE
              IF (UserRec.LastArchNr = Limit) THEN
              BEGIN
                   LogMessage ('All ArcMail numbers have been used for '+Fido2Str (UserRec.Address)+'; restarting at 0');
                   UserRec.LastArchNr:=0;
              END ELSE
                  Inc (UserRec.LastArchNr);

          WriteUserBaseRecord (UserBaseRecNr,UserRec);

          IF (UserRec.LastArchNr < 10) THEN
             Teken:=Char (UserRec.LastArchNr+48)
          ELSE
              Teken:=Char (UserRec.LastArchNr+55);

          FindFirst (OutboundDir+ArchiveName+Teken,$3C,ZoekFile);
          IF (DosError = 0) THEN
             LogMessage ('Somehow '+OutboundDir+ArchiveName+Teken+' already exists. Adding to it!');

          FindClose (ZoekFile);
     END ELSE
     BEGIN
          { user niet gevonden }

          FOR FindArchive:=0 TO Limit DO
          BEGIN
               IF (FindArchive < 10) THEN
                  Teken:=Char (FindArchive+48)
               ELSE
                   Teken:=Char (FindArchive+55);

               IF (FindArchive <> 0) THEN
                  FindClose (ZoekFile); { nog van de vorige keer }

               FindFirst (OutboundDir+ArchiveName+Teken,$3C,ZoekFile);

               { Als een archive gevonden wordt, check dan :                }
               {                                                            }
               {  - Of het toevallig leeg is (0 bytes, truncated) verwijder }
               {    het dan                                                 }
               {  - Het niet 'vol' is, (niet > Config.MaxFidoArchiveSize)   }
               {                                                            }
               { Als het NIET gevonden is, betekent dat dat we dat nummer   }
               { gewoon kunnen gebruiken.                                   }

               IF (DosError = 0) THEN
               BEGIN
                    { gevonden }

                    { controleer of de file leeg is }
                    IF (Zoekfile.Size = 0) THEN
                    BEGIN
                         Assign (DeleteFile,OutboundDir+ArchiveName+Teken);
                         {$I-} Erase (DeleteFile); {$I+} IORes:=IOResult;
                         IF (IORes <> 0) THEN
                            LogDiskIOError (IORes,'Unable to remove empty archive file '+OutboundDir+ArchiveName+Teken);

                         {## causes re-use: not good!}

                         Break; { Archive is verwijderd, dus we kunnen het nummer gebruiken }
                    END;

                    IF (Config.MaxFidoArcLen = 0) OR (ZoekFile.Size < Config.MaxFidoArcLen) THEN
                       Break;
               END ELSE
                   Break; { Niet gevonden ! Dus archive is nog vrij }

          END; { for }

          FindClose (ZoekFile);
     END;

     FidoGetExtension:='.'+Extensions[DOW]+Teken;
     *)
END;


{--------------------------------------------------------------------------}
{ FidoCheckNetmail                                                         }
{                                                                          }
{ Controleert of een netmail bericht van lokale oorsprong wel verwerkt mag }
{ worden. Controle op, is ie wel lokaal? Is het voor de listserver?        }
{ Is het een frontdoor alike file attach? Is ie voor Areafix ?             }
{ Alles wat deze routine doet is de local flag zetten op die berichten.    }
{                                                                          }
FUNCTION FidoCheckNetmail (IsPrimaryNetmailArea : BOOLEAN; ToUser : STRING; ToAka : FidoAddrType) : BOOLEAN;

VAR UpToUser : STRING;
    Dummy    : FidoAddrType;

BEGIN
     {## werkt route-fido with forcepacked destination in FD mode?? ##}

     FidoCheckNetmail:=FALSE;

     { Als dit een netmail bericht is, en we draaien in frontdoor mode }
     { mag het bericht alleen verstuurd worden als het a) voor ons     }
     { bestemd is, en b) voor postmaster is !                          }

     UpToUser:=UpCaseString (ToUser);

     IF (Msg.Ready_F = Local_Netmail) THEN
     BEGIN
          { RWI 970110: moved MapFidoCheck up here, instead of _after_ }
          {             the system AKA check.                          }
          IF MapFidoCheck (UpToUser,ToAka) THEN
             Msg.Attr_F:=Msg.Attr_F OR MSGLOCAL
          ELSE
              IF FidoOurAdres (ToAka) THEN
              BEGIN
                   { Uitleg:                                  }
                   {                                          }
                   { Een bericht wordt toch verwerkt als het  }
                   {    a) voor de gateway is                 }
                   {    b) voor een list is                   }
                   {    c) voor de listserver is              }
                   {    d) een '@' in de naam heeft           }
                   {    e) Areafix is                         }
                   {    f) een '!' in de naam heeft   RWI 950810 }
                   {    g) voor een sendfile is       RWI 951117 }

                   IF (UpToUser = UpCaseString (Config.GatewayUser)) OR
                      (ListServerSearchName (UpToUser) <> NILPos) OR
                      (UpToUser = ListServer1) OR
                      (UpToUser = ListServer2) OR
                      (IsAreafixName (UpToUser)) OR
                      (Config.FidoAcceptTO AND ((Pos ('@',UpToUser) <> 0) OR (Pos ('!',UpToUser) <> 0))) OR
                      FidoSendFileCheck (UpToUser)
                   THEN
                       Msg.Attr_F:=Msg.Attr_F OR MSGLOCAL
                   ELSE
                       Exit;

              END ELSE
                  { RWI 960602: alleen voor de primaire netmail area }
                  { RWI 961011: geen f/a's met archives meer inpakken }
                  IF (IsPrimaryNetmailArea) AND (Config.FidoSystem = stFrontdoor) THEN
                  BEGIN
                       { In frontdoor mode gaan we geen berichten exporteren }
                       { naar onze bekende nodes, dat laten we aan Frontdoor }
                       { over.                                               }

                       { ForcePack doet dat nu toch wel, maar natuurlijk }
                       { NOOIT voor file attaches!!                      }

                       { RAWI 970511: no file attach messages are ever }
                       {              exported when in FrontDoor mode, }
                       {              because the file would be left   }
                       {              behind.                          }
                       {              When File Routing is implemented }
                       {              in a future version, then we     }
                       {              should only ignore messages from }
                       {              ARCmail.                         }

                       { RWI961011 }
                       IF {(Msg.FromUser_F = 'ARCmail') AND }((Msg.Attr_F AND MSGFILE) <> 0) THEN
                          Exit; { niet exporteren }

                       { geen file attach, dan FORCEPACK bekijken
                       RAWI 970508: now for routed addresses with forcepack
                                    destination as well..
                       IF (NOT CheckForcePack (Msg.ToAddr_F)) THEN
                          Exit;
                       }

                       { 0:no route, 1:import for fd, 2:route }
                       { we might need to allow case 0 as well }
                       IF (FindRoute (ToAka,Dummy) <> 2) THEN
                          Exit; { niet exporteren }
                  END;
     END; { local_netmail }

     { Tja,... al die moeite en dan staat er geen LOCAL vlag op het   }
     { bericht. Dan moeten we het toch echt weigeren...               }
     IF (Msg.Attr_F AND MSGLOCAL = 0) AND
        (Msg.Attr_F AND MSGFWD = 0)
     THEN
        Exit;

     FidoCheckNetmail:=TRUE;
END;


{--------------------------------------------------------------------------}
{ FidoFinishEchomailExport                                                 }
{                                                                          }
{ Deze routine maakt een geexporteerd bericht af. De Origin wordt          }
{ toegevoegd als er nog niet was en de SEEN-BY en PATH regels worden in    }
{ orde gemaakt.                                                            }
{                                                                          }
PROCEDURE FidoFinishEchomailExport (VAR AreaData : AreaBaseRecord);
BEGIN
     { tear line }
     IF (NOT Found_Tear) THEN
        MsgsAddLineTo (Footer_F,FidoTear);

     { Als er geen origin lijn gevonden kon worden }
     { RWI 950622: De juiste AREA Origin AKA wordt nu gebruikt }
     IF (NOT Found_Origin) THEN
        IF (AreaData.OriginNr <> 0) THEN  { RAWI 970321: was = 0 }
           MsgsAddLineTo (Footer_F,FidoBuildOrigin (Config.Origins[AreaData.OriginNr],
                                                    Config.NodeNrs[AreaData.OriginAKA]))
        ELSE
            MsgsAddLineTo (Footer_F,FidoBuildOrigin (AreaData.Origin,
                                                     Config.NodeNrs[AreaData.OriginAKA]));
END;


{--------------------------------------------------------------------------}
{ FidoMakeNormalAdres                                                      }
{                                                                          }
{ Deze routine controleert het opgegeven adres. Als het een pointnet adres }
{ is, dan wordt deze omgezet in het equivalent in een normaal adres.       }
{ 2:23456/15 -> 2:200/111.15                                               }
{                                                                          }
PROCEDURE FidoMakeNormalAdres (VAR Ad : FidoAddrType);

VAR Lp : 1..MaxAKAs;

BEGIN
     IF (Ad.Point <> 0) THEN
        Exit;  { kan geen pointnet adres zijn }

     FOR Lp:=1 TO MaxAKAs DO
         IF (Config.PointNets[Lp] = Ad.Net) THEN
         BEGIN
              { gevonden }
              Ad.Point:=Ad.Node;

              Ad.Net:=Config.NodeNrs[Lp].Net;
              Ad.Node:=Config.NodeNrs[Lp].Node;
              Exit;
         END;
END;


{--------------------------------------------------------------------------}
{ unit initialisation                                                      }
{                                                                          }
BEGIN
     FidoCreateUnRegTearLine;
     FidoPktNameInit;
     PrevWhereTo:=Header_F;
     PrevKludgeID:=klNone;
END.

