eric
/
mysticbbs
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Added mUtil Message Base packer for JAM/Squish

This commit is contained in:
mysticbbs 2012-11-18 08:51:55 -05:00
parent fec621d090
commit ae134dbb39
8 changed files with 333 additions and 37 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
mystic/HISTORY.txt
View File

@ -4915,3 +4915,9 @@
+ The Toggle New Scan and Toggle QWK Scan menu commands now allow an optional
/ALLGROUP in the optional data. If this is supplied it will show all bases
in all groups. By default it only shows current group only.
- Removed MYSTPACK from Mystic BBS distribution. Do not use this anymore.
+ Added a message base packer and renumber option to mUtil. This replaces
MYSTPACK with the bonus that it also works with Squish (and appears to not
be as buggy as MYSTPACK was).

25
mystic/bbs_msgbase_abs.pas
View File

@ -1,8 +1,9 @@
{$I M_OPS.PAS}
{$WARNINGS OFF}
Unit BBS_MsgBase_ABS;
{$I M_OPS.PAS}
{$WARNINGS OFF}
Interface
Uses
@ -28,8 +29,8 @@ Type
Function MsgBaseExists: Boolean; Virtual; {Does msg base exist}
Function LockMsgBase: Boolean; Virtual; {Lock the message base}
Function UnLockMsgBase: Boolean; Virtual; {Unlock the message base}
Procedure SetDest(Var Addr: RecEchoMailAddr); Virtual; {Set Zone/Net/Node/Point for Dest}
Procedure SetOrig(Var Addr: RecEchoMailAddr); Virtual; {Set Zone/Net/Node/Point for Orig}
Procedure SetDest (Addr: RecEchoMailAddr); Virtual; {Set Zone/Net/Node/Point for Dest}
Procedure SetOrig (Addr: RecEchoMailAddr); Virtual; {Set Zone/Net/Node/Point for Orig}
Procedure SetFrom(Name: String); Virtual; {Set message from}
Procedure SetTo(Name: String); Virtual; {Set message to}
Procedure SetSubj(Str: String); Virtual; {Set message subject}
@ -72,7 +73,9 @@ Type
Function GetMsgNum: LongInt; Virtual; {Get message number}
Function GetTextLen: LongInt; Virtual; {Get text length}
Procedure GetOrig (Var Addr : RecEchoMailAddr); Virtual; {Get origin address}
Function GetOrigAddr : RecEchoMailAddr; Virtual;
Procedure GetDest (Var Addr : RecEchoMailAddr); Virtual; {Get destination address}
Function GetDestAddr : RecEchoMailAddr; Virtual;
Function IsLocal: Boolean; Virtual; {Is current msg local}
Function IsCrash: Boolean; Virtual; {Is current msg crash}
Function IsKillSent: Boolean; Virtual; {Is current msg kill sent}
@ -149,11 +152,11 @@ Function TMsgBaseABS.UnLockMsgBase: Boolean;
Begin
End;
Procedure TMsgBaseABS.SetDest(Var Addr: RecEchoMailAddr);
Procedure TMsgBaseABS.SetDest (Addr: RecEchoMailAddr);
Begin
End;
Procedure TMsgBaseABS.SetOrig(Var Addr: RecEchoMailAddr);
Procedure TMsgBaseABS.SetOrig (Addr: RecEchoMailAddr);
Begin
End;
@ -413,10 +416,18 @@ Procedure TMsgBaseABS.GetOrig(Var Addr: RecEchoMailAddr);
Begin
End;
Function TMsgBaseABS.GetOrigAddr : RecEchoMailAddr;
Begin
End;
Procedure TMsgBaseABS.GetDest(Var Addr: RecEchoMailAddr);
Begin
End;
Function TMsgBaseABS.GetDestAddr : RecEchoMailAddr;
Begin
End;
Function TMsgBaseABS.IsLocal: Boolean;
Begin
End;

25
mystic/bbs_msgbase_jam.pas
View File

@ -152,8 +152,8 @@ Type
Function GetHighMsgNum : LongInt; Virtual; {Get highest netmail msg number in area}
Function LockMsgBase : Boolean; Virtual; {Lock the message base}
Function UnLockMsgBase : Boolean; Virtual; {Unlock the message base}
Procedure SetDest (Var Addr: RecEchoMailAddr); Virtual; {Set Zone/Net/Node/Point for Dest}
Procedure SetOrig (Var Addr: RecEchoMailAddr); Virtual; {Set Zone/Net/Node/Point for Orig}
Procedure SetDest (Addr: RecEchoMailAddr); Virtual; {Set Zone/Net/Node/Point for Dest}
Procedure SetOrig (Addr: RecEchoMailAddr); Virtual; {Set Zone/Net/Node/Point for Orig}
Procedure SetFrom (Name: String); Virtual; {Set message from}
Procedure SetTo (Name: String); Virtual; {Set message to}
Procedure SetSubj (Str: String); Virtual; {Set message subject}
@ -198,6 +198,10 @@ Type
Function GetSeeAlso : LongInt; Virtual; {Get see also of current msg}
Function GetMsgNum : LongInt; Virtual; {Get message number}
Procedure GetOrig (Var Addr: RecEchoMailAddr); Virtual; {Get origin address}
Function GetOrigAddr : RecEchoMailAddr; Virtual;
Function GetDestAddr : RecEchoMailAddr; Virtual;
Procedure GetDest (Var Addr: RecEchoMailAddr); Virtual; {Get destination address}
Function GetTextLen : LongInt; Virtual; {returns length of text in msg}
Function IsLocal : Boolean; Virtual; {Is current msg local}
@ -317,12 +321,12 @@ Begin
GetHighMsgNum := JM^.BaseHdr.BaseMsgNum + FileSize(JM^.IdxFile) - 1;
End;
Procedure TMsgBaseJAM.SetDest(Var Addr: RecEchoMailAddr);
Procedure TMsgBaseJAM.SetDest (Addr: RecEchoMailAddr);
Begin
JM^.Dest := Addr;
End;
Procedure TMsgBaseJAM.SetOrig(Var Addr: RecEchoMailAddr);
Procedure TMsgBaseJAM.SetOrig(Addr: RecEchoMailAddr);
Begin
JM^.Orig := Addr;
End;
@ -552,6 +556,7 @@ Begin
JM^.TxtPos := 0;
MsgHdr^.JamHdr.SubFieldLen := 0;
FillChar(MsgHdr^.SubBuf, SizeOf(MsgHdr^.SubBuf), #0);
End;
@ -1200,6 +1205,16 @@ Begin
GetMsgNum := MsgHdr^.JamHdr.MsgNum;
End;
Function TMsgBaseJAM.GetOrigAddr : RecEchoMailAddr;
Begin
Result := JM^.Orig;
End;
Function TMsgBaseJAM.GetDestAddr : RecEchoMailAddr;
Begin
Result := JM^.Dest;
End;
Procedure TMsgBaseJAM.GetOrig(Var Addr: RecEchoMailAddr); {Get origin address}
Begin
Addr := JM^.Orig;
@ -1415,7 +1430,7 @@ Begin
FillChar(MsgHdr^, SizeOf(MsgHdr^), #0);
// MsgHdr^.JamHdr.SubFieldLen := 0;
MsgHdr^.JamHdr.SubFieldLen := 0;
MsgHdr^.JamHdr.MsgIdCrc := -1;
MsgHdr^.JamHdr.ReplyCrc := -1;
MsgHdr^.JamHdr.PwdCrc := -1;

32
mystic/bbs_msgbase_squish.pas
View File

@ -197,9 +197,13 @@ Type
Function GetChar: Char; Virtual;
Function GetString(MaxLen: Word): String; Virtual;
Procedure GetOrig(Var Addr: RecEchoMailAddr); Virtual;
Procedure SetOrig(Var Addr: RecEchoMailAddr); Virtual;
Procedure SetOrig(Addr: RecEchoMailAddr); Virtual;
Procedure GetDest(Var Addr: RecEchoMailAddr); Virtual;
Procedure SetDest(Var Addr: RecEchoMailAddr); Virtual;
Procedure SetDest (Addr: RecEchoMailAddr); Virtual;
Function GetOrigAddr : RecEchoMailAddr; Virtual;
Function GetDestAddr : RecEchoMailAddr; Virtual;
Function EOM: Boolean; Virtual;
(*
Function WasWrap: Boolean; Virtual;
@ -252,7 +256,7 @@ Type
Procedure LoadFree; Virtual; {Load freelist into memory}
Function NumberOfMsgs: LongInt; Virtual; {Number of messages}
Procedure SetEcho(ES: Boolean); Virtual; {Set echo status}
// Function IsEchoed: Boolean; Virtual; {Is current msg unmoved echomail msg}
Function IsEchoed: Boolean; Virtual; {Is current msg unmoved echomail msg}
Function GetLastRead(UNum: LongInt): LongInt; Virtual; {Get last read for user num}
Procedure SetLastRead(UNum: LongInt; LR: LongInt); Virtual; {Set last read}
Function GetMsgLoc: LongInt; Virtual; {To allow reseeking to message}
@ -570,7 +574,12 @@ Begin
Addr := SqInfo^.MsgHdr.Orig;
End;
Procedure TMsgBaseSquish.SetOrig(Var Addr: RecEchoMailAddr);
Function TMsgBaseSquish.GetOrigAddr : RecEchoMailAddr;
Begin
Result := SqInfo^.MsgHdr.Orig;
End;
Procedure TMsgBaseSquish.SetOrig(Addr: RecEchoMailAddr);
Begin
SqInfo^.MsgHdr.Orig := Addr;
End;
@ -580,7 +589,12 @@ Begin
Addr := SqInfo^.MsgHdr.Dest;
End;
Procedure TMsgBaseSquish.SetDest(Var Addr: RecEchoMailAddr);
Function TMsgBaseSquish.GetDestAddr : RecEchoMailAddr;
Begin
Result := SqInfo^.MsgHdr.Dest;
End;
Procedure TMsgBaseSquish.SetDest (Addr: RecEchoMailAddr);
Begin
SqInfo^.MsgHdr.Dest := Addr;
End;
@ -1310,10 +1324,10 @@ Begin
IsPriv := ((SqInfo^.MsgHdr.Attr and SqMsgPriv) <> 0);
End;
//Function TMsgBaseSquish.IsEchoed: Boolean;
//Begin
// IsEchoed := ((SqInfo^.MsgHdr.Attr and SqMsgScanned) = 0);
//End;
Function TMsgBaseSquish.IsEchoed: Boolean;
Begin
IsEchoed := ((SqInfo^.MsgHdr.Attr and SqMsgScanned) = 0);
End;
Function TMsgBaseSquish.IsDeleted: Boolean; {Is current msg deleted}
Begin

24
mystic/mutil.ini
View File

@ -24,6 +24,7 @@
; - Import FILES.BBS into file bases
; - Generate all files listing
; - Purge Message bases (by age and max messages)
; - Pack and renumber message bases
; - Post text files to message bases
;
; ==========================================================================
@ -53,18 +54,15 @@
; list of functions to perform on startup
Import_FIDONET.NA = false
Import_FILEBONE.NA = false
Import_FILES.BBS = false
MassUpload = false
GenerateTopLists = false
GenerateAllFiles = false
PurgeMessageBases = false
PostTextFiles = false
; work in progress
LinkMessageBases = false
PackMessageBases = false
Import_FIDONET.NA = true
Import_FILEBONE.NA = true
Import_FILES.BBS = true
MassUpload = true
GenerateTopLists = true
GenerateAllFiles = true
PurgeMessageBases = true
PostTextFiles = true
PackMessageBases = true
; ==========================================================================
; ==========================================================================
@ -295,7 +293,7 @@
[PackMessageBases]
; Not implmented yet
; No options for this function
[PostTextFiles]

8
mystic/mutil_common.pas
View File

@ -40,6 +40,7 @@ Const
Procedure Log (Level: Byte; Code: Char; Str: String);
Function strAddr2Str (Addr : RecEchoMailAddr) : String;
Function GetUserBaseSize : Cardinal;
Function GenerateMBaseIndex : LongInt;
Function GenerateFBaseIndex : LongInt;
Function IsDupeMBase (FN: String) : Boolean;
@ -100,6 +101,13 @@ Begin
Result := Temp;
End;
Function GetUserBaseSize : Cardinal;
Begin
Result := FileByteSize(bbsConfig.DataPath + 'users.dat');
If Result > 0 Then Result := Result DIV SizeOf(RecUser);
End;
Function IsDupeMBase (FN: String) : Boolean;
Var
MBaseFile : File of RecMessageBase;

248
mystic/mutil_msgpack.pas
View File

@ -10,15 +10,259 @@ Implementation
Uses
m_Strings,
m_FileIO,
mUtil_Common,
mUtil_Status;
mUtil_Status,
bbs_MsgBase_ABS,
bbs_MsgBase_JAM,
bbs_MsgBase_Squish;
{$I RECORDS.PAS}
Procedure uPackMessageBases;
Type
RecMsgLink = Record
OldNum : Cardinal;
NewNum : Cardinal;
End;
Var
LinkFile : TBufFile;
BaseKills : Cardinal = 0;
BaseTotal : Cardinal = 0;
TotalKills : Cardinal = 0;
Function GetMessageLink (OldNum: Cardinal; Zero: Boolean) : Cardinal;
Var
L : RecMsgLink;
Begin
LinkFile.Reset;
While Not LinkFile.EOF Do Begin
LinkFile.Read(L);
If L.OldNum = OldNum Then Begin
Result := L.NewNum;
Exit;
End;
End;
If Zero Then
Result := 0
Else
Result := OldNum;
End;
Procedure PackOneBase (Var MsgBase: RecMessageBase);
Const
TempName = 'msgpacktemp';
Var
MsgData : PMsgBaseABS;
NewData : PMsgBaseABS;
SaveMsg : Boolean = False;
UserTotal : Cardinal;
Link : RecMsgLink;
Count : Cardinal;
Addr : RecEchoMailAddr;
Begin
FileMode := 66;
BaseKills := 0;
Inc (BaseTotal);
Case MsgBase.BaseType of
0 : Begin
MsgData := New(PMsgBaseJAM, Init);
NewData := New(PMsgBaseJAM, Init);
End;
1 : Begin
MsgData := New(PMsgBaseSquish, Init);
NewData := New(PMsgBaseSquish, Init);
End;
End;
MsgData^.SetMsgPath (MsgBase.Path + MsgBase.FileName);
MsgData^.SetTempFile (TempPath + 'msgbuf.old');
NewData^.SetMsgPath (TempPath + TempName);
NewData^.SetTempFile (TempPath + 'msgbuf.new');
If Not MsgData^.OpenMsgBase Then Begin
Dispose (MsgData, Done);
Dispose (NewData, Done);
Exit;
End;
If Not NewData^.CreateMsgBase (MsgBase.MaxMsgs, MsgBase.MaxAge) Then Begin
Dispose (MsgData, Done);
Dispose (NewData, Done);
Exit;
End;
If Not NewData^.OpenMsgBase Then Begin
Dispose (MsgData, Done);
Dispose (NewData, Done);
Exit;
End;
LinkFile := TBufFile.Create (8 * 1024);
LinkFile.Open (TempPath + TempName + '.tmp', fmCreate, fmRWDN, SizeOf(RecMsgLink));
MsgData^.SeekFirst(1);
While MsgData^.SeekFound Do Begin
MsgData^.MsgStartUp;
SaveMsg := True;
// option:
// if private/netmail message area check to make sure users are valid
// and delete if they are not.
// also do kludges make it successfully? replyID etc?
If SaveMsg Then Begin
NewData^.StartNewMsg;
NewData^.SetFrom (MsgData^.GetFrom);
NewData^.SetTo (MsgData^.GetTo);
NewData^.SetSubj (MsgData^.GetSubj);
NewData^.SetDate (MsgData^.GetDate);
NewData^.SetTime (MsgData^.GetTime);
NewData^.SetLocal (MsgData^.IsLocal);
NewData^.SetPriv (MsgData^.IsPriv);
NewData^.SetSent (MsgData^.IsSent);
NewData^.SetCrash (MsgData^.IsCrash);
NewData^.SetRcvd (MsgData^.IsRcvd);
// NewData^.SetHold (MsgData^.IsHold);
NewData^.SetEcho (Not MsgData^.IsEchoed);
NewData^.SetKillSent (MsgData^.IsKillSent);
NewData^.SetRefer (MsgData^.GetRefer);
NewData^.SetSeeAlso (MsgData^.GetSeeAlso);
Case MsgBase.NetType of
0 : NewData^.SetMailType(mmtNormal);
1..2 : NewData^.SetMailType(mmtEchoMail);
3 : NewData^.SetMailType(mmtNetMail);
End;
NewData^.SetOrig(MsgData^.GetOrigAddr);
NewData^.SetDest(MsgData^.GetDestAddr);
MsgData^.MsgTxtStartUp;
While Not MsgData^.EOM Do
NewData^.DoStringLn(MsgData^.GetString(79));
NewData^.WriteMsg;
Link.OldNum := MsgData^.GetMsgNum;
Link.NewNum := NewData^.GetHighMsgNum;
LinkFile.Write (Link);
End;
MsgData^.SeekNext;
End;
// cycle through old lastread pointers and generate new ones
UserTotal := GetUserBaseSize;
For Count := 1 to UserTotal Do Begin
Link.OldNum := MsgData^.GetLastRead (Count);
NewData^.SetLastRead (Count, GetMessageLink(Link.OldNum, False));
End;
// cycle through all messages and update referto/seealso
NewData^.SeekFirst(1);
While NewData^.SeekFound Do Begin
NewData^.MsgStartUp;
Link.OldNum := NewData^.GetRefer;
Link.NewNum := NewData^.GetSeeAlso;
If (Link.OldNum <> 0) Then Link.OldNum := GetMessageLink(Link.OldNum, True);
If (Link.NewNum <> 0) Then Link.NewNum := GetMessageLink(Link.NewNum, True);
If (Link.OldNum <> NewData^.GetRefer) or (Link.NewNum <> NewData^.GetSeeAlso) Then Begin
NewData^.SetRefer (Link.OldNum);
NewData^.SetSeeAlso (Link.NewNum);
NewData^.ReWriteHdr;
End;
NewData^.SeekNext;
End;
BaseKills := MsgData^.GetHighMsgNum - NewData^.GetHighMsgNum;
Inc (TotalKills, BaseKills);
MsgData^.CloseMsgBase;
NewData^.CloseMsgBase;
Dispose (MsgData, Done);
Dispose (NewData, Done);
LinkFile.Free;
FileErase (TempPath + TempName + '.tmp');
Case MsgBase.BaseType of
0 : Begin
FileErase (MsgBase.Path + MsgBase.FileName + '.jhr');
FileErase (MsgBase.Path + MsgBase.FileName + '.jdt');
FileErase (MsgBase.Path + MsgBase.FileName + '.jdx');
FileErase (MsgBase.Path + MsgBase.FileName + '.jlr');
FileRename (TempPath + TempName + '.jhr', MsgBase.Path + MsgBase.FileName + '.jhr');
FileRename (TempPath + TempName + '.jdt', MsgBase.Path + MsgBase.FileName + '.jdt');
FileRename (TempPath + TempName + '.jdx', MsgBase.Path + MsgBase.FileName + '.jdx');
FileRename (TempPath + TempName + '.jlr', MsgBase.Path + MsgBase.FileName + '.jlr');
End;
1 : Begin
FileErase (MsgBase.Path + MsgBase.FileName + '.sqd');
FileErase (MsgBase.Path + MsgBase.FileName + '.sqi');
FileErase (MsgBase.Path + MsgBase.FileName + '.sql');
FileRename (TempPath + TempName + '.sqd', MsgBase.Path + MsgBase.FileName + '.sqd');
FileRename (TempPath + TempName + '.sqi', MsgBase.Path + MsgBase.FileName + '.sqi');
FileRename (TempPath + TempName + '.sql', MsgBase.Path + MsgBase.FileName + '.sql');
End;
End;
Log (2, '+', ' Removed ' + strI2S(BaseKills) + ' msgs');
End;
Var
BaseFile : File of RecMessageBase;
Base : RecMessageBase;
Begin
ProcessName ('Packing Message Bases', True);
ProcessResult (rWORKING, False);
ProcessStatus ('Removed X Msgs in X Bases', True);
Assign (BaseFile, bbsConfig.DataPath + 'mbases.dat');
If ioReset (BaseFile, SizeOf(Base), fmRWDN) Then Begin
While Not Eof(BaseFile) Do Begin
Read (BaseFile, Base);
ProcessStatus (Base.Name, False);
BarOne.Update (FilePos(BaseFile), FileSize(BaseFile));
PackOneBase (Base);
End;
Close (BaseFile);
End;
ProcessStatus ('Removed |15' + strI2S(TotalKills) + ' |07msgs in |15' + strI2S(BaseTotal) + ' |07bases', True);
ProcessResult (rDONE, True);
End;

2
mystic/mutil_msgpurge.pas
View File

@ -97,4 +97,4 @@ Begin
ProcessResult (rDONE, True);
End;
End.
End.