mysticbbs/mystic/mutil_msgpurge.pas

Unit MUTIL_MsgPurge;

{$I M_OPS.PAS}

Interface

Procedure uPurgeMessageBases;

Implementation

Uses
  m_Strings,
  m_DateTime,
  mUtil_Common,
  mUtil_Status,
  bbs_DataBase,
  bbs_MsgBase_ABS,
  bbs_MsgBase_JAM,
  bbs_MsgBase_Squish;

Procedure uPurgeMessageBases;
Var
  PurgeTotal : LongInt = 0;
  PurgeBase  : LongInt;
  BaseFile   : File of RecMessageBase;
  Base       : RecMessageBase;
  MsgBase    : PMsgBaseABS;
Begin
  ProcessName   ('Purging Message Bases', True);
  ProcessResult (rWORKING, False);

  Assign (BaseFile, bbsConfig.DataPath + 'mbases.dat');
  {$I-} Reset (BaseFile); {$I+}

  If IoResult = 0 Then Begin
    While Not Eof(BaseFile) Do Begin
      Read (BaseFile, Base);

      ProcessStatus (Base.Name, False);
      BarOne.Update (FilePos(BaseFile), FileSize(BaseFile));

      PurgeBase := 0;

      If Not MessageBaseOpen(MsgBase, Base) Then Continue;

      If Base.MaxAge > 0 Then Begin
        MsgBase^.SeekFirst(1);

        While MsgBase^.SeekFound Do Begin
          MsgBase^.MsgStartUp;

          If MsgBase^.IsDeleted Then Begin
            MsgBase^.SeekNext;

            Continue;
          End;

          If DaysAgo(DateStr2Julian(MsgBase^.GetDate), 1) > Base.MaxAge Then Begin
            MsgBase^.DeleteMsg;

            Inc (PurgeTotal);
            Inc (PurgeBase);
          End;

          MsgBase^.SeekNext;
        End;
      End;

      If Base.MaxMsgs > 0 Then Begin
        MsgBase^.SeekFirst(1);

        While MsgBase^.SeekFound And (MsgBase^.NumberOfMsgs > Base.MaxMsgs) Do Begin
          MsgBase^.MsgStartUp;

          If Not MsgBase^.IsDeleted Then Begin
            MsgBase^.DeleteMsg;

            Inc (PurgeTotal);
            Inc (PurgeBase);
          End;

          MsgBase^.SeekNext;
        End;
      End;

      MsgBase^.CloseMsgBase;

      Dispose (MsgBase, Done);

      Log (2, '+', '      Purged ' + strI2S(PurgeBase));
    End;

    Close (BaseFile);
  End;

  ProcessStatus ('Purged |15' + strI2S(PurgeTotal) + ' |07messages', True);
  ProcessResult (rDONE, True);
End;

End.