MPL GetMBaseStats function

mystic/HISTORY.txt

@@ -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.

mystic/bbs_msgbase.pas

@@ -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
+    GetMessageStats(MBase, TotalMsgs, NewMsgs, YourMsgs);
-      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;
 
     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

mystic/mpl_common.pas

@@ -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 }
 

mystic/mpl_execute.pas

@@ -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 Result Then
-  If Not ioReset(F, SizeOf(RecMessageBase), fmRWDN) Then Exit;
+    Session.Msgs.GetMessageStats(M, Total, New, Yours);
-
-  If ioSeek(F, Num) And (ioRead(F, M)) Then Begin
-    GetMBaseVars(M);
-    Result := True;
 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;