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

{ PC-Board                                                              }
{                                                                       }
{ Ondersteuning voor PCBoard v15.x                                      }
{                                                                       }
{ Een gebied bestaat uit 2 files: een *.IDX en een bestand met header   }
{ en bericht.                                                           }
{                                                                       }
{ MD 24-02-94 Heb de specs binnen en ben een beetje aan het spelen hoe  }
{             dit formaat in elkaar zit.                                }
{    25-02-94 Uitgevonden hoe het floating point formaat in elkaar zit  }
{    01-07-94 Nieuwe poging, PCBDUMP geschreven om uit te vinden wat    }
{             er mis gaat.. erg weinig :(                               }
{    03-07-94 De Micro2Longint en Longint2Micro routines opnieuw        }
{             geschreven, zou nu alle index problemen op moeten lossen  }

INTERFACE

{$IFNDEF PCBoard}

TYPE PCBoardBase = OBJECT
                         PROCEDURE InitBase;
                         PROCEDURE CloseBase;
                         PROCEDURE ScanArea;
                         PROCEDURE WriteMessage;
                   END;

VAR PCBoardMsgBase : PCBoardBase;

IMPLEMENTATION

PROCEDURE PCBoardBase.InitBase; BEGIN END;
PROCEDURE PCBoardBase.CloseBase; BEGIN END;
PROCEDURE PCBoardBase.ScanArea; BEGIN END;
PROCEDURE PCBoardBase.WriteMessage; BEGIN END;
{$ELSE}

         ## WARNING ##

         Deze code kan nog niet gebruik worden:

          - geen support voor swap file
          - geen support voor split parts
          - geen scan routine?

         ## WARNING ##

USES Ramon,
     Msgs,
     Logs,
     Dos;

TYPE PCB_MessageHeader = RECORD
                               Status     : Byte ;
                               MsgNumber  : LongInt;
                               RefNumber  : LongInt;
                               NumBlocks  : Byte;
                               Date       : ARRAY [1.. 8] OF Byte;
                               Time       : ARRAY [1.. 5] OF Byte;
                               ToField    : ARRAY [1..25] OF Byte;
                               ReplyDate  : LongInt;
                               ReplyTime  : ARRAY [1.. 5] OF Byte;
                               ReplyStatus: Byte;
                               FromField  : ARRAY [1..25] OF Byte;
                               SubjField  : ARRAY [1..25] OF Byte;
                               Password   : ARRAY [1..12] OF Byte;
                               ActiveFlag : Byte;
                               EchoFlag   : Byte;
                               Reserved1  : LongInt;
                               ExtendedSt : Byte;
                               Reserved2  : Byte;
                         END;

     PCB_IndexEntry  =   RECORD
                               Offset      : LongInt;
                               MessageNumb : LongInt;
                               TOName      : ARRAY[1..25] OF Byte;
                               FROMName    : ARRAY[1..25] OF Byte;
                               Status      : Byte;
                               Date        : Word;
                               Reserved    : ARRAY[1..3] OF Byte;
                         END;

     PCB_BaseHeader  =   RECORD
                               HighMessage : LongInt;
                               LowMessage  : LongInt;
                               Active      : LongInt;
                               Callers     : LongInt;
                               Locked      : ARRAY [1..6] OF Char;
                               Reserved    : ARRAY [1..106] OF Char;
                         END;

TYPE PCBoardBase = OBJECT
                         AreaPath : STRING;
                         AreaName : STRING;

                         IsOpen   : Boolean;

                         AreaFile : FILE;
                         IndexFile: FILE;

                         BaseHeader    : PCB_BaseHeader;
                         MsgHeader     : PCB_MessageHeader;

                         CONSTRUCTOR InitBase;
                         DESTRUCTOR  DeInitBase;

                         FUNCTION  OpenBase( VAR BoardName, BoardPath : String ) : BOOLEAN;
                         PROCEDURE CloseBase;
                         FUNCTION  CreateBase : BOOLEAN;
                         FUNCTION  ReadBaseHeader : BOOLEAN;
                         FUNCTION  WriteBaseHeader : BOOLEAN;
                         FUNCTION  LockBase: BOOLEAN;
                         FUNCTION  UnlockBase: BOOLEAN;

                         PROCEDURE WriteNewIndexEntry;

                         PROCEDURE WriteMessage( VAR Msg : MessageRecord ; BoardName, BoardPath : String );
                         PROCEDURE SetHeader( VAR Msg : MessageRecord );

                         FUNCTION  Fido2Julian( Source : String ) : Word;
                   END;

VAR PCBoardMsgBase : PCBoardBase;


IMPLEMENTATION

USES Globals;

CONST PCB_Days : ARRAY[0..1,1..12] OF WORD = ( (0,31,59,90,120,151,181,212,243,273,304,334),
                                               (0,31,60,91,121,152,182,213,244,274,305,335));


{--------------------------------------------------------------------------}
{ InitBase                                                                 }
{                                                                          }
{ Reset enkele variabelen bij het alloceren van de base                    }
{                                                                          }
CONSTRUCTOR PCBoardBase.InitBase;
BEGIN
     IsOpen:=FALSE;
     AreaPath:='';
     AreaName:='';
END;


{--------------------------------------------------------------------------}
{ DeInitBase                                                               }
{                                                                          }
{ Zorg voor een nette afhandeling van het afsluiten van de base            }
{                                                                          }
DESTRUCTOR PCBoardBase.DeInitBase;
BEGIN
     IF IsOpen THEN
        CloseBase;
END;


{--------------------------------------------------------------------------}
{ CreateBase                                                               }
{                                                                          }
{ Creert een base op disk als deze nog niet bestaat                        }
{                                                                          }
FUNCTION PCBoardBase.CreateBase : Boolean;
BEGIN
     CreateBase:=FALSE;
     LogMessage ('Creating PCBoard message base '+AreaPath);

     {$I-}
     ReWrite (AreaFile,1);
     ReWrite (IndexFile,1);

     WITH BaseHeader DO                          { Reset de base header }
     BEGIN
          HighMessage:=0;                        { Float nul is echt nul}
          LowMessage:=0;                         { Float nul is echt nul}
          Active:=0;
          Callers:=0;
          FillChar (Locked,6+106,0);
     END;

     BlockWrite (AreaFile,BaseHeader,SizeOf (PCB_BaseHeader));
     {$I+}
     IORes:=IOResult;

     IF (IORes <> 0) THEN
     BEGIN
          LogDiskIOError (IORes,'Unable to create PCBoard messagebase file '+AreaName);
          Exit;
     END;

     CreateBase:=TRUE;
END;


{--------------------------------------------------------------------------}
{ CLoseBase                                                                }
{                                                                          }
{ Sluit een message base af                                                }
{                                                                          }
PROCEDURE PCBoardBase.CloseBase;
BEGIN
     IF IsOpen THEN
     BEGIN
          Close (AreaFile);
          Close (IndexFile);
          AreaName:='';
          AreaPath:='';
          IsOpen:=FALSE;
     END;
END;


{--------------------------------------------------------------------------}
{ PCBOpenBase                                                              }
{                                                                          }
{ Opent een Pc-Board compatible message base                               }
{                                                                          }
FUNCTION PCBoardBase.OpenBase (VAR BoardName,BoardPath : STRING) : BOOLEAN;

VAR ZoekRec : SearchRec;

BEGIN
     { Kijk of we de goede base toevallig te pakken hebben }
     OpenBase:=FALSE;

     IF (BoardName = AreaName) THEN
     BEGIN
          OpenBase:=TRUE;
          Exit;
     END;

     IF IsOpen THEN
        CloseBase;

     AreaName:=BoardName;
     AreaPath:=BoardPath;

     Assign (AreaFile,AreaPath);
     Assign (IndexFile,AreaPath+'.IDX');

     { Controleer of het bestand wel bestaat }
     FindFirst (BoardPath,$3C,ZoekRec);

     { Creer als het nog niet aanwezig is }
     IF (DosError <> 0) THEN
     BEGIN
          IF NOT CreateBase THEN
             Exit;
     END;

     {$I-}
     Reset (Areafile,1);
     Reset (IndexFile,1);
     {$I+}

     IsOpen:=TRUE;
     OpenBase:=(IOResult = 0);
END;


{--------------------------------------------------------------------------}
{ WriteNewIndexEntry                                                       }
{                                                                          }
{ Schrijf een nieuwe index entry aan het einde van de index file, gevult   }
{ met informatie uit het huidige bericht.                                  }
{                                                                          }
PROCEDURE PCBoardBase.WriteNewIndexEntry;

VAR IndexEntry : PCB_IndexEntry;

BEGIN
     { Spring naar het einde van de indexfile }
     IF (FilePos (IndexFile) <> FileSize (IndexFile)) THEN
        Seek (IndexFile,FileSize (IndexFile));

     { Vul de entry met nuttige informatie }
     WITH IndexEntry DO
     BEGIN
          Offset:=FileSize (AreaFile);
          MessageNumb:=Micro2Longint (MsgHeader.MsgNumber);
          Move (MsgHeader.TOField,TOName,25);
          Move (MsgHeader.FROMField,FROMName,25);
          Status:=MsgHeader.Status;
          Date:=34515;{Fido2Julian( Msg.Date_F );}    { ### TODO ### }
     END;

     {$I-} BlockWrite (IndexFile,IndexEntry,SizeOf (IndexEntry)); {$I+} IORes:=IOResult;
     IF (IORes <> 0) THEN
        LogDiskIOError (IORes,'Error writing PC-Board index entry for '+AreaName);
END;


{--------------------------------------------------------------------------}
{ PCBWriteMessage                                                          }
{                                                                          }
{ Schrijft een bericht naar het aangegeven bord                            }
{                                                                          }
PROCEDURE PCBoardBase.WriteMessage (VAR Msg : MessageRecord; BoardName,BoardPath : STRING);

TYPE MemBlock = ARRAY[1..1] OF BYTE;

VAR Buffer         : ^MemBlock;
    Start          : WORD;
    FooterRegelPtr,
    RegelPtr       : EenRegelRecordPtr;
    BodyStart      : WORD;

    FUNCTION WriteFromMemory : BOOLEAN;

         FUNCTION AddToBuffer (Line : STRING) : BOOLEAN;
         BEGIN
              Line:=Line+#227;
              Move (Line[1],Buffer^[Start],Length (Line));
              Inc (Start,Length (Line));
              AddToBuffer:=(Start+255)>30000;
         END;

         { WriteToDisk -- Schrijf de inhoud van de buffer naar disk }
         PROCEDURE WriteToDisk;
         BEGIN
              { Set de Header }
              SetHeader (Msg);

              { Schrijf Index entry }
              WriteNewIndexEntry;

              { Voeg de fido footer toe aan het einde }
              { Zorg voor een fido header aan het begin van het bericht             }
              IF (Msg.FooterTop_F <> NIL) THEN
              BEGIN
                   FooterRegelPtr:=Msg.FooterTop_F^.FirstRegelRecordPtr;
                   WHILE (FooterRegelPtr <> NIL) DO
                   BEGIN
                        AddToBuffer (FooterRegelPtr^.RegelPtr^);
                        FooterRegelPtr:=FooterRegelPtr^.NextRegelRecordPtr;
                   END; { while }
              END;

              {Buffer vol}
              MsgHeader.NumBlocks:=Start DIV 128;
              IF (Start MOD 128 > 0) THEN
                 Inc (MsgHeader.NumBlocks);

              { Vul het laatste stuk op met spaties }
              FillChar (Buffer^[Start],33000-Start,32);

              { Copieer de header naar het begin }
              Move( MsgHeader,Buffer^[1],128);

              { Voeg het aan het einde toe       }
              Seek (AreaFile,FileSize (AreaFile));

              {$I-} BlockWrite (AreaFile,Buffer^[1],MsgHeader.Numblocks*128); {$I+}

              IF (IOResult <> 0) THEN
                 Exit;
         END; { WriteToDisk }

    BEGIN
         IF (MaxAvail < 33000) THEN
         BEGIN
              WriteFromMemory:=FALSE;
              Exit;
         END;

         { Vraag geheugen voor de buffer aan }
         { 32Kb is de maximum grootte voor   }
         { een PCBoard bericht (255*128)     }

         GetMem (Buffer,33000);
         Start:=129;

         AddToBuffer (#255#64'TO     :'+AddUpWithSpaces(60,Msg.ToUser_F)+'N');
         AddToBuffer (#255#64'FROM   :'+AddUpWithSpaces(60,Msg.FromUser_F)+'N');
         AddToBuffer (#255#64'SUBJECT:'+AddUpWithSpaces(60,Msg.Subj_F)+'N');

         { Zorg voor een fido header aan het begin van het bericht }
         IF (Msg.HeaderTop_F <> NIL) THEN
         BEGIN
              RegelPtr:=Msg.HeaderTop_F^.FirstRegelRecordPtr;
              RegelPtr:=RegelPtr^.NextRegelRecordPtr;          {Skip AREA:}

              WHILE (RegelPtr <> NIL) DO
              BEGIN
                   AddToBuffer( RegelPtr^.RegelPtr^ );
                   RegelPtr:=RegelPtr^.NextRegelRecordPtr;
              END; { while }
         END;

         { Zorg dat we de body niet steeds opnieuw hoeven in te vullen         }
         { We laten het nieuwe deel van het bericht gewoon aan het einde       }
         { van de header starten, die al in het geheugen stond                 }
         BodyStart:=Start;

         IF (Msg.BodyTop <> NIL) THEN
         BEGIN
              RegelPtr:=Msg.BodyTop^.FirstRegelRecordPtr;

              WHILE (RegelPtr <> NIL) DO
              BEGIN
                   IF AddToBuffer (RegelPtr^.RegelPtr^) THEN
                   BEGIN
                        WriteToDisk;
                        { Nog niet aan het einde, dus begin van een nieuw bericht }
                        Start:=BodyStart;
                   END;

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

              { Schrijf het restant naar disk }
              WriteToDisk;
         END;

         FreeMem (Buffer,33000);
    END;


BEGIN
     { Open base }
     IF (NOT OpenBase (BoardName,BoardPath)) THEN
        Exit;

     { Lock base }
     IF (NOT LockBase) THEN
        Exit;

     IF (NOT ReadBaseHeader) THEN
     BEGIN
          LogMessage ('Error reading base header of '+AreaName);
          Exit;
     END;

     { Bewaar het bericht }
     WriteFromMemory;

     { Update base }
     WriteBaseHeader;

     { Unlock base }
     UnlockBase;
END;


{--------------------------------------------------------------------------}
{ WriteHeader                                                              }
{                                                                          }
{ Schrijft een standaard PCBoard header naar disk.                         }
{                                                                          }
PROCEDURE PCBoardBase.SetHeader (VAR Msg : MessageRecord);

VAR TmpString : STRING;
    Tmpx      : LONGINT;

BEGIN
     { Vul de header met gegevens uit het bericht }
     WITH MsgHeader DO
     BEGIN
          IF (Msg.Ready_F = Echomail) THEN
             Status:=32   { Public bericht }
          ELSE
              Status:=42; { Prive bericht }

          BaseHeader.HighMessage:=LongInt2Micro (Micro2LongInt (BaseHeader.HighMessage)+1);
          BaseHeader.Active:=LongInt2Micro (Micro2LongInt (BaseHeader.Active)+1);

          IF (Micro2Longint (BaseHeader.LowMessage) = 0) THEN
             BaseHeader.LowMessage:=Longint2Micro (1);

          MsgNumber:=BaseHeader.HighMessage;
          RefNumber:=0;

          NumBlocks:=((Msg.HeaderTop_F^.TotalRegelLength+
                       Msg.BodyTop^.TotalRegelLength+
                       Msg.FooterTop_F^.TotalRegelLength) DIV 128)+1;

          IF ((Msg.HeaderTop_F^.TotalRegelLength+
               Msg.BodyTop^.TotalRegelLength+
               Msg.FooterTop_F^.TotalRegelLength) MOD 128) > 0
          THEN
              Inc (NumBlocks);

          TmpString:=AddupWithSpaces (25,Msg.ToUser_F);
          Move (TmpString[1],ToField[1],25);

          TmpString := AddupWithSpaces (25,Msg.FromUser_F);
          Move (TmpString[1],FromField[1],25);

          TmpString := AddupWithSpaces (25,Msg.Subj_F);
          Move (TmpString[1],SubjField[1],25);

          TmpString := AddUpwithSpaces (12,'');
          Move (TmpString[1],Password[1],12);

          ReplyDate:=0;
          ReplyTime[1]:=32;
          ReplyStatus:=32;

          ActiveFlag:=225; {Active}
          EchoFlag:=32;  {Hoeft niet meer de echo in}
          Reserved1:=0;
          ExtendedSt:=1{To}+2{From}+4{Subj}+32{Ignore?};
          Reserved2:=0;
     END;
END;


{--------------------------------------------------------------------------}
{ ReadBaseHeader                                                           }
{                                                                          }
{ Leest het tabelletje met info uit het begin van de message base          }
{                                                                          }
FUNCTION PCBoardBase.ReadBaseHeader : BOOLEAN;
BEGIN
     Seek (AreaFile,0);
     {$I-} BlockRead (AreaFile,BaseHeader,SizeOf (BaseHeader)); {$I+}
     ReadBaseHeader:=(IOResult = 0);
END;


{--------------------------------------------------------------------------}
{ WriteBaseHeader                                                          }
{                                                                          }
{ Leest het tabelletje met info uit het begin van de message base          }
{                                                                          }
FUNCTION PCBoardBase.WriteBaseHeader : BOOLEAN;
BEGIN
     Seek (AreaFile,0);
     {$I-} BlockWrite (AreaFile,BaseHeader,SizeOf (BaseHeader)); {$I+}
     WriteBaseHeader:=(IOResult = 0);
END;


{--------------------------------------------------------------------------}
{ LockBase                                                                 }
{                                                                          }
{ Probeer de base van een lock te voorzien,                                }
{                                                                          }
FUNCTION PCBoardBase.LockBase : BOOLEAN;
BEGIN
     LockBase:=TRUE;
END;


{--------------------------------------------------------------------------}
{ UnlockBase                                                               }
{                                                                          }
{ Geef het lock op de base weer vrij                                       }
{                                                                          }
FUNCTION PCBoardBase.UnlockBase : BOOLEAN;
BEGIN
     UnlockBase:=FALSE;
END;


{--------------------------------------------------------------------------}
{ Fido2Julian                                                              }
{                                                                          }
{ Converteerd een fido datum en tijd naar een juliaanse tijdsrekening      }
{                                                                          }
FUNCTION PCBoardBase.Fido2Julian (Source : STRING) : WORD;

VAR DT         : DateTime;
    Months,
    Error      : INTEGER;
    JulianTijd : WORD;

BEGIN
     WITH DT DO
     BEGIN
          Val (Copy (Source,1,2),Day,Error);
          Val (Copy (Source,8,2),Year,Error);
          Val (Copy (Source,12,2),Hour,Error);
          Val (Copy (Source,15,2),Min,Error);
          Val (Copy (Source,18,2),Sec,Error);
     END;

     FOR Months:=1 TO 12 DO
         IF Month[Months] = Copy (Source,4,3) THEN
            Break;

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

     JulianTijd:=36528*Dt.Year;
     IF ((JulianTijd MOD 100) = 0) AND (Months < 3) THEN
        Dec (JulianTijd);

     JulianTijd:=(JulianTijd-(1900*36528)) DIV 100;
     Fido2Julian:=JulianTijd+PCB_Days[0,Months]+DT.Day;
END;

{$ENDIF}
BEGIN
     PCBoardMsgBase.InitBase;
END.
