MPL GetMBaseStats function

This commit is contained in:
mysticbbs 2012-07-25 00:55:32 -04:00
parent 32fec6a3a8
commit 7d3868b3f3
4 changed files with 102 additions and 42 deletions

View File

@ -4458,3 +4458,33 @@
! Setting inactivity to 0 (to globally disable it) wasn't working. I don't
know if this was a fault in 1.10 alphas or also in 1.09, so I am
mentioning it just in case.
+ New MPL function: GetMBaseStats. This can be used as a function or a
procedure (returning true if successful). It takes 4 parameters.
#1: Message base number
#2: Total messages (this is a VAR parameter)
#3: New messages (this is a VAR parameter)
#4: New messages to you (this is a VAR parameter)
Example:
uses mbase;
var
count, total, new, yours : longint;
begin
count := 1; //start @1 to skip email base
while getmbase(count) do begin
getmbasestats(count, total, new, yours);
writeln('base : ' + mbasename);
writeln('total msgs : ' + int2str(total));
writeln('new msgs : ' + int2str(new));
writeln('your msgs : ' + int2str(yours));
writeln('');
count := count + 1
end;
end.

View File

@ -34,6 +34,8 @@ Type
Function OpenCreateBase (Var Msg: PMsgBaseABS; Var Area: RecMessageBase) : Boolean;
Procedure AppendMessageText (Var Msg: PMsgBaseABS; Lines: Integer; ReplyID: String);
Procedure AssignMessageData (Var Msg: PMsgBaseABS);
Function GetRecord (Num: LongInt; Var TempBase: RecMessageBase) : Boolean;
Procedure GetMessageStats (Var TempBase: RecMessageBase; Var Total, New, Yours: LongInt);
Function GetTotalMessages (Var TempBase: RecMessageBase) : LongInt;
Procedure PostTextFile (Data: String; AllowCodes: Boolean);
Function SaveMessage (mArea: RecMessageBase; mFrom, mTo, mSubj: String; mAddr: RecEchoMailAddr; mLines: Integer) : Boolean;
@ -136,6 +138,22 @@ Begin
Result := True;
End;
Function TMsgBase.GetRecord (Num: LongInt; Var TempBase: RecMessageBase) : Boolean;
Var
F : File;
Begin
Result := False;
Assign (F, Config.DataPath + 'mbases.dat');
If Not ioReset(F, SizeOf(RecMessageBase), fmRWDN) Then Exit;
If ioSeek(F, Num) And (ioRead(F, TempBase)) Then
Result := True;
Close (F);
End;
Function TMsgBase.GetTotalMessages (Var TempBase: RecMessageBase) : LongInt;
Var
TempMsg : PMsgBaseABS;
@ -153,6 +171,41 @@ Begin
End;
End;
Procedure TMsgBase.GetMessageStats (Var TempBase: RecMessageBase; Var Total, New, Yours: LongInt);
Var
TempMsg : PMsgBaseABS;
MsgTo : String[40];
Begin
Total := 0;
New := 0;
Yours := 0;
If TempBase.Name = 'None' Then Exit;
If OpenCreateBase(TempMsg, TempBase) Then Begin
Total := TempMsg^.NumberOfMsgs;
TempMsg^.SeekFirst(TempMsg^.GetLastRead(Session.User.UserNum) + 1);
While TempMsg^.SeekFound Do Begin
Inc (New);
TempMsg^.MsgStartUp;
MsgTo := strUpper(TempMsg^.GetTo);
If (MsgTo = strUpper(Session.User.ThisUser.Handle)) or (MsgTo = strUpper(Session.User.ThisUser.RealName)) Then
Inc(Yours);
TempMsg^.SeekNext;
End;
TempMsg^.CloseMsgBase;
Dispose (TempMsg, Done);
End;
End;
Procedure TMsgBase.SetMessageScan;
Var
Count : Integer;
@ -3454,11 +3507,9 @@ Const
Procedure ScanBase;
Var
MsgBase : PMsgBaseABS;
NewMsgs : LongInt;
YourMsgs : LongInt;
TotalMsgs : LongInt;
MsgTo : String;
Begin
Session.io.PromptInfo[1] := MBase.Name;
Session.io.PromptInfo[2] := strI2S(Global_CurBase);
@ -3471,33 +3522,7 @@ Const
If ShowScanPrompt Then
Session.io.OutFull(Session.GetPrompt(487));
Case MBase.BaseType of
0 : MsgBase := New(PMsgBaseJAM, Init);
1 : MsgBase := New(PMsgBaseSquish, Init);
End;
MsgBase^.SetMsgPath (MBase.Path + MBase.FileName);
If MsgBase^.OpenMsgBase Then Begin
TotalMsgs := MsgBase^.NumberOfMsgs;
MsgBase^.SeekFirst(MsgBase^.GetLastRead(Session.User.UserNum) + 1);
While MsgBase^.SeekFound Do Begin
Inc (NewMsgs);
MsgBase^.MsgStartUp;
MsgTo := strUpper(MsgBase^.GetTo);
If (MsgTo = strUpper(Session.User.ThisUser.Handle)) or (MsgTo = strUpper(Session.User.ThisUser.RealName)) Then
Inc(YourMsgs);
MsgBase^.SeekNext;
End;
MsgBase^.CloseMsgBase;
End;
GetMessageStats(MBase, TotalMsgs, NewMsgs, YourMsgs);
Inc (Global_TotalMsgs, TotalMsgs);
Inc (Global_NewMsgs, NewMsgs);
@ -3515,8 +3540,6 @@ Const
If (ShowIfNew And (NewMsgs > 0)) or (ShowIfYou And (YourMsgs > 0)) or (Not ShowIfNew And Not ShowIfYou) Then
Session.io.OutFullLn(Session.GetPrompt(488));
Dispose (MsgBase, Done);
End;
Var

View File

@ -289,6 +289,7 @@ Begin
AddProc ({$IFDEF MPLPARSER} 'putthisuser', {$ENDIF} '', iNone); // 538
AddProc ({$IFDEF MPLPARSER} 'putuser', {$ENDIF} 'l', iNone); // 539
AddProc ({$IFDEF MPLPARSER} 'isuser', {$ENDIF} 's', iBool); // 540
AddProc ({$IFDEF MPLPARSER} 'getmbasestats', {$ENDIF} 'lLLL', iBool); // 541
{ END OF PROCEDURE DEFINITIONS }

View File

@ -92,6 +92,8 @@ Type
Procedure GetMBaseVars (Var M: RecMessageBase);
Function GetMBaseRecord (Num: LongInt) : Boolean;
Function GetMBaseStats (Num: LongInt; Var Total, New, Yours: LongInt) : Boolean;
Procedure GetMGroupVars (Var G: RecGroup);
Function GetMGroupRecord (Num: LongInt) : Boolean;
Procedure GetFBaseVars (Var F: RecFileBase);
@ -241,22 +243,22 @@ Begin
Move (M.SysopACS, VarData[IdxVarMBase + 5 ]^.Data^, SizeOf(M.SysopACS));
End;
Function TInterpEngine.GetMBaseRecord (Num: LongInt) : Boolean;
Function TInterpEngine.GetMBaseStats (Num: LongInt; Var Total, New, Yours: LongInt) : Boolean;
Var
F : File;
M : RecMessageBase;
Begin
Result := False;
Result := Session.Msgs.GetRecord(Num, M);
Assign (F, Config.DataPath + 'mbases.dat');
If Not ioReset(F, SizeOf(RecMessageBase), fmRWDN) Then Exit;
If ioSeek(F, Num) And (ioRead(F, M)) Then Begin
GetMBaseVars(M);
Result := True;
If Result Then
Session.Msgs.GetMessageStats(M, Total, New, Yours);
End;
Close (F);
Function TInterpEngine.GetMBaseRecord (Num: LongInt) : Boolean;
Var
M : RecMessageBase;
Begin
Result := Session.Msgs.GetRecord(Num, M);
If Result Then GetMBaseVars(M);
End;
Procedure TInterpEngine.GetMGroupVars (Var G: RecGroup);
@ -1895,6 +1897,10 @@ Begin
TempBool := Session.User.FindUser(Param[1].S, False);
Store (TempBool, 1);
End;
541 : Begin
TempBool := GetMBaseStats(Param[1].L, LongInt(Pointer(Param[2].vData)^), LongInt(Pointer(Param[3].vData)^), LongInt(Pointer(Param[4].vData)^));
Store (TempBool, 1);
End;
End;
End;