{$I PLATFORM.INC}
{$IFDEF WtrGate}{$IFDEF UseOvr}{$O+,F+}{$ENDIF}{$ENDIF}
UNIT Logs;

{ Routines om gegevens naar de LogFile te sturen }

{ History

RvdW 20-02-93 Deze unit opgepoetst.
     25-05-93 Toevoeging ScreenToo.

}


INTERFACE

            { S = Shown on screen (and in log); L = In log only }
TYPE LogInd = (liReport,    {S}        {* + ** PLEASE REPORT ** }
               liFatal,     {S}        {!}
               liConfig,    {S}        {#}
               liDebug,     {L}        {%}
               liGeneral,   {S}        {+}
               liGeneralLog,{L}        {+}
               liTrivial,   {S}        {-}
               liTrivialLog,{L}        {-}
               liStats,     {S}        {=}
               liAdd);      { }        { }

TYPE DateStampString = STRING[15]; { Sat 03 Apr 1993 }
     TimeStampString = STRING[8];  { 09:35:10 }

FUNCTION  DateStamp : DateStampString;
FUNCTION  TimeStamp : TimeStampString;
PROCEDURE LogMessage (Ind : LogInd; Tekst : STRING);
PROCEDURE LogExtraMessage (Tekst : STRING);
PROCEDURE LogDiskIOError (IORes : BYTE; Tekst : STRING);
PROCEDURE LogClose;
PROCEDURE LogGetMem (At : POINTER; Len : WORD; Descr : STRING);
PROCEDURE Log_StoreFilePos;
PROCEDURE Log_SendReport;
PROCEDURE Log_HexDump (VAR Buffer; Count : WORD);
PROCEDURE Log_SetWindowSize (Lines : BYTE);
FUNCTION  Log_GetWindowSize : BYTE;

(*
PROCEDURE DeleteLogFile;
PROCEDURE LogBad (Tekst : STRING);
PROCEDURE LogNetmail (Tekst : STRING);
PROCEDURE LogFatalError (Tekst : STRING);
*)

{$IFDEF WtrUtil}
PROCEDURE ShrinkLogFile (Auto : BOOLEAN);
PROCEDURE ShrinkStaFile (Auto : BOOLEAN);
{$ENDIF}

VAR ScreenToo      : BOOLEAN;
    LogIsOpen      : BOOLEAN;
    SendingReport  : BOOLEAN;
    LogScreenLines : BYTE; { 4 voor 25 regels/scherm, 22 voor 43 regels/scherm }

{$IFDEF WtrUtil}
    ShrinkDays     : BYTE;
{$ENDIF}


IMPLEMENTATION

USES Dos,
     Ramon,
     Cfg,
     Globals,
     Address,

{ added for writing admin report: }
     Deliver,
     Database,
     FBuffer,
     Fido,
     Usenet,
     Msgs;

VAR LogFile        : TEXT;
    StoredPos      : LONGINT;
    LogFirst       : BOOLEAN;
    MemStrLen      : BYTE;

{--------------------------------------------------------------------------}
{ DateStamp                                                                }
{                                                                          }
{ Deze routine geeft een string in het formaat "Fri 26 Mar 1993" terug met }
{ de huidige dag van de week en datum erin.                                }
{                                                                          }
FUNCTION DateStamp : DateStampString;

CONST DOWs : ARRAY[0..6] OF STRING[3] = ('Sun','Mon','Tue','Wed','Thu','Fri','Sat');

VAR Year,Monthv,Day,DOW : WordLong;

BEGIN
     GetDate (Year,Monthv,Day,DOW);

     DateStamp:=DOWs[DOW]+' '+AddUpWithPre0s (2,Word2String (Day))+' '+
                Month[Monthv]+' '+Word2String (Year);
END;


{--------------------------------------------------------------------------}
{ TimeStamp                                                                }
{                                                                          }
{ Deze functie geeft een string in het formaat "10:13:12" terug met de     }
{ huidige tijd erin.                                                       }
{                                                                          }
FUNCTION TimeStamp : TimeStampString;

VAR Hour,Min,Sec,SecH  : WordLong;

BEGIN
     GetTime (Hour,Min,Sec,SecH);

     TimeStamp:=AddUpWithPre0s (2,Word2String (Hour))+':'+
                AddUpWithPre0s (2,Word2String (Min))+':'+
                AddUpWithPre0s (2,Word2String (Sec));
END;


{--------------------------------------------------------------------------}
{ LogOpen                                                                  }
{                                                                          }
{ This procedure opens the logfile and then sets IsOpen to TRUE.           }
{                                                                          }
PROCEDURE LogOpen;

VAR IORes      : BYTE;

    splitDir   : DirStr;
    splitName  : NameStr;
    splitExt   : ExtStr;

    Filename   : STRING;

BEGIN
     IF LogIsOpen THEN
        Exit;

     { RAWI 980128: can be called before the config file has been read     }
     IF (Config.LogFilePath = '') THEN
        Exit;

     { If we have to send the log file to the administrator, we want to    }
     { build the log entries to <LOGFILE>.ADM first.  When Log_SendReport  }
     { is called, the contents of this file will be appended to the master }
     { log and sent to the administrator address.                          }
     Filename := Config.LogFilePath;

     IF (Config.AdminAddrType <> 0) AND (Config.AdminSendLog) THEN
     BEGIN
          FSplit (Config.LogFilePath, splitDir, splitName, splitExt);
          Filename := splitDir + splitName + '.ADM';
     END;

     Assign (LogFile, Filename);
     {$I-} Append (LogFile); {$I+} IORes:=IOResult;
     IF (IORes = 2) THEN
     BEGIN
          {$I-} ReWrite (LogFile); {$I+} IORes:=IOResult;
     END;

     {
     IF (IORes = 4) THEN
        Error ('[LogMessage] Too many open files! Cannot write to log');
     }

     LogIsOpen:=(IORes = 0);

     IF (IORes = 0) THEN
     BEGIN
          {$IFDEF LogFileIO}PostOpenT (LogFile);{$ENDIF}

          IF LogFirst THEN
          BEGIN
               LogFirst:=FALSE;
               WriteLn (LogFile);
               LogMessage (liTrivial,'Starting '+FullProgramName+' v'+FullProgramVersion+' on '+DateStamp);
          END;
     END;
END;


{---------------------------------------------------------------------------}
{ LogClose                                                                  }
{                                                                           }
PROCEDURE LogClose;
BEGIN
     IF LogIsOpen THEN
     BEGIN
          {$IFDEF LogFileIO}PreCloseT (LogFile);{$ENDIF}
          Close (LogFile);
          LogIsOpen:=FALSE;
     END;
END;


CONST IndStr : ARRAY[LogInd] OF CHAR =
             ('*',          {liReport}
              '!',          {liFatal}
              '#',          {liConfig}
              '%',          {liDebug}
              '+',          {liGeneral}
              '+',          {liGeneralLog}
              '-',          {liTrivial}
              '-',          {liTrivialLog}
              '=',          {liStats}
              ' '           {liAdd}
             );

{--------------------------------------------------------------------------}
{ LogWriteMessage                                                          }
{                                                                          }
{ Deze routine schrijft een melding weg naar de logfile. Deze wordt        }
{ geopent, de melding geschreven en meteen weer gesloten om er zeker van   }
{ te zijn dat de tekst erin staat.                                         }
{                                                                          }
PROCEDURE LogWriteMessage (VAR Stamp : STRING;
                           Ind : LogInd;
                           VAR Tekst : STRING);

VAR Msg : STRING;

BEGIN
     Msg:='';

     IF (Tekst <> '') THEN
     BEGIN
{$IFNDEF FPC}
          IF Config.LogDebug THEN
             Msg:=AddUpWithSpaces (MemStrLen,Longint2String (_MemAvail));
{$ELSE}
          IF Config.LogDebug THEN
             Msg:=AddUpWithSpaces (MemStrLen,Longint2String (MaxAvail));
{$ENDIF}

          Msg:=Msg+Stamp+' '+IndStr[Ind]+' '+Tekst;

          IF (Ind = liReport) THEN
             Msg:=Msg+' ** PLEASE REPORT **';
     END;

     LogOpen;

     IF LogIsOpen THEN
        WriteLn (LogFile,Msg);

     { don't print debug messages on the screen; just in the log }
     IF (NOT NoFullScreen) THEN
     BEGIN
          IF (NOT (Ind IN [liDebug, liGeneralLog, liTrivialLog])) THEN BEGIN
               IF ScreenToo THEN
               BEGIN
                    ScrollUp (2,Video.Rows-LogScreenLines-1,78,LogScreenLines{4});
                    WriteXYC (2,Video.Rows-2,cBoxData,AddUpWithSpaces (78,Msg));
               END;
          END;
     END ELSE
          WriteLn (Msg);

     {$IFDEF LogDebug}
     LogClose;
     {$ENDIF}
END;


{--------------------------------------------------------------------------}
{ LogMessage                                                               }
{                                                                          }
{ Deze routine logt de opgegeven regel, met een DateTimeStamp ervoor.      }
{                                                                          }
PROCEDURE LogMessage (Ind : LogInd; Tekst : STRING);

VAR Temp : STRING[9];

BEGIN
     Temp:=TimeStamp;
     LogWriteMessage (Temp,Ind,Tekst);
END;


{--------------------------------------------------------------------------}
{ LogExtraMessage                                                          }
{                                                                          }
{ Zelfde routine als LogMessage, alleen worden er nu spaties ter lengte    }
{ van de DateTimeStamp aan vooraf gezet.                                   }
{                                                                          }
PROCEDURE LogExtraMessage (Tekst : STRING);

VAR Temp : STRING[9];

BEGIN
     Temp:=Spaces (9);
     LogWriteMessage (Temp,liAdd,Tekst);
END;


{--------------------------------------------------------------------------}
{ LogDiskIOError                                                           }
{                                                                          }
{ Met deze routine kan een melding van een disk I/O fout gemeld worden op  }
{ het scherm en in de log file. Het is geen critical error en de routine   }
{ zal dus gewoon terug keren.                                              }
{                                                                          }
PROCEDURE LogDiskIOError (IORes : BYTE; Tekst : STRING);

VAR Desc : STRING;

BEGIN
     Desc:='';

     CASE IORes OF
          2 : Desc:=':File not found';
          3 : Desc:=':Path not found';
          4 : Desc:=':Too many open files';
          5 : Desc:=':Access denied';
          100 : Desc:=':Disk read error';

          {101 : RWI961027: verwijderd }
     END; { case }

     LogMessage (liFatal,Tekst+' (code '+Byte2String (IORes)+Desc+')');

     IF (IORes = 4) THEN
        LogExtraMessage ('Try lowering "Max. open handles" in WtrConf!!');
END;


(*
{--------------------------------------------------------------------------}
{ LogBad                                                                   }
{                                                                          }
{ Deze routine schrijft een melding weg naar de logfile waarin komt te     }
{ staan waarom een bericht de bad in is gegooid.                           }
{                                                                          }
PROCEDURE LogBad (Tekst : STRING);

VAR LogFile : TEXT;
    IORes   : BYTE;

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

     {
     IF (IORes = 4) THEN
        Error ('[LogBad] Too many open files! Cannot write to log');
     }

     IF (IORes = 0) THEN
     BEGIN
          WriteLn (LogFile,Tekst);
          Close (LogFile);
     END;
END;


{--------------------------------------------------------------------------}
{ LogNetmail                                                               }
{                                                                          }
{ Deze routine schrijft een melding weg naar de logfile waarin komt te     }
{ staan wat er met de netmail is gedaan.                                   }
{                                                                          }
PROCEDURE LogNetmail (Tekst : STRING);

VAR LogFile : TEXT;
    IORes   : BYTE;

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

     {
     IF (IORes = 4) THEN
        Error ('[LogNetmail] Too many open files! Cannot write to log');
     }

     IF (IORes = 0) THEN
     BEGIN
          WriteLn (LogFile,Tekst);
          Close (LogFile);
     END;
END;


{--------------------------------------------------------------------------}
{ DeleteLogFile                                                            }
{                                                                          }
{ Deze routine wist de logfile van disk, zodat alleen de melden van deze   }
{ run aan het einde in de .LOG file staan.                                 }
{ De BAD.LOG wordt op dit moment ook tijdelijk even verwijderd.            }
{                                                                          }
PROCEDURE DeleteLogFile;

VAR DelFile : FILE;
    IORes   : BYTE;

BEGIN
     Assign (DelFile,Config.LogFilePath);
     {$I-} Erase (DelFile); {$I+} IORes:=IOResult;

     Assign (DelFile,Config.SystemDir+'BAD.LOG');
     {$I-} Erase (DelFile); {$I+} IORes:=IOResult;

     Assign (DelFile,Config.SystemDir+'NETMAIL.LOG');
     {$I-} Erase (DelFile); {$I+} IORes:=IOResult;
END;
*)

(* RWI 961027: waaaayy too grof!
{--------------------------------------------------------------------------}
{ LogFatalError                                                            }
{                                                                          }
{ Sluit de desktop, en schrijft een string naar het scherm.                }
{                                                                          }
PROCEDURE LogFatalError (Tekst : STRING);
BEGIN
     CloseDesktop;
     WriteLn (Tekst);
     WriteLn;
     Halt (2);
END;
*)


{$IFDEF WtrUtil}
{---------------------------------------------------------------------------}
{ ShrinkLogFile                                                             }
{                                                                           }
{ Deze routine zorgt dat de history in de logfile uitgedunt wordt tot een   }
{ X aantal dagen.                                                           }
{                                                                           }
PROCEDURE ShrinkLogFile (Auto : BOOLEAN);

CONST Xb = 20;
      Yb = 7;
      Xl = 40;
      Yl = 5;

      MonthStrs : ARRAY[1..12] OF STRING[5] = (' Jan ',' Feb ',' Mar ',
                                               ' Apr ',' May ',' Jun ',
                                               ' Jul ',' Aug ',' Sep ',
                                               ' Oct ',' Nov ',' Dec ');

      DaysPerMonth : ARRAY[1..12] OF BYTE = (31,28,31,30,31,30,31,31,30,31,30,31);

VAR InFile,
    NewFile  : TEXT;
    Regel    : STRING;
    Lp,P     : BYTE;
    DayStr   : STRING[2];
    Day      : BYTE;
    Nop      : ValNop;
    CurrD,
    CurrM,
    Dummy    : WordLong;
    TrashedSome,
    KeepRest : BOOLEAN;
    IORes    : BYTE;

LABEL QuitNow,
      DoneNow;

BEGIN
     LogClose;

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

     WriteXY (Xb+2,Yb+1,'History keep:');
     WriteXY (Xb+2,Yb+2,'Keeping from:');
     WriteXY (Xb+2,Yb+3,'Status:');

     WriteXYC (Xb+16,Yb+1,cBoxData,Byte2String (ShrinkDays)+' days');
     WriteXY (Xb+16,Yb+3,'Searching...');

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

     Assign (InFile,Config.LogFilePath);
     {$I-} Reset (InFile); {$I+} IORes:=IOResult;
     IF (IORes <> 0) THEN
     BEGIN
          IF (NOT Auto) THEN
             Error ('Error opening logfile '+Config.LogFilePath+' (error '+Byte2String (IORes)+')');
          GOTO QuitNow;
     END;

     Assign (NewFile,ExtractPathPart (Config.LogFilePath)+'WTRLOG.$$$');
     {$I-} ReWrite (NewFile); {$I+}
     IF (IOResult <> 0) THEN
     BEGIN
          { tijdelijke file kan niet aangemaakt worden -> kappen }
          Close (InFile);

          IF (NOT Auto) THEN
             Error ('Cannot create temporary logfile WTRLOG.$$$ (error '+Byte2String (IORes)+')');

          GOTO QuitNow;
     END;

     GetDate (Dummy,CurrM,CurrD,Dummy);

     KeepRest:=FALSE;
     TrashedSome:=FALSE;
     WHILE (NOT Eof (InFile)) DO
     BEGIN
          ReadLn (InFile,Regel);

          IF KeepRest THEN
          BEGIN
               WriteLn (NewFile,Regel);
               Continue;
          END;

          Regel:=DeleteFrontSpaces (Regel);

          IF (Regel = '') THEN
          BEGIN
               TrashedSome:=TRUE;
               Continue; { volgende regel }
          END;

          FOR Lp:=1 TO 12 DO
          BEGIN
               P:=Pos (MonthStrs[Lp],Regel);
               IF (P > 0) THEN
               BEGIN
                    DayStr:=Copy (Regel,P-2,2);
                    IF (DayStr[1] = ' ') THEN
                       Delete (DayStr,1,1);

                    Val (DayStr,Day,Nop);

                    IF (Lp = CurrM) THEN
                    BEGIN
                         IF (CurrD-Day <= ShrinkDays) THEN
                            KeepRest:=TRUE;
                    END ELSE
                        IF ((Lp = 12) AND (CurrM = 1)) OR (Lp = CurrM-1) THEN
                        BEGIN
                             IF (CurrD+DaysPerMonth[Lp]-Day <= ShrinkDays) THEN
                                KeepRest:=TRUE;
                        END;

                    IF KeepRest THEN
                    BEGIN
                         WriteLn (NewFile,Regel);

                         Regel:=Copy (Regel,P-6,255);
                         IF (Regel[1] = ' ') THEN
                            Delete (Regel,1,1);

                         WriteXYC (Xb+16,Yb+2,cBoxData,Regel);

                         IF (NOT TrashedSome) THEN
                         BEGIN
                              { snelle sessie, er verandert namelijk niets! }
                              Close (InFile);
                              Close (NewFile);
                              Erase (NewFile); { niet meer nodig }
                              WriteXYC (Xb+16,Yb+3,cBoxData,'Done (nothing changed)');
                              LogMessage (liTrivial,'Shrinking the logfile (nothing to do)');
                              GOTO DoneNow;
                         END;

                         WriteXYC (Xb+16,Yb+3,cBoxData,'Copying...  ');
                    END;

                    Break; { uit de for }
               END;
          END; { for }

     END; { while }

     Close (InFile);
     Close (NewFile);

     {$I-} Erase (InFile); {$I+} IORes:=IOResult;
     IF Auto AND (IORes <> 0) THEN
        Error ('Cannot erase old logfile (error '+Byte2String (IORes)+')');

     {$I-} Rename (NewFile,Config.LogFilePath); {$I+} IORes:=IOResult;
     IF Auto AND (IORes <> 0) THEN
        Error ('Cannot rename temporary logfile (error '+Byte2String (IORes)+')');

     WriteXYC (Xb+16,Yb+3,cBoxData,'Done        ');
     LogMessage (liTrivial,'Shrunk the logfile to '+Byte2String (ShrinkDays)+' history days');

     LogClose;

DoneNow:
     IF (NOT Auto) THEN
     BEGIN
          WriteKeysLine (' Press ^any key to continue...');
          ReadKey;
     END;

QuitNow:
     PopKeysLine;
     WindowPop;
END;


{---------------------------------------------------------------------------}
{ ShrinkStaFile                                                             }
{                                                                           }
{ This routine shrinks the history file, keeping X number of days worth of  }
{ statistics.  Delete all entries older than X.                             }
{ 19990824[don't care]                                                      }
{                                                                           }
PROCEDURE ShrinkStaFile (Auto : BOOLEAN);

CONST Xb = 20;
      Yb = 7;
      Xl = 40;
      Yl = 5;

      {
      MonthStrs : ARRAY[1..12] OF STRING[5] = (' Jan ',' Feb ',' Mar ',
                                               ' Apr ',' May ',' Jun ',
                                               ' Jul ',' Aug ',' Sep ',
                                               ' Oct ',' Nov ',' Dec ');
      }

      DaysPerMonth : ARRAY[1..12] OF BYTE = (31,28,31,30,31,30,31,31,30,31,30,31);

VAR Dir      : DirStr;
    Name     : NameStr;
    Ext      : ExtStr;
    StaPath  : STRING[80];
    InFile,
    NewFile  : TEXT;
    IORes    : BYTE;
    Regel    : STRING;
    Lp       : BYTE;
    Day      : BYTE;
    Nop      : ValNop;
    CurrD,
    CurrM,
    Dummy    : WordLong;
    TrashedSome,
    KeepRest : BOOLEAN;

LABEL QuitNow,
      DoneNow;

BEGIN
     LogClose;

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

     WriteXY (Xb+2,Yb+1,'History keep:');
     WriteXY (Xb+2,Yb+2,'Keeping from:');
     WriteXY (Xb+2,Yb+3,'Status:');

     WriteXYC (Xb+16,Yb+1,cBoxData,Byte2String (ShrinkDays)+' days');
     WriteXY (Xb+16,Yb+3,'Searching...');

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

     FSplit (UNC_FExpand (Config.LogfilePath),Dir,Name,Ext);
     StaPath:=Dir+Name+'.STX';

     Assign (InFile,StaPath);
     {$I-} Reset (InFile); {$I+} IORes:=IOResult;
     IF (IORes <> 0) THEN
     BEGIN
          IF (NOT Auto) THEN
             Error ('Error opening statistics file '+StaPath+' (error '+Byte2String (IORes)+')');
          GOTO QuitNow;
     END;

     Assign (NewFile,ExtractPathPart (StaPath)+'WTRSTA.$$$');
     {$I-} ReWrite (NewFile); {$I+}
     IF (IOResult <> 0) THEN
     BEGIN
          { tijdelijke file kan niet aangemaakt worden -> kappen }
          Close (InFile);

          IF (NOT Auto) THEN
             Error ('Cannot create temporary logfile WTRSTA.$$$ (error '+Byte2String (IORes)+')');

          GOTO QuitNow;
     END;

     GetDate (Dummy,CurrM,CurrD,Dummy);

     KeepRest:=FALSE;
     TrashedSome:=FALSE;
     WHILE (NOT Eof (InFile)) DO
     BEGIN
          ReadLn (InFile,Regel);

          IF KeepRest THEN
          BEGIN
               WriteLn (NewFile,Regel);
               Continue;
          END;

          IF (DeleteFrontAndBackSpaces (Regel) = '') THEN
          BEGIN
               TrashedSome := TRUE;
               Continue;
          END;

          { Grab the date }
          { ------DD }
          { 12345678 }
          Val (Copy (Regel, 7, 2), Day, Nop);

          { ----MM-- }
          { 12345678 }
          Val (Copy (Regel, 5, 2), Lp, Nop);

          IF (Lp = CurrM) THEN
          BEGIN
               IF (CurrD-Day <= ShrinkDays) THEN
                  KeepRest:=TRUE;
          END ELSE
               IF ((Lp = 12) AND (CurrM = 1)) OR (Lp = CurrM-1) THEN
                    IF (CurrD+DaysPerMonth[Lp]-Day <= ShrinkDays) THEN
                         KeepRest:=TRUE;

          IF KeepRest THEN
          BEGIN
               WriteLn (NewFile,Regel);

               { Make date as 1999-8-22 }
               Regel := Copy (Regel, 1, 4) + '-' + Copy (Regel, 5, 2) + '-' +
                              Copy (Regel, 7, 2);
               WriteXYC (Xb+16,Yb+2,cBoxData,Regel);

               IF (NOT TrashedSome) THEN
               BEGIN
                    { snelle sessie, er verandert namelijk niets! }
                    Close (InFile);
                    Close (NewFile);
                    Erase (NewFile); { niet meer nodig }
                    WriteXYC (Xb+16,Yb+3,cBoxData,'Done (nothing changed)');
                    LogMessage (liTrivial,'Shrinking the statistics file (nothing to do)');
                    GOTO DoneNow;
               END;

               WriteXYC (Xb+16,Yb+3,cBoxData,'Copying...  ');
          END;

          { Why was this working before??? }
          TrashedSome := TRUE;
     END; { while }
     
     Close (InFile);
     Close (NewFile);
     
     {$I-} Erase (InFile); {$I+} IORes:=IOResult;
     IF Auto AND (IORes <> 0) THEN
        Error ('Cannot erase old statistics file (error '+Byte2String (IORes)+')');

     {$I-} Rename (NewFile,StaPath); {$I+} IORes:=IOResult;
     IF Auto AND (IORes <> 0) THEN
        Error ('Cannot rename temporary file (error '+Byte2String (IORes)+')');

     WriteXYC (Xb+16,Yb+3,cBoxData,'Done        ');
     LogMessage (liTrivial,'Shrunk the statistics file to '+Byte2String (ShrinkDays)+' history days');

     LogClose;

DoneNow:
     IF (NOT Auto) THEN
     BEGIN
          WriteKeysLine (' Press ^any key to continue...');
          ReadKey;
     END;

QuitNow:
     PopKeysLine;
     WindowPop;
END;
{$ENDIF}


{--------------------------------------------------------------------------}
{ Log_StoreFilePos                                                         }
{                                                                          }
{ Deze routine slaat de fysieke grootte van de logfile op, zodat bij het   }
{ maken van het rapport straks het stuk logfile vanaf deze positie tot het }
{ einde genomen kan worden.                                                }
{                                                                          }
PROCEDURE Log_StoreFilePos;

VAR AFile : FILE;
    IORes : BYTE;

BEGIN
     LogClose;

     StoredPos:=0;

     Assign (AFile,Config.LogFilePath);
     {$I-} Reset (AFile,1); {$I+} IORes:=IOResult;
     IF (IORes = 0) THEN
     BEGIN
          StoredPos:=FileSize (AFile);
          Close (AFile);
     END;
END;

{--------------------------------------------------------------------------}
{ Log_SendReport                                                           }
{                                                                          }
{ This routine sends the last part of the logfile (stored in the LOG.ADM   }
{ file) to the administrator address.                                      }
{                                                                          }
PROCEDURE Log_SendReport;
VAR AdmLog    : Text;
    LogFile   : Text;

    FtnAddress: FidoAddrType;

    splitDir   : DirStr;
    splitName  : NameStr;
    splitExt   : ExtStr;

    Filename   : STRING;

    Line       : STRING;

    IORes      : BYTE;

BEGIN
     MsgsEmpty;

     IF (Config.AdminAddrType = 0) OR (NOT Config.AdminSendLog) THEN
          Exit;

     { Make sure .ADM file is closed }
     LogMessage (liGeneral, 'Sending log file to administrator');
     SendingReport := TRUE;

     { Start a message to the administrator }
     IF (Config.AdminAddrType = 1) THEN      { Netmail }
     BEGIN
          FidoMatch (Config.AdminFidoAddr, FtnAddress);
          FTN_CreateNetmail (FtnAddress, 'WaterGate', 'WaterGate Admin Log Report');
          Address_AddFTN (Config.AdminFidoName, Config.AdminFidoAddr, FALSE, FALSE);
     END ELSE
     BEGIN
          RFC_StartSingleRecipientMessage (Config.AdminUUCPAddr, 'WtrGate', 'WaterGate', 'Log Report');
     END;

     { Reopen main log file (to copy .ADM lines to) }
     Assign (LogFile, Config.LogFilePath);
     {$I-} Append (LogFile); IORes := IOResult; {$I+}
     IF (IORes <> 0) THEN
     BEGIN
          {$I-} Rewrite (LogFile); IORes := IOResult; {$I+}
          IF (IORes <> 0) THEN
          BEGIN
               MsgsAddLineTo (Body, '** Disk error '+Integer2String (IORes)+' opening '+Config.LogFilePath);

               DeliverNow;
               MsgsEmpty;
               Exit;          { ## EXIT ## }
          END;
     END;

     LogExtraMessage ('... Log entries after this point will follow on next run');
     LogClose;

     FSplit (Config.LogFilePath, splitDir, splitName, splitExt);
     Filename := splitDir + splitName + '.ADM';
     Assign (AdmLog, Filename);
     {$I-} Reset (AdmLog); IORes := IOResult; {$I+}
     IF (IORes <> 0) THEN
     BEGIN
          MsgsAddLineTo (Body, '** Disk error '+Integer2String (IORes)+' opening '+Filename);

          {## should be logged?}
          Close (LogFile);

          DeliverNow;
          MsgsEmpty;
          Exit;          { ## EXIT ## }
     END;

     WHILE (NOT Eof (AdmLog)) DO
     BEGIN
          Readln (AdmLog, Line);
          MsgsAddLineTo (Body, Line);
          Writeln (LogFile, Line);
     END;

     Close (LogFile);
     Close (AdmLog);
     Erase (AdmLog);
    
     DeliverNow;
     MsgsEmpty;

     SendingReport := FALSE;
END;

{--------------------------------------------------------------------------}
{ LogGetMem                                                                }
{                                                                          }
{ Deze routine wordt gebruikt om alle memory allocaties te loggen.         }
{                                                                          }
PROCEDURE LogGetMem (At : POINTER; Len : WORD; Descr : STRING);

    FUNCTION Ptr2Long (X : POINTER) : LONGINT;
    BEGIN
         {$IFDEF PLATFORM_WIN32}
         Ptr2Long := LONGINT (Longint (X) SHR 16)*16+(Longint (X) AND $0000FFFF);
         {$ELSE}
         Ptr2Long:=(Longint (X) SHR 16)*16+Word (X);
         {$ENDIF}
    END;

BEGIN
     {$IFNDEF DPMI}
     {$IFNDEF OS2}
     {$IFNDEF WIN32}
     LogExtraMessage ('+$'+Long2HexString (Ptr2Long (At)-Ptr2Long (HeapOrg))+' '+Long2HexString (Len)+' '+Descr);
     {$ENDIF}
     {$ENDIF}
     {$ENDIF}
END;


{--------------------------------------------------------------------------}
{ Log_HexDump                                                              }
{                                                                          }
{ This routine takes a buffer and dumps it as combined hex+ascii to the    }
{ log file, showing the offset in the first column.                        }
{                                                                          }
PROCEDURE Log_HexDump (VAR Buffer; Count : WORD);

CONST PER_LINE = 16;

TYPE BA = ARRAY[0..65530] OF BYTE;

VAR Index   : WORD;
    Len     : WORD;
    AdStr   : STRING[4];
    HexStr  : STRING[16*3];
    AscStr  : STRING[16];
    B       : BYTE;
    X       : STRING[1];

BEGIN
     LogMessage (liDebug,'HexDump '+Word2String (Count)+' bytes');

     LogOpen;

     IF (NOT LogIsOpen) THEN
        Exit; { cannot dump to logfile }

     Index:=0;
     X:='';

     WHILE (Count > 0) DO
     BEGIN
          IF (Count > PER_LINE) THEN
             Len:=PER_LINE
          ELSE
              Len:=Count;

          Dec (Count,Len);

          AdStr:=Word2HexString (Index);

          HexStr:='';
          AscStr:='';

          REPEAT
                B:=BA(Buffer)[Index];
                Inc (Index);

                HexStr:=HexStr+Byte2HexString (B)+' ';

                IF (B < 32) OR (B > 127) THEN
                   B:=Ord ('.');

                AscStr:=AscStr+Char (B);
                Dec (Len);

          UNTIL (Len = 0);

          WriteLn (LogFile,AdStr+': '+AddUpWithSpaces (PER_LINE*3+1,HexStr)+AscStr);
     END;
END;


{--------------------------------------------------------------------------}
{ Log_SetWindowSize                                                        }
{                                                                          }
{ This routine is used to resize the Log window. The window border is      }
{ redrawn and the title printed on the border. If the window was made      }
{ larger, the new lines are filled with empty lines, above the current     }
{ log. If the window was made smaller, some lines of the log will          }
{ disappear and the now unused part will be painted with "desktop".        }
{                                                                          }
PROCEDURE Log_SetWindowSize (Lines : BYTE);
BEGIN
     IF (NOT (StayQuiet OR NoFullScreen)) THEN
     BEGIN
          BoxDrawNSOuter (Single,1,Video.Rows-Lines-2,Video.Cols,Lines+2);
          WriteXY (2,Video.Rows-Lines-2,' Log ');

          IF (Lines < LogScreenLines) THEN
          BEGIN
               { reduced size - paint desktop }
               PaintDesktop (1,Video.Rows-LogScreenLines-2,Video.Cols,LogScreenLines-Lines);
               LogScreenLines:=Lines;
          END ELSE
              WHILE (Lines > LogScreenLines) DO
              BEGIN
                   { increased size - paint empty lines }
                   Inc (LogScreenLines);
                   WriteXY (2,Video.Rows-LogScreenLines-1,Spaces (Video.Cols-2));
              END;
     END;
END;


{--------------------------------------------------------------------------}
{ Log_GetWindowSize                                                        }
{                                                                          }
{ This routine returns the number of lines the log window is larger.       }
{                                                                          }
FUNCTION Log_GetWindowSize : BYTE;
BEGIN
     Log_GetWindowSize:=LogScreenLines;
END;


{--------------------------------------------------------------------------}
{ unit initialization                                                      }
{                                                                          }
BEGIN
     ScreenToo:=FALSE;
     LogIsOpen:=FALSE;
     LogFirst:=TRUE;
     LogScreenLines:=0; { window inhoud }
{$IFDEF WtrUtil}
     ShrinkDays:=7; { hele week behouden }
{$ENDIF}
{$IFDEF Pre}
{$IFNDEF FPC}
     MemStrLen:=Length (Longint2String (_MemAvail))+1;
{$ELSE}
     MemStrLen:=Length (Longint2String (MemAvail))+1;
{$ENDIF}

{$ENDIF}
     SendingReport := FALSE;
END.
