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

{$i platform.inc}

{ unit to support user names for local bbs users }

{ used to import messages for these users straight into a certain area }

INTERFACE

PROCEDURE RebuildBBSUsersIndex (Automatic : BOOLEAN; Path : STRING);
FUNCTION  IsKnownBBSUser (ToUser : STRING) : BOOLEAN;
FUNCTION  GetBBSUserID (UserNr : WORD) : LONGINT;
PROCEDURE ReadBBSUsersIndex (DebugMem : BOOLEAN);
PROCEDURE JunkBBSUsersIndex;


IMPLEMENTATION

USES Logs,
     Cfg,
     Ramon,
     Dos,
     Globals,
     Msgs;

{$I wtrhlp.inc}

CONST BBSUSERS_FILENAME = 'BBSUSERS.TDB';

TYPE BBSUserRecord = RECORD
                           UserID : LONGINT;
                           Code   : LONGINT;
                     END;

CONST MAX_BBSUSERS = 16382;  {65528 DIV 4}

TYPE BBSUsersArray = ARRAY[1..MAX_BBSUSERS] OF LONGINT;

VAR BBSUsersCount : WORD;
    BBSUsersPtr   : ^BBSUsersArray;

{--------------------------------------------------------------------------}
{ BbsFileMgr                                                               }
{                                                                          }
{ Deze wordt gebruikt door van alles en nog wat.                           }
{                                                                          }
PROCEDURE BbsFileMgr (BufferPtr : StringPtr; CheckOnly : BOOLEAN); FAR;

VAR OldLen : BYTE;

BEGIN
     IF CheckOnly THEN
        Exit;

     OldLen:=Length (BufferPtr^);
     BufferPtr^:=AddUpWithSpaces (OldLen,FileManager (DeleteFrontAndBackSpaces (BufferPtr^),'','*.*'));
END;


{--------------------------------------------------------------------------}
{ EnterPath                                                                }
{                                                                          }
{ Deze routine vraagt om het pad waar the text file met users gevonden kan }
{ worden.                                                                  }
{                                                                          }
FUNCTION EnterPath (VAR Path : STRING) : BOOLEAN;

CONST Xb = 5;
      Yb = 8;
      Xl = 65;
      Yl = 5;

VAR DaysStr : STRING[2];
    Nop     : ValNop;

BEGIN
     WindowPush (Xb,Yb,Xl,Yl);
     BoxDraw (Double,Xb,Yb,Xl,Yl);

     WriteXY (Xb+2,Yb+2,'Filename:');

     Path:=AddUpWithSpaces (79,Path);

     FieldInit;
     FieldAutoDefineFileMgr (Xb+12,Yb+2,51,@Path,BbsFileMgr,FALSE);
     FieldSetHelp (1,htr_BBSUsers_Path);

     REPEAT
           FieldEditDirect;
     UNTIL (Key = kEsc) OR (DeleteBackSpaces (Path) <> '');

     Path:=UNC_FExpand (DeleteFrontAndBackSpaces (Path));

     WindowPop;

     EnterPath:=(Key <> kEsc);
END;


{--------------------------------------------------------------------------}
{ CalcBBSUserIndexCode                                                     }
{                                                                          }
{ Deze routine berekend de CRC32 over de met spaties aangevulde naam en    }
{ geeft die terug.                                                         }
{                                                                          }
FUNCTION CalcBBSUserIndexCode (FullName : STRING) : LONGINT;
BEGIN
     FullName:=AddUpWithSpaces (100,UpCaseString (FullName));
     CalcBBSUserIndexCode:=UpdateCRC32 ($949325,FullName,100);
END;


{--------------------------------------------------------------------------}
{ RebuildBBSUserIndex                                                      }
{                                                                          }
{ Deze routine wordt gebruikt door WtrUtil om een index file van alle      }
{ users op het BBS aan te maken. Deze index is gewoon een tabel met een    }
{ CRC32 over de uppercased en met spaties aangevulde naam van iedere user. }
{ De invoerfile moet op iedere regel e'e'n naam hebben.                    }
{ Max 16000+ BBS users                                                     }
{                                                                          }
PROCEDURE RebuildBBSUsersIndex (Automatic : BOOLEAN; Path : STRING);

VAR InFile    : TEXT;
    IORes     : BYTE;
    OutFile   : FILE;
    UserCount : WORD;
    UserID    : LONGINT;
    Code      : LONGINT;
    FullName  : STRING;
    BBSRec    : BBSUserRecord;
    DoHex,
    HasHex    : BOOLEAN;
    Lp        : BYTE;

BEGIN
     IF (Path = '') AND (NOT Automatic) THEN
        IF (NOT EnterPath (Path)) THEN
           Exit;

     LogMessage (liGeneral,'Rebuilding '+Config.SystemDir+BBSUSERS_FILENAME);

     Assign (InFile,Path);
     {$I-} Reset (InFile); {$I+} IORes:=IOResult;
     IF (IORes <> 0) THEN
     BEGIN
          LogDiskIOError (IORes,'Error opening '+Path);
          Exit;
     END;

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

     Assign (OutFile,Config.SystemDir+BBSUSERS_FILENAME);
     {$I-} ReWrite (OutFile,1); {$I+} IORes:=IOResult;
     IF (IORes <> 0) THEN
     BEGIN
          LogDiskIOError (IORes,'Error creating '+Config.SystemDir+BBSUSERS_FILENAME);
          Close (InFile);
          Exit;
     END;

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

     LogExtraMessage ('Reading from '+Path);

     UserCount:=0;

     DoHex:=TRUE;

     WHILE (NOT Eof (InFile)) AND DoHex AND (UserCount < 10) DO
     BEGIN
          ReadLn (InFile,FullName);
          IF (FullName = '') THEN
             Continue;

          HasHex:=(Length (FullName) > 9) AND (FullName[9] = ' ');
          IF HasHex THEN
             FOR Lp:=1 TO 8 DO
                 HasHex:=HasHex AND (FullName[Lp] IN ['0'..'9','A'..'F','a'..'f']);

          DoHex:=DoHex AND HasHex;
          Inc (UserCount);
     END;

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

     IF DoHex THEN
        LogExtraMessage ('Detected format with User IDs');

     UserCount:=0;

     WHILE (NOT Eof (InFile)) DO
     BEGIN
          ReadLn (InFile,FullName);
          IF (FullName = '') THEN
             Continue;

          IF DoHex THEN
          BEGIN
               BBSRec.UserID:=HexString2Long (Copy (FullName,1,8));
               Delete (FullName,1,9);
          END ELSE
              BBSRec.UserID:=0;

          BBSRec.Code:=CalcBBSUserIndexCode (FullName);

          BlockWrite (OutFile,BBSRec,SizeOf (BBSUserRecord));

          Inc (UserCount);
     END; { while }

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

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

     LogMessage (liTrivial,'Done. Added '+Word2String (UserCount)+' users');
END;


{--------------------------------------------------------------------------}
{ ReadBBSUsersIndex                                                        }
{                                                                          }
{ Deze routine kijkt of een BBS user index file in de systeem directory    }
{ te vinden is. Deze wordt dan helemaal ingelezen.                         }
{                                                                          }
PROCEDURE ReadBBSUsersIndex (DebugMem : BOOLEAN);

CONST MAX_TEMP = 800;   { 100*8 = 800 bytes stack }

VAR InFile    : FILE;
    IORes     : BYTE;
    StorePos  : WORD;
    Temp      : ARRAY[1..MAX_TEMP] OF BBSUserRecord;
    BytesRead : WordLong;
    Lp        : BYTE;

BEGIN
     BBSUsersCount:=0;

     Assign (InFile,Config.SystemDir+BBSUSERS_FILENAME);
     {$I-} Reset (InFile,1); {$I+} IORes:=IOResult;
     IF (IORes <> 0) THEN
     BEGIN
          LogDiskIOError (IORes,'Error loading '+Config.SystemDir+BBSUSERS_FILENAME);
          Exit;
     END;

     {$IFDEF LogFileIO}PostOpenF (InFile);{$ENDIF}

     BBSUsersCount:=FileSize (InFile) DIV SizeOf (BBSUserRecord);

     IF (BBSUsersCount > MAX_BBSUSERS) THEN
        BBSUsersCount:=MAX_BBSUSERS;

     GetMem (BBSUsersPtr,BBSUsersCount*4);

     StorePos:=1;

     REPEAT
           {$I-} BlockRead (InFile,Temp,MAX_TEMP*SizeOf (BBSUserRecord),BytesRead); {$I+} IORes:=IOResult;
           IF (IORes <> 0) THEN
           BEGIN
                LogDiskIOError (IORes,'Error reading BBSUSERS.TDB');

                FreeMem (BBSUsersPtr,BBSUsersCount*SizeOf (BBSUserRecord));
                BBSUsersPtr:=NIL;
                BBSUsersCount:=0;

                {$IFDEF LogFileIO}PreCloseF (InFile);{$ENDIF}
                Close (InFile);
                Exit;
           END;

           FOR Lp:=1 TO (BytesRead DIV SizeOf (BBSUserRecord)) DO
           BEGIN
                BBSUsersPtr^[StorePos]:=Temp[Lp].Code;
                Inc (StorePos);
           END;

     UNTIL (BytesRead < MAX_TEMP*SizeOf (BBSUserRecord));

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

     LogMessage (liTrivial,'Loaded BBS users index');

     IF DebugMem THEN
        LogExtraMessage (MEMUSEFOR+'BBS Users = '+Word2String (BBSUsersCount*4));
END;


{--------------------------------------------------------------------------}
{ JunkBBSUsersIndex                                                        }
{                                                                          }
{ Geef het geheugen dat in gebruik is voor de BBS users weer vrij.         }
{                                                                          }
PROCEDURE JunkBBSUsersIndex;
BEGIN
     IF (BBSUsersPtr <> NIL) THEN
     BEGIN
          FreeMem (BBSUsersPtr,BBSUsersCount*4);
          BBSUsersPtr:=NIL;
     END;
END;


{--------------------------------------------------------------------------}
{ IsKnownBBSUser                                                           }
{                                                                          }
{ Deze routine geeft TRUE terug als de opgegeven naam waarschijnlijk een   }
{ BBS user is.                                                             }
{                                                                          }
FUNCTION IsKnownBBSUser (ToUser : STRING) : BOOLEAN;

VAR Lp   : WORD;
    Code : LONGINT;

BEGIN
     IF (BBSUsersCount > 0) THEN
     BEGIN
          Code:=CalcBBSUserIndexCode (ToUser);

          IsKnownBBSUser:=TRUE;

          FOR Lp:=1 TO BBSUsersCount DO
              IF (BBSUsersPtr^[Lp] = Code) THEN
              BEGIN
                   Msg.BBSUserIndex:=Lp;
                   Exit;
              END;
     END;

     IsKnownBBSUser:=FALSE;
END;


{--------------------------------------------------------------------------}
{ GetBBSUserID                                                             }
{                                                                          }
{ Deze routine leest uit de BBSUSERS.TDB file het ID van de opgegeven user }
{ en geeft deze terug.                                                     }
{                                                                          }
FUNCTION GetBBSUserID (UserNr : WORD) : LONGINT;

VAR InFile : FILE;
    IORes  : BYTE;
    BBSRec : BBSUserRecord;
    Lp     : BYTE;

BEGIN
     GetBBSUserID:=0;

     IF (UserNr = 0) OR (UserNr = 65535) THEN
        Exit;

     Assign (InFile,Config.SystemDir+BBSUSERS_FILENAME);
     {$I-} Reset (InFile,1); {$I+} IORes:=IOResult;
     IF (IORes <> 0) THEN
     BEGIN
          LogDiskIOError (IORes,'Failed to re-open '+BBSUSERS_FILENAME);
          Exit;
     END;

     {$IFDEF LogFileIO}PostOpenF (InFile);{$ENDIF}

     {$I-}
     Seek (InFile,(UserNr-1)*SizeOf (BBSUserRecord));
     BlockRead (InFile,BBSRec,SizeOf (BBSUserRecord));
     {$I+}
     IORes:=IOResult;

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

     IF (IORes = 0) THEN
          GetBBSUserID:=BBSRec.UserID;
END;


{--------------------------------------------------------------------------}
{ Unit Initialization                                                      }
{                                                                          }
BEGIN
     BBSUsersPtr:=NIL;
     BBSUsersCount:=0;
END.
