mysticbbs/mystic/mutil_msgpurge.pas

112 lines
2.4 KiB
ObjectPascal
Raw Normal View History

2012-09-08 01:27:43 -07:00
Unit MUTIL_MsgPurge;
{$I M_OPS.PAS}
Interface
Procedure uPurgeMessageBases;
Implementation
Uses
m_Strings,
2012-09-25 16:20:59 -07:00
m_DateTime,
2012-09-08 01:27:43 -07:00
mUtil_Common,
2012-09-25 16:20:59 -07:00
mUtil_Status,
bbs_MsgBase_ABS,
bbs_MsgBase_JAM,
bbs_MsgBase_Squish;
2012-09-08 01:27:43 -07:00
Procedure uPurgeMessageBases;
2012-09-25 16:20:59 -07:00
Var
PurgeTotal : LongInt = 0;
PurgeBase : LongInt;
BaseFile : File of RecMessageBase;
Base : RecMessageBase;
MsgBase : PMsgBaseABS;
2012-09-08 01:27:43 -07:00
Begin
ProcessName ('Purging Message Bases', True);
ProcessResult (rWORKING, False);
2012-09-25 16:20:59 -07:00
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;
Case Base.BaseType of
0 : MsgBase := New(PMsgBaseJAM, Init);
1 : MsgBase := New(PMsgBaseSquish, Init);
End;
MsgBase^.SetMsgPath (Base.Path + Base.FileName);
MsgBase^.SetTempFile (TempPath + 'msgbuf.tmp');
If Not MsgBase^.OpenMsgBase Then Begin
Dispose (MsgBase, Done);
Continue;
End;
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);
2012-09-08 01:27:43 -07:00
ProcessResult (rDONE, True);
End;
End.