PROGRAM WCDump;

USES Ramon;

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

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


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

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

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

(*
TYPE WildCatBase = OBJECT
                         DatHdr   : wc_MsgHeader;
                   END;

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

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

BEGIN
     ReadHeaderEntry:=FALSE; { assume failure }

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

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

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

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

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

     Msg.Date_F:=FidoCurrTime2Str;

     ReadHeaderEntry:=TRUE; { successful }
END;


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

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

LABEL NextMsg;

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

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

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

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

           MsgsEmpty;

           CASE AreaData.AreaType OF
                Area_Netmail:
                    Msg.Ready_F:=Local_Netmail;

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

                ELSE BEGIN
                     Msg.Ready_F:=Local_Echomail;
                     { Stop de AREA: kludge in de eerste regel van het bericht }
                     Msg.Area_F:=AreaData.AreaName_F;
                     MsgsAddLineTo (Header_F,'AREA:'+Msg.Area_F);
                END;
           END; { case }

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

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

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

                Regel[0]:=Char (BytesRead);

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

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

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

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

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

           FidoAddLastLine (TRUE,LastRegel);

           { fix het bericht door ontbrekende delen bij te vullen }
           IF (NOT Found_Tear) THEN
              MsgsAddLineTo (Footer_F,FidoTear);

           { Zorg dat er een tearline wordt toegevoegd, een origin line }
           { zodat we een 'echt' fido bericht krijgen.                  }
           IF (AreaData.AreaType = Area_Echo) THEN
           BEGIN
                { als er geen origin lijn gevonden kon worden }
                { RWI 950722: Ipv de Origin AKA werd het adres van de   }
                {             zender in de origin line gebruikt. Fixed. }
                IF (NOT Found_Origin) THEN
                   IF (AreaData.OriginNr = 0) THEN
                      MsgsAddLineTo (Footer_F,FidoBuildOrigin (Config.Origins[AreaData.OriginNr],
                                                               Config.NodeNrs[AreaData.OriginAKA]{Msg.FromAddr_F}))
                   ELSE
                       MsgsAddLineTo (Footer_F,FidoBuildOrigin (AreaData.Origin,
                                                                Config.NodeNrs[AreaData.OriginAKA]{Msg.FromAddr_F}));

                { als er geen seenby lines waren }
                IF (NOT Found_SeenBy) THEN
                   FidoAddSeenBy (TRUE,AreaData,GetAreaBaseRecordNrByAreaName_F (AreaData.AreaName_F),'SEEN-BY:');

                { als er geen Path gevonden kon worden }
                IF (NOT Found_Path) THEN
                   FidoAddPath (#1'PATH:',AreaData);
           END;

           { Voeg INTL, TOPT en FMPT regels toe }
           IF (AreaData.AreaType = Area_EMail) THEN
           BEGIN
                IF (Msg.ToUser_F = '') THEN
                   Msg.ToUser_F:=Config.GatewayUser
                ELSE
                    IF (UpCaseString (Msg.ToUser_F) <> Config.GatewayUser) THEN
                    BEGIN
                         IF (Pos ('@',Msg.ToUser_F) = 0) AND (Pos ('!',Msg.ToUser_F) = 0) THEN
                         BEGIN
                              LogMessage ('WildCat msg '+Longint2String (DatHdr.MsgNumber)+
                                          ': No e-mail address in To: ("'+Msg.ToUser_F+'")');
                              GOTO NextMsg;  { geen e-mail! }
                         END;

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

                { zoek het bijpassende system node nummer voor in de To: }
                FidoMatch (Msg.FromAddr_F,Msg.ToAddr_F);

                Msg.Ready_F:=Local_Netmail;
           END;

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


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

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

           IF (AreaData.AreaType <> Area_Echo) THEN
           BEGIN
                { dus net of e-mail, local komt niet voor }
                MsgsAddlineTo (Header_F,#1'INTL '+Fido23DStr (Msg.ToAddr_F)+' '+
                                        Fido23DStr (Msg.FromAddr_F));

                IF (Msg.ToAddr_F.Point > 0) THEN
                   MsgsAddLineTo (Header_F,#1'TOPT '+Word2String (Msg.ToAddr_F.Point));

                IF (Msg.FromAddr_F.Point > 0) THEN
                   MsgsAddLineTo (Header_F,#1'FMPT '+Word2String (Msg.FromAddr_F.Point));
           END;

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

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

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

                UnlockBase;
           END;

           { -- Exporteer het bericht    }

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

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

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

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

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

           PrevCounter:=TouchCounter;

           MsgsExport;

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

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

                UpdateReadFile (AreaData.FidoMsgPath,0);

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

        NextMsg:

     UNTIL (NOT GetNextMessage);

     { einde area }
     CloseBase;
END;


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

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

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

    PROCEDURE EmptyWriteBuffer;

    VAR IORes : BYTE;

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

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

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

    VAR RegelLength : BYTE;

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

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

                            Move (EenRegelPtr^.RegelPtr^[1],WriteBufPtr^[WriteBufLen],RegelLength);

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

                            Inc (WriteBufLen,RegelLength);

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

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

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

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

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

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

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

{ WriteMessage }

VAR IORes          : BYTE;
    SplitParts     : WORD;
    SplitCurrent   : WORD;
    MaxLenBodyPart : WORD;
    HeaderPos      : LONGINT;

    BodyPtr        : EenRegelRecordPtr;
    SwapPos        : LONGINT;
    BodyLeft       : WORD;
    Regel          : STRING;

LABEL Einde;

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

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

     UpdateWriteFile (Area_Path,0);

     WriteBufPtr:=NIL;

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

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

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

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

     IF (Msg.BodyTop <> NIL) THEN
     BEGIN
          BodyPtr:=Msg.BodyTop^.FirstRegelRecordPtr;
          MsgsNewSeek (BodyPtr);
          SwapPos:=FilePos (SwapFile);
     END ELSE
     BEGIN
          BodyPtr:=NIL;
          SwapPos:=0;
     END;

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

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

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

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

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

                Dest:=Msg.ToUser_F;
                DestTitle:='';
                DestUserID:=0;

                Subject:=Msg.Subj_F;

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

                Network:='';

                FidoDateToWildCatDate (Msg.Date_F,MsgTime);

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

                mFlags:=mfSent; { to avoid exporting }

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

                Reference:=0;

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

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

                MsgBytes:=0; { will be updated }

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

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

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

           { schrijf (deel) bericht naar disk }

           WriteBufLen:=0;

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

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

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

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

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

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

           BodyLeft:=MaxLenBodyPart;

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

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

                { voeg de regel toe }
                Move (Regel[1],WriteBufPtr^[WriteBufLen],Length (Regel));
                Inc (WriteBufLen,Length (Regel));

                Dec (BodyLeft,Length (Regel));
           END; { while }

           IF SwapIsOpen THEN
              SwapPos:=FilePos (SwapFile);

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

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

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

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

     UNTIL (BodyPtr = NIL);

     UpdateInfoNr (INFO_WildCatSave_Msgs,1);

Einde:

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

     { verwijder het slot... }
     UnlockBase;

     { einde area }
     CloseBase;
END;
*)

FUNCTION mFlags2String (Flags : WORD) : STRING;

VAR Result : STRING;

BEGIN
     Result:='0x'+Word2HexString (Flags)+': ';

     IF (Flags AND $0001) <>0 THEN Result:=Result+'Private, ';
     IF (Flags AND $0002) <>0 THEN Result:=Result+'Receivable, ';
     IF (Flags AND $0004) <>0 THEN Result:=Result+'Received, ';
     IF (Flags AND $0008) <>0 THEN Result:=Result+'Receipt, ';
     IF (Flags AND $0010) <>0 THEN Result:=Result+'Carboned, ';
     IF (Flags AND $0020) <>0 THEN Result:=Result+'Forwarded, ';
     IF (Flags AND $0040) <>0 THEN Result:=Result+'EchoFlag, ';
     IF (Flags AND $0080) <>0 THEN Result:=Result+'?, ';
     IF (Flags AND $0100) <>0 THEN Result:=Result+'HasReplies, ';
     IF (Flags AND $0200) <>0 THEN Result:=Result+'Deleted, ';
     IF (Flags AND $0400) <>0 THEN Result:=Result+'Tagged, ';
     IF (Flags AND $0800) <>0 THEN Result:=Result+'Sent, ';
     IF (Flags AND $1000) <>0 THEN Result:=Result+'ChgAttach, ';
     IF (Flags AND $2000) <>0 THEN Result:=Result+'Forwarding, ';
     IF (Flags AND $4000) <>0 THEN Result:=Result+'NoDelete, ';
     IF (Flags AND $8000) <> 0 THEN Result:=Result+'NDAttach, ';

     Delete (Result,Length (Result)-1,2);

     mFlags2String:=Result;
END;


FUNCTION FidoAddress2String (Addr : wc_FidoAddress) : STRING;
BEGIN
     FidoAddress2String:=Word2String (Addr.Zone)+':'+
                         Word2String (Addr.Net)+'/'+
                         Word2String (Addr.Node)+'.'+
                         Word2String (Addr.Point);
END;


VAR IxFile  : FILE;
    DatFile : FILE;
    IORes   : BYTE;
    IxHdr   : wc_MsgIndexHeader;
    IxEntry : wc_MsgIndexEntry;
    DatHdr  : wc_MsgHeader;
    Lp      : BYTE;

LABEL Abort;

BEGIN
     WriteLn ('WCDump v1.00 / 970319 - by Ramon van der Winkel');
     WriteLn;

     IF (ParamCount = 0) THEN
     BEGIN
          WriteLn ('Usage: wcdump <message base filename>');
          WriteLn ('For example: wcdump abwg');
          Halt;
     END;

     Assign (IxFile,ParamStr (1)+'.IX');

     {$I-} Reset (IxFile,1); {$I+} IORes:=IOResult;
     IF (IORes <> 0) THEN
     BEGIN
          WriteLn ('Error opening '+ParamStr (1)+'.IX (error ',IORes,')');
          Halt;
     END;

     Assign (DatFile,ParamStr (1)+'.DAT');
     {$I-} Reset (DatFile,1); {$I+} IORes:=IOResult;
     IF (IORes <> 0) THEN
     BEGIN
          WriteLn ('Error opening '+ParamStr (1)+'.DAT (error ',IORes,')');
          Close (IxFile);
          Halt;
     END;


     { dump the IX header }
     WriteLn ('IX HEADER:');

     Seek (IxFile,0);
     {$I-} BlockRead (IxFile,IxHdr,SizeOf (wc_MsgIndexHeader)); {$I+} IORes:=IOResult;
     IF (IORes <> 0) THEN
     BEGIN
          WriteLn ('Error reading header from .IX file (error ',IORes,')');
          GOTO Abort;
     END;

     WriteLn ('  RecordSize:    ',IxHdr.RecordSize);
     WriteLn ('  ActiveRecords: ',IxHdr.ActiveRecords);
     WriteLn ('  NextMsgNumber: ',IxHdr.NextMsgNumber);
     WriteLn;

     WriteLn ('IX ENTRIES:');

     WHILE (FilePos (IxFile) < FileSize (IxFile)) DO
     BEGIN
          {$I-} BlockRead (IxFile,IxEntry,SizeOf (wc_MsgIndexEntry)); {$I+} IORes:=IOResult;
          IF (IORes <> 0) THEN
          BEGIN
               WriteLn ('Error reading entry from .IX file (error ',IORes,')');
               GOTO Abort;
          END;

          WriteLn ('  Number: ',IxEntry.MsgNumber:5,'  HeaderOffset: ',IxEntry.HeaderOffset);
     END; { while }

     WriteLn;

     { DAT contents }

     Seek (IxFile,SizeOf (wc_MsgIndexHeader));

     WHILE (FilePos (DatFile) < FileSize (DatFile)) DO
     BEGIN
          WriteLn ('Esc/Other key');
          IF (ReadKey = kEsc) THEN
             GOTO Abort;

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

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

          IF (IORes = 0) THEN
          BEGIN
               WriteLn;
               WriteLn ('MESSAGE HEADER:');
               WriteLn ('  IX: Offset:  ',IxEntry.HeaderOffset);
               WriteLn ('  IX: Number:  ',IxEntry.MsgNumber);
               WriteLn ('  MagicNumber: 0x',Longint2String (DatHdr.MagicNumber));
               WriteLn ('  MsgNumber:   ',DatHdr.MsgNumber);
               WriteLn ('  Orig:        ',DatHdr.Orig);
               WriteLn ('  OrigTitle:   ',DatHdr.OrigTitle);
               WriteLn ('  OrigUserID:  ',DatHdr.OrigUserID);
               WriteLn ('  Dest:        ',DatHdr.Dest);
               WriteLn ('  DestTitle:   ',DatHdr.DestTitle);
               WriteLn ('  DestUserID:  ',DatHdr.DestUserID);
               WriteLn ('  Subject:     ',DatHdr.Subject);
               WriteLn ('  Network:     ',DatHdr.Network);
               WriteLn ('  MsgTime:     Date:',DatHdr.MsgTime.Date,' Time:',DatHdr.MsgTime.Time);
               WriteLn ('  ReadTime:    Date:',DatHdr.ReadTime.Date,' Time:',DatHdr.MsgTime.Time);
               WriteLn ('  mFlags:      ',mFlags2String (DatHdr.mFlags));
               WriteLn ('  Reference:   ',DatHdr.Reference);
               WriteLn ('  FidoFrom:    ',FidoAddress2String (DatHdr.FidoFrom));
               WriteLn ('  FidoTo:      ',FidoAddress2String (DatHdr.FidoTo));
               WriteLn ('  MsgBytes:    ',DatHdr.MsgBytes);
               WriteLn ('  IntAttach:   ',DatHdr.InternalAttach);
               WriteLn ('  ExtAttach:   ',DatHdr.ExternalAttach);
               WriteLn ('  PrevUnread:  ',DatHdr.PrevUnread);
               WriteLn ('  NextUnread:  ',DatHdr.NextUnread);
               WriteLn ('  FidoFlags:   ',DatHdr.FidoFlags);
               WriteLn ('  Cost:        ',DatHdr.Cost);
               WriteLn ('  Area:        ',DatHdr.Area);

               Write   ('  Reserved:   ');
               FOR Lp:=1 TO 18 DO
                   Write (' ',DatHdr.Reserved[Lp]);
               WriteLn;

               WriteLn;
          END;

          IF (IORes <> 0) THEN
          BEGIN
               WriteLn ('Aborting because of IO error ',IORes);
               GOTO Abort;
          END;

     END; { while }

Abort:

     Close (IxFile);
     Close (DatFile);

     WriteLn;
     WriteLn ('WCDump finished');
END.
