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

Alpha 19 sync

This commit is contained in:
mysticbbs 2012-09-20 13:52:58 -04:00
parent 360e43d724
commit 4ba62f0a5e
22 changed files with 963 additions and 645 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

69
mystic/HISTORY.txt
View File

@ -4719,7 +4719,7 @@
! Fixed bugs with MIS calculating the wrong node number if a user was ! Fixed bugs with MIS calculating the wrong node number if a user was
logged in locally in Windows. logged in locally in Windows.
+ Mystic in non-Unix will not assign an available node number automatically + Mystic in non-Unix will now assign an available node number automatically
similar to how it works in a Unix environment. This will help prevent similar to how it works in a Unix environment. This will help prevent
a person from accidentally logging into a node that is being used during a person from accidentally logging into a node that is being used during
a local login. a local login.
@ -4739,3 +4739,70 @@
! MUTIL FILEBONE import was not adding the trailing slash when generating a ! MUTIL FILEBONE import was not adding the trailing slash when generating a
file path. file path.
+ MUTIL now has an option to generate an allfiles list which contains a
listing of all files from each filebase in one text file.
The functionality if there, but its not very configurable yet. If
anyone has suggestions please let me know.
+ Added 3 new MPL functions: MsgEditor, MsgEditSet, MsgEditGet. These allow
access to the internal Mystic msg editor (line and/or full) from within
MPL. It even allows you to define wrap position and template to completely
make it look like its not the Mystic editor!
As a little hint the MsgEditSet and MsgEditGet stuff could be used to post
process message text on posts. Like say for example you wanted to write
a MPL that allows users to add Tag lines, you could do that by replacing
the "Saving message..." prompt and using those two in order to modify the
text before it is saved by Mystic!
Rather than trying to explain it all, here is an example of all 3:
Var
Lines : Integer = 0;
WrapPos : Integer = 79;
MaxLines : Integer = 200;
Forced : Boolean = False;
Template : String = 'ansiedit';
Subject : String = 'My subject';
Count : Integer;
Begin
MsgEditSet (1, 'this is line 1');
MsgEditSet (2, 'this is line 2!');
Lines := 2;
SetPromptInfo(1, 'MsgTo'); // if template uses &1 for "To:" display
If MsgEditor(0, Lines, WrapPos, MaxLines, Forced, Template, Subject) Then Begin
WriteLn('User selected to save.');
WriteLn('There are ' + Int2Str(Lines) + ' of text in buffer:');
For Count := 1 to Lines Do
WriteLn(MsgEditGet(Count));
Pause;
End Else Begin
WriteLn('User aborted the edit.');
Pause;
End
End
! Fixed a bug in the internal LHA archive viewing that could cause the last
file in the archive to get corrupted during the view, if the file had
comments (and was created on an Amiga?)
+ CTRL-Z and [ESCAPE] now both bring up the full screen editor prompt to
save, etc.
+ Revampped message quoting a little bit. Quoted text will now be auto
reformatted if adding the initials would cut off text in the original
message EXCEPT when quoting quoted text.
Quote initials will always be 2 characters now. If the User handle is a
single word handle, it will use the first two letters of their name.
! Fixed a bug that could corrupt a message and/or crash when editing a
message with a lot of lines.

9
mystic/aviewlzh.pas
View File

@ -18,7 +18,7 @@ Type
FileTime : LongInt; FileTime : LongInt;
Attr : Word; Attr : Word;
FileName : String[12]; FileName : String[12];
F32 : PathStr; F32 : String[255];
DT : DateTime; DT : DateTime;
End; End;
@ -61,14 +61,17 @@ Begin
If _FHdr.HeadSize <> 0 Then If _FHdr.HeadSize <> 0 Then
UnPackTime (_FHdr.FileTime, _FHdr.DT); UnPackTime (_FHdr.FileTime, _FHdr.DT);
SR.Name := _FHdr.FileName; If Pos(#0, _FHdr.FileName) > 0 Then
SR.Name := Copy(_FHdr.FileName, 1, Pos(#0, _FHdr.FileName) - 1)
Else
SR.Name := _FHdr.FileName;
SR.Size := _FHdr.OrigSize; SR.Size := _FHdr.OrigSize;
SR.Time := _FHdr.FileTime; SR.Time := _FHdr.FileTime;
End; End;
Procedure TLzhArchive.FindFirst (Var SR: ArcSearchRec); Procedure TLzhArchive.FindFirst (Var SR: ArcSearchRec);
Begin Begin
_SL := 0;
GetHeader(SR); GetHeader(SR);
End; End;

2
mystic/bbs_core.pas
View File

@ -201,7 +201,7 @@ Begin
If User.ThisUser.Calls = 1 Then Inc (History.NewUsers, 1); If User.ThisUser.Calls = 1 Then Inc (History.NewUsers, 1);
Inc (History.Hourly[HistoryHour]); If Not LocalMode Then Inc (History.Hourly[HistoryHour]);
ioWrite (HistoryFile, History); ioWrite (HistoryFile, History);
Close (HistoryFile); Close (HistoryFile);

9
mystic/bbs_edit_full.pas
View File

@ -4,7 +4,7 @@ Unit bbs_Edit_Full;
Interface Interface
Function AnsiEditor (Var Lines: SmallInt; WrapPos: Byte; MaxLines: SmallInt; TEdit, Forced: Boolean; Var Subj: String) : Boolean; Function AnsiEditor (Var Lines: SmallInt; WrapPos: Byte; MaxLines: SmallInt; Forced: Boolean; Template: String; Var Subj: String) : Boolean;
Implementation Implementation
@ -18,7 +18,7 @@ Begin
Session.io.BufAddStr(S + #13#10); Session.io.BufAddStr(S + #13#10);
End; End;
Function AnsiEditor (Var Lines: Integer; WrapPos: Byte; MaxLines: Integer; TEdit, Forced: Boolean; Var Subj: String) : Boolean; Function AnsiEditor (Var Lines: Integer; WrapPos: Byte; MaxLines: Integer; Forced: Boolean; Template: String; Var Subj: String) : Boolean;
Const Const
MaxCutText = 100; MaxCutText = 100;
Type Type
@ -411,7 +411,9 @@ End;
Procedure FullReDraw; Procedure FullReDraw;
Begin Begin
If TEdit Then Session.io.OutFile ('ansitext', True, 0) Else Session.io.OutFile ('ansiedit', True, 0); Session.io.PromptInfo[2] := Subj;
Session.io.OutFile (Template, True, 0);
WinStart := Session.io.ScreenInfo[1].Y; WinStart := Session.io.ScreenInfo[1].Y;
WinEnd := Session.io.ScreenInfo[2].Y; WinEnd := Session.io.ScreenInfo[2].Y;
@ -933,6 +935,7 @@ Begin
DeleteLine (CurLine); DeleteLine (CurLine);
TextRefreshPart; TextRefreshPart;
End; End;
^Z,
^[ : Begin ^[ : Begin
Commands; Commands;

2
mystic/bbs_filebase.pas
View File

@ -3629,7 +3629,7 @@ Begin
Temp := 'Description Editor'; Temp := 'Description Editor';
B := FDir.DescLines; B := FDir.DescLines;
If Editor(B, mysMaxFileDescLen, Config.MaxFileDesc, True, False, Temp) Then Begin If Editor(B, mysMaxFileDescLen, Config.MaxFileDesc, False, fn_tplTextEdit, Temp) Then Begin
FDir.DescLines := B; FDir.DescLines := B;
FDir.DescPtr := FileSize(DataFile); FDir.DescPtr := FileSize(DataFile);

10
mystic/bbs_general.pas
View File

@ -15,7 +15,7 @@ Uses
bbs_Edit_Full, bbs_Edit_Full,
bbs_Edit_Line; bbs_Edit_Line;
Function Editor (Var Lines: SmallInt; MaxLen, MaxLine: SmallInt; TEdit, Forced : Boolean; Var Subj: String) : Boolean; Function Editor (Var Lines: SmallInt; MaxLen, MaxLine: SmallInt; Forced: Boolean; Template: String; Var Subj: String) : Boolean;
Procedure Upgrade_User_Level (Now : Boolean; Var U : RecUser; Sec: Byte); Procedure Upgrade_User_Level (Now : Boolean; Var U : RecUser; Sec: Byte);
Procedure View_BBS_List (Long: Boolean; Data: String); Procedure View_BBS_List (Long: Boolean; Data: String);
Procedure Add_BBS_List (Name : String); Procedure Add_BBS_List (Name : String);
@ -50,12 +50,12 @@ Uses
bbs_Core, bbs_Core,
bbs_NodeInfo; bbs_NodeInfo;
Function Editor (Var Lines: SmallInt; MaxLen, MaxLine: SmallInt; TEdit, Forced : Boolean; Var Subj: String) : Boolean; Function Editor (Var Lines: SmallInt; MaxLen, MaxLine: SmallInt; Forced: Boolean; Template: String; Var Subj: String) : Boolean;
Begin Begin
If (Session.io.Graphics > 0) and ((Session.User.ThisUser.EditType = 1) or ((Session.User.ThisUser.EditType = 2) and Session.io.GetYN(Session.GetPrompt(106), True))) Then If (Session.io.Graphics > 0) and ((Session.User.ThisUser.EditType = 1) or ((Session.User.ThisUser.EditType = 2) and Session.io.GetYN(Session.GetPrompt(106), True))) Then
Editor := AnsiEditor(Lines, MaxLen, MaxLine, TEdit, Forced, Subj) Editor := AnsiEditor(Lines, MaxLen, MaxLine, Forced, Template, Subj)
Else Else
Editor := LineEditor(Lines, MaxLen, MaxLine, TEdit, Forced, Subj); Editor := LineEditor(Lines, MaxLen, MaxLine, False, Forced, Subj);
End; End;
Procedure Upgrade_User_Level (Now: Boolean; Var U: RecUser; Sec: Byte); Procedure Upgrade_User_Level (Now: Boolean; Var U: RecUser; Sec: Byte);
@ -120,7 +120,7 @@ Begin
Str := 'Signature Editor'; {++lang} Str := 'Signature Editor'; {++lang}
If Editor (Lines, 78, Config.MaxAutoSig, True, False, Str) Then Begin If Editor (Lines, 78, Config.MaxAutoSig, False, fn_tplMsgEdit, Str) Then Begin
{$I-} Reset (DF, 1); {$I+} {$I-} Reset (DF, 1); {$I+}
If IoResult <> 0 Then ReWrite (DF, 1); If IoResult <> 0 Then ReWrite (DF, 1);

143
mystic/bbs_msgbase.pas
View File

@ -15,22 +15,24 @@ Uses
Type Type
TMsgBase = Class TMsgBase = Class
MBaseFile : File of RecMessageBase; MBaseFile : File of RecMessageBase;
MScanFile : File of MScanRec; MScanFile : File of MScanRec;
GroupFile : File of RecGroup; GroupFile : File of RecGroup;
TotalMsgs : Integer; TotalMsgs : Integer;
TotalConf : Integer; TotalConf : Integer;
MsgBase : PMsgBaseABS; MsgBase : PMsgBaseABS;
MBase : RecMessageBase; MBase : RecMessageBase;
MScan : MScanRec; MScan : MScanRec;
Group : RecGroup; Group : RecGroup;
MsgText : RecMessageText; MsgText : RecMessageText;
WereMsgs : Boolean; MsgTextSize : SmallInt;
Reading : Boolean; WereMsgs : Boolean;
Reading : Boolean;
Constructor Create (Var Owner: Pointer); Constructor Create (Var Owner: Pointer);
Destructor Destroy; Override; Destructor Destroy; Override;
Function IsQuotedText (Str: String) : Boolean;
Function OpenCreateBase (Var Msg: PMsgBaseABS; Var Area: RecMessageBase) : Boolean; Function OpenCreateBase (Var Msg: PMsgBaseABS; Var Area: RecMessageBase) : Boolean;
Procedure AppendMessageText (Var Msg: PMsgBaseABS; Lines: Integer; ReplyID: String); Procedure AppendMessageText (Var Msg: PMsgBaseABS; Lines: Integer; ReplyID: String);
Procedure AssignMessageData (Var Msg: PMsgBaseABS); Procedure AssignMessageData (Var Msg: PMsgBaseABS);
@ -109,10 +111,11 @@ Constructor TMsgBase.Create (Var Owner: Pointer);
Begin Begin
Inherited Create; Inherited Create;
MBase.Name := 'None'; MBase.Name := 'None';
Group.Name := 'None'; Group.Name := 'None';
WereMsgs := False; WereMsgs := False;
Reading := False; Reading := False;
MsgTextSize := 0;
End; End;
Destructor TMsgBase.Destroy; Destructor TMsgBase.Destroy;
@ -120,6 +123,14 @@ Begin
Inherited Destroy; Inherited Destroy;
End; End;
Function TMsgBase.IsQuotedText (Str: String) : Boolean;
Var
Temp : Byte;
Begin
Temp := Pos('>', strStripL(Str, ' '));
Result := (Temp > 0) and (Temp < 5);
End;
Function TMsgBase.OpenCreateBase (Var Msg: PMsgBaseABS; Var Area: RecMessageBase) : Boolean; Function TMsgBase.OpenCreateBase (Var Msg: PMsgBaseABS; Var Area: RecMessageBase) : Boolean;
Begin Begin
Result := False; Result := False;
@ -870,15 +881,16 @@ End;
Procedure TMsgBase.ReplyMessage (Email: Boolean; ListMode: Byte; ReplyID: String); Procedure TMsgBase.ReplyMessage (Email: Boolean; ListMode: Byte; ReplyID: String);
Var Var
ToWho : String[30]; ToWho : String[30];
Subj : String[60]; Subj : String[60];
Addr : RecEchomailAddr; Addr : RecEchomailAddr;
MsgNew : PMsgBaseABS; MsgNew : PMsgBaseABS;
Temp1 : String; TempStr : String;
Temp2 : String[2]; Initials : String[4];
Temp3 : String[80]; WrapData : String;
tFile : Text; DoWrap : Boolean = True;
Lines : SmallInt; QuoteFile : Text;
Lines : SmallInt;
Begin Begin
If Not Session.User.Access(MBase.PostACS) Then Begin If Not Session.User.Access(MBase.PostACS) Then Begin
Session.io.OutFullLn (Session.GetPrompt(105)); Session.io.OutFullLn (Session.GetPrompt(105));
@ -914,9 +926,9 @@ Begin
MsgBase^.GetOrig(Addr); MsgBase^.GetOrig(Addr);
Temp3 := Session.io.GetInput(20, 20, 12, strAddr2Str(Addr)); TempStr := Session.io.GetInput(20, 20, 12, strAddr2Str(Addr));
If Not strStr2Addr (Temp3, Addr) Then Exit; If Not strStr2Addr (TempStr, Addr) Then Exit;
End; End;
Subj := MsgBase^.GetSubj; Subj := MsgBase^.GetSubj;
@ -929,47 +941,60 @@ Begin
If Subj = '' Then Exit; If Subj = '' Then Exit;
Assign (tFile, Session.TempPath + 'msgtmp'); Assign (QuoteFile, Session.TempPath + 'msgtmp');
{$I-} ReWrite (tFile); {$I+} {$I-} ReWrite (QuoteFile); {$I+}
If IoResult = 0 Then Begin If IoResult = 0 Then Begin
Temp3 := MsgBase^.GetFrom; Initials := strInitials(MsgBase^.GetFrom) + '> ';
Temp2 := Temp3[1]; TempStr := Session.GetPrompt(464);
If Pos(' ', Temp3) > 0 Then TempStr := strReplace(TempStr, '|&1', MsgBase^.GetDate);
Temp2 := Temp2 + Temp3[Succ(Pos(' ', Temp3))]; TempStr := strReplace(TempStr, '|&2', MsgBase^.GetFrom);
TempStr := strReplace(TempStr, '|&3', Initials);
Temp1 := Session.GetPrompt(464); WriteLn (QuoteFile, TempStr);
WriteLn (QuoteFile, ' ');
Temp1 := strReplace(Temp1, '|&1', MsgBase^.GetDate);
Temp1 := strReplace(Temp1, '|&2', MsgBase^.GetFrom);
Temp1 := strReplace(Temp1, '|&3', Temp2);
WriteLn (tFile, Temp1);
WriteLn (tFile, ' ');
Lines := 0;
MsgBase^.MsgTxtStartUp; MsgBase^.MsgTxtStartUp;
While Not MsgBase^.EOM and (Lines < mysMaxMsgLines - 2) Do Begin WrapData := '';
Inc (Lines);
Temp3 := MsgBase^.GetString(79); While Not MsgBase^.EOM Do Begin
TempStr := MsgBase^.GetString(79);
If Temp3[1] <> #1 Then If TempStr[1] = #1 Then Continue;
WriteLn (tFile, Temp2 + '> ' + Copy(Temp3, 1, 74));
DoWrap := Not IsQuotedText(TempStr);
If DoWrap Then Begin
If WrapData <> '' Then Begin
If TempStr = '' Then Begin
WriteLn (QuoteFile, Initials + WrapData);
WriteLn (QuoteFile, Initials);
WrapData := '';
Continue;
End;
TempStr := WrapData + ' ' + TempStr;
End;
strWrap (TempStr, WrapData, 74);
WriteLn (QuoteFile, Initials + Copy(TempStr, 1, 74));
End Else
WriteLn (QuoteFile, Initials + Copy(TempStr, 1, 74));
End; End;
Close (tFile); Close (QuoteFile);
End; End;
Lines := 0; Lines := 0;
Session.io.PromptInfo[1] := ToWho; Session.io.PromptInfo[1] := ToWho;
Session.io.PromptInfo[2] := Subj;
If Editor(Lines, 78, mysMaxMsgLines, False, False, Subj) Then Begin If Editor(Lines, 78, mysMaxMsgLines, False, fn_tplMsgEdit, Subj) Then Begin
Session.io.OutFull (Session.GetPrompt(107)); Session.io.OutFull (Session.GetPrompt(107));
@ -1043,11 +1068,13 @@ Var
While Not MsgBase^.EOM and (Lines < mysMaxMsgLines) Do Begin While Not MsgBase^.EOM and (Lines < mysMaxMsgLines) Do Begin
Inc (Lines); Inc (Lines);
MsgText[Lines] := MsgBase^.GetString(79); MsgText[Lines] := MsgBase^.GetString(79);
End; End;
If Lines < mysMaxMsgLines Then Begin If Lines < mysMaxMsgLines Then Begin
Inc (Lines); Inc (Lines);
MsgText[Lines] := ''; MsgText[Lines] := '';
End; End;
End; End;
@ -1096,7 +1123,7 @@ Begin
'!' : Begin '!' : Begin
Temp1 := MsgBase^.GetSubj; Temp1 := MsgBase^.GetSubj;
If Editor(Lines, 78, mysMaxMsgLines, False, False, Temp1) Then If Editor(Lines, 78, mysMaxMsgLines, False, fn_tplMsgEdit, Temp1) Then
MsgBase^.SetSubj(Temp1) MsgBase^.SetSubj(Temp1)
Else Else
ReadText; ReadText;
@ -1440,9 +1467,8 @@ Var
Var Var
B : Byte; B : Byte;
Begin Begin
B := Pos('>', strStripL(Str, ' '));
If (B > 0) and (B < 5) Then Begin If IsQuotedText(Str) Then Begin
Session.io.AnsiColor(MBase.ColQuote); Session.io.AnsiColor(MBase.ColQuote);
Session.io.OutPipe (Str); Session.io.OutPipe (Str);
Session.io.AnsiColor(MBase.ColText); Session.io.AnsiColor(MBase.ColText);
@ -2351,7 +2377,8 @@ Begin
1 : MsgBase := New(PMsgbaseSquish, Init); 1 : MsgBase := New(PMsgbaseSquish, Init);
End; End;
MsgBase^.SetMsgPath (MBase.Path + MBase.FileName); MsgBase^.SetMsgPath (MBase.Path + MBase.FileName);
MsgBase^.SetTempFile (Session.TempPath + 'msgbuf.');
If Not MsgBase^.OpenMsgBase Then Begin If Not MsgBase^.OpenMsgBase Then Begin
If Mode = 'E' Then If Mode = 'E' Then
@ -2555,9 +2582,9 @@ Begin
Lines := 0; Lines := 0;
Session.io.PromptInfo[1] := MsgTo; Session.io.PromptInfo[1] := MsgTo;
Session.io.PromptInfo[2] := MsgSubj; // Session.io.PromptInfo[2] := MsgSubj;
If Editor(Lines, 78, mysMaxMsgLines, False, Forced, MsgSubj) Then Begin If Editor(Lines, 78, mysMaxMsgLines, Forced, fn_tplMsgEdit, MsgSubj) Then Begin
Session.io.OutFull (Session.GetPrompt(107)); Session.io.OutFull (Session.GetPrompt(107));
{ all of this below should be replaced with a SaveMessage function } { all of this below should be replaced with a SaveMessage function }
@ -2997,7 +3024,7 @@ Begin
Lines := 0; Lines := 0;
If Editor(Lines, 78, mysMaxMsgLines, False, False, MsgSubj) Then Begin If Editor(Lines, 78, mysMaxMsgLines, False, fn_tplMsgEdit, MsgSubj) Then Begin
Session.io.OutFullLn (Session.GetPrompt(394)); Session.io.OutFullLn (Session.GetPrompt(394));
OLD := MBase; OLD := MBase;

10
mystic/bbs_msgbase_abs.pas
View File

@ -100,7 +100,7 @@ Type
Function YoursFound: Boolean; Virtual; {Message found} Function YoursFound: Boolean; Virtual; {Message found}
Function GetHighMsgNum: LongInt; Virtual; {Get highest msg number} Function GetHighMsgNum: LongInt; Virtual; {Get highest msg number}
Procedure SetMailType(MT: MsgMailType); Virtual; {Set message base type} Procedure SetMailType(MT: MsgMailType); Virtual; {Set message base type}
Function GetSubArea: Word; Virtual; {Get sub area number} // Function GetSubArea: Word; Virtual; {Get sub area number}
Procedure ReWriteHdr; Virtual; {Rewrite msg header after changes} Procedure ReWriteHdr; Virtual; {Rewrite msg header after changes}
Procedure DeleteMsg; Virtual; {Delete current message} Procedure DeleteMsg; Virtual; {Delete current message}
Procedure SetEcho(ES: Boolean); Virtual; {Set echo status} Procedure SetEcho(ES: Boolean); Virtual; {Set echo status}
@ -521,10 +521,10 @@ Procedure TMsgBaseABS.SetMailType(MT: MsgMailType);
Begin Begin
End; End;
Function TMsgBaseABS.GetSubArea: Word; //Function TMsgBaseABS.GetSubArea: Word;
Begin //Begin
GetSubArea := 0; // GetSubArea := 0;
End; //End;
Procedure TMsgBaseABS.ReWriteHdr; Procedure TMsgBaseABS.ReWriteHdr;
Begin Begin

436
mystic/bbs_msgbase_jam.pas
View File

@ -189,57 +189,57 @@ Type
Procedure SeekNext; Virtual; {Find next matching msg} Procedure SeekNext; Virtual; {Find next matching msg}
Procedure SeekPrior; Virtual; {Seek prior matching msg} Procedure SeekPrior; Virtual; {Seek prior matching msg}
Function GetFrom : String; Virtual; {Get from name on current msg} Function GetFrom : String; Virtual; {Get from name on current msg}
Function GetTo: String; Virtual; {Get to name on current msg} Function GetTo : String; Virtual; {Get to name on current msg}
Function GetSubj: String; Virtual; {Get subject on current msg} Function GetSubj : String; Virtual; {Get subject on current msg}
Function GetCost: Word; Virtual; {Get cost of current msg} Function GetCost : Word; Virtual; {Get cost of current msg}
Function GetDate: String; Virtual; {Get date of current msg} Function GetDate : String; Virtual; {Get date of current msg}
Function GetTime: String; Virtual; {Get time of current msg} Function GetTime : String; Virtual; {Get time of current msg}
Function GetRefer: LongInt; Virtual; {Get reply to of current msg} Function GetRefer : LongInt; Virtual; {Get reply to of current msg}
Function GetSeeAlso: LongInt; Virtual; {Get see also of current msg} Function GetSeeAlso : LongInt; Virtual; {Get see also of current msg}
Function GetMsgNum: LongInt; Virtual; {Get message number} Function GetMsgNum : LongInt; Virtual; {Get message number}
Procedure GetOrig(Var Addr: RecEchoMailAddr); Virtual; {Get origin address} Procedure GetOrig (Var Addr: RecEchoMailAddr); Virtual; {Get origin address}
Procedure GetDest(Var Addr: RecEchoMailAddr); Virtual; {Get destination address} Procedure GetDest (Var Addr: RecEchoMailAddr); Virtual; {Get destination address}
Function GetTextLen : LongInt; Virtual; {returns length of text in msg} Function GetTextLen : LongInt; Virtual; {returns length of text in msg}
Function IsLocal: Boolean; Virtual; {Is current msg local} Function IsLocal : Boolean; Virtual; {Is current msg local}
Function IsCrash: Boolean; Virtual; {Is current msg crash} Function IsCrash : Boolean; Virtual; {Is current msg crash}
Function IsKillSent: Boolean; Virtual; {Is current msg kill sent} Function IsKillSent : Boolean; Virtual; {Is current msg kill sent}
Function IsSent: Boolean; Virtual; {Is current msg sent} Function IsSent : Boolean; Virtual; {Is current msg sent}
Function IsFAttach: Boolean; Virtual; {Is current msg file attach} Function IsFAttach : Boolean; Virtual; {Is current msg file attach}
// Function IsReqRct: Boolean; Virtual; {Is current msg request receipt} // Function IsReqRct: Boolean; Virtual; {Is current msg request receipt}
// Function IsReqAud: Boolean; Virtual; {Is current msg request audit} // Function IsReqAud: Boolean; Virtual; {Is current msg request audit}
// Function IsRetRct: Boolean; Virtual; {Is current msg a return receipt} // Function IsRetRct: Boolean; Virtual; {Is current msg a return receipt}
Function IsFileReq: Boolean; Virtual; {Is current msg a file request} Function IsFileReq : Boolean; Virtual; {Is current msg a file request}
Function IsRcvd: Boolean; Virtual; {Is current msg received} Function IsRcvd : Boolean; Virtual; {Is current msg received}
Function IsPriv: Boolean; Virtual; {Is current msg priviledged/private} Function IsPriv : Boolean; Virtual; {Is current msg priviledged/private}
Function IsDeleted: Boolean; Virtual; {Is current msg deleted} Function IsDeleted : Boolean; Virtual; {Is current msg deleted}
Function IsEchoed: Boolean; Virtual; {Msg should be echoed} // Function IsEchoed : Boolean; Virtual; {Msg should be echoed}
Function GetMsgLoc: LongInt; Virtual; {Msg location} Function GetMsgLoc : LongInt; Virtual; {Msg location}
Procedure SetMsgLoc(ML: LongInt); Virtual; {Msg location} Procedure SetMsgLoc (ML: LongInt); Virtual; {Msg location}
Procedure YoursFirst(Name: String; Handle: String); Virtual; {Seek your mail} Procedure YoursFirst (Name: String; Handle: String); Virtual; {Seek your mail}
Procedure YoursNext; Virtual; {Seek next your mail} Procedure YoursNext; Virtual; {Seek next your mail}
Function YoursFound: Boolean; Virtual; {Message found} Function YoursFound : Boolean; Virtual; {Message found}
Procedure StartNewMsg; Virtual; Procedure StartNewMsg; Virtual;
Function OpenMsgBase : Boolean; Virtual; Function OpenMsgBase : Boolean; Virtual;
Procedure CloseMsgBase; Virtual; Procedure CloseMsgBase; Virtual;
Function MsgBaseExists: Boolean; Virtual; {Does msg base exist} // Function MsgBaseExists : Boolean; Virtual; {Does msg base exist}
Function CreateMsgBase(MaxMsg: Word; MaxDays: Word): Boolean; Virtual; Function CreateMsgBase (MaxMsg: Word; MaxDays: Word): Boolean; Virtual;
Function SeekFound: Boolean; Virtual; Function SeekFound : Boolean; Virtual;
Procedure SetMailType(MT: MsgMailType); Virtual; {Set message base type} Procedure SetMailType (MT: MsgMailType); Virtual; {Set message base type}
Function GetSubArea: Word; Virtual; {Get sub area number} // Function GetSubArea : Word; Virtual; {Get sub area number}
Procedure ReWriteHdr; Virtual; {Rewrite msg header after changes} Procedure ReWriteHdr; Virtual; {Rewrite msg header after changes}
Procedure DeleteMsg; Virtual; {Delete current message} Procedure DeleteMsg; Virtual; {Delete current message}
Function NumberOfMsgs: LongInt; Virtual; {Number of messages} Function NumberOfMsgs : LongInt; Virtual; {Number of messages}
Function GetLastRead(UNum: LongInt): LongInt; Virtual; {Get last read for user num} Function GetLastRead (UNum: LongInt): LongInt; Virtual; {Get last read for user num}
Procedure SetLastRead(UNum: LongInt; LR: LongInt); Virtual; {Set last read} Procedure SetLastRead (UNum: LongInt; LR: LongInt); Virtual; {Set last read}
Procedure MsgTxtStartUp; Virtual; {Do message text start up tasks} Procedure MsgTxtStartUp; Virtual; {Do message text start up tasks}
Function GetTxtPos: LongInt; Virtual; {Get indicator of msg text position} Function GetTxtPos : LongInt; Virtual; {Get indicator of msg text position}
Procedure SetTxtPos(TP: LongInt); Virtual; {Set text position} Procedure SetTxtPos (TP: LongInt); Virtual; {Set text position}
Procedure SetAttr1(Mask: LongInt; St: Boolean); {Set attribute 1} Procedure SetAttr1 (Mask: LongInt; St: Boolean); {Set attribute 1}
Function ReadIdx: Word; Function ReadIdx : Word;
Function WriteIdx: Word; Function WriteIdx : Word;
Procedure AddSubField(id: Word; Data: String); Procedure AddSubField (id: Word; Data: String);
Function FindLastRead(Var LastFile: File; UNum: LongInt): LongInt; Function FindLastRead (Var LastFile: File; UNum: LongInt): LongInt;
Function ReReadIdx(Var IdxLoc : LongInt) : Word; Function ReReadIdx (Var IdxLoc : LongInt) : Word;
End; End;
Function JamStrCrc(St: String): LongInt; Function JamStrCrc(St: String): LongInt;
@ -1320,37 +1320,37 @@ Function TMsgBaseJAM.IsPriv: Boolean; {Is current msg priviledged/private}
Function TMsgBaseJAM.IsDeleted: Boolean; {Is current msg deleted} Function TMsgBaseJAM.IsDeleted: Boolean; {Is current msg deleted}
Begin Begin
IsDeleted := (MsgHdr^.JamHdr.Attr1 and Jam_Deleted) <> 0; IsDeleted := (MsgHdr^.JamHdr.Attr1 and Jam_Deleted) <> 0;
End; End;
Function TMsgBaseJAM.IsEchoed: Boolean; {Is current msg echoed}
Begin
IsEchoed := True;
End;
//Function TMsgBaseJAM.IsEchoed: Boolean; {Is current msg echoed}
//Begin
// IsEchoed := True;
//End;
Procedure TMsgBaseJAM.SeekFirst(MsgNum: LongInt); {Start msg seek} Procedure TMsgBaseJAM.SeekFirst(MsgNum: LongInt); {Start msg seek}
Begin Begin
JM^.CurrMsgNum := MsgNum - 1; JM^.CurrMsgNum := MsgNum - 1;
If JM^.CurrMsgNum < (JM^.BaseHdr.BaseMsgNum - 1) Then If JM^.CurrMsgNum < (JM^.BaseHdr.BaseMsgNum - 1) Then
JM^.CurrMsgNum := JM^.BaseHdr.BaseMsgNum - 1; JM^.CurrMsgNum := JM^.BaseHdr.BaseMsgNum - 1;
SeekNext;
End;
SeekNext;
End;
Procedure TMsgBaseJAM.SeekNext; {Find next matching msg} Procedure TMsgBaseJAM.SeekNext; {Find next matching msg}
Var Var
IdxLoc: LongInt; IdxLoc: LongInt;
Begin Begin
If JM^.CurrMsgNum <= GetHighMsgNum Then If JM^.CurrMsgNum <= GetHighMsgNum Then
Inc(JM^.CurrMsgNum); Inc (JM^.CurrMsgNum);
Error := ReReadIdx(IdxLoc); Error := ReReadIdx(IdxLoc);
While (((JamIdx^[IdxLoc - JM^.IdxStart].HdrLoc < 0) or (JamIdx^[IdxLoc - JM^.IdxStart].MsgToCrc = -1)) And (JM^.CurrMsgNum <= GetHighMsgNum)) Do Begin While (((JamIdx^[IdxLoc - JM^.IdxStart].HdrLoc < 0) or (JamIdx^[IdxLoc - JM^.IdxStart].MsgToCrc = -1)) And (JM^.CurrMsgNum <= GetHighMsgNum)) Do Begin
Inc(JM^.CurrMsgNum); Inc (JM^.CurrMsgNum);
Error := ReReadIdx(IdxLoc); Error := ReReadIdx(IdxLoc);
End; End;
End; End;
@ -1366,7 +1366,7 @@ Begin
If JM^.CurrMsgNum >= JM^.BaseHdr.BaseMsgNum Then If JM^.CurrMsgNum >= JM^.BaseHdr.BaseMsgNum Then
While (IdxLoc >= 0) And (((JamIdx^[IdxLoc - JM^.IdxStart].HdrLoc < 0) or (JamIdx^[IdxLoc - JM^.IdxStart].MsgToCrc = -1)) And (JM^.CurrMsgNum >= JM^.BaseHdr.BaseMsgNum)) Do Begin While (IdxLoc >= 0) And (((JamIdx^[IdxLoc - JM^.IdxStart].HdrLoc < 0) or (JamIdx^[IdxLoc - JM^.IdxStart].MsgToCrc = -1)) And (JM^.CurrMsgNum >= JM^.BaseHdr.BaseMsgNum)) Do Begin
Dec(JM^.CurrMsgNum); Dec (JM^.CurrMsgNum);
Error := ReReadIdx(IdxLoc); Error := ReReadIdx(IdxLoc);
End; End;
End; End;
@ -1376,30 +1376,27 @@ Begin
SeekFound := ((JM^.CurrMsgNum >= JM^.BaseHdr.BaseMsgNum) and (JM^.CurrMsgNum <= GetHighMsgNum)); SeekFound := ((JM^.CurrMsgNum >= JM^.BaseHdr.BaseMsgNum) and (JM^.CurrMsgNum <= GetHighMsgNum));
End; End;
Function TMsgBaseJAM.GetMsgLoc: LongInt; {Msg location} Function TMsgBaseJAM.GetMsgLoc: LongInt; {Msg location}
Begin Begin
GetMsgLoc := GetMsgNum; GetMsgLoc := GetMsgNum;
End; End;
Procedure TMsgBaseJAM.SetMsgLoc(ML: LongInt); {Msg location} Procedure TMsgBaseJAM.SetMsgLoc(ML: LongInt); {Msg location}
Begin Begin
JM^.CurrMsgNum := ML; JM^.CurrMsgNum := ML;
End; End;
Procedure TMsgBaseJAM.YoursFirst (Name: String; Handle: String);
Procedure TMsgBaseJAM.YoursFirst(Name: String; Handle: String);
Begin Begin
JM^.YourName := Name; JM^.YourName := Name;
JM^.YourHdl := Handle; JM^.YourHdl := Handle;
JM^.NameCrc := JamStrCrc(Name); JM^.NameCrc := JamStrCrc(Name);
JM^.HdlCrc := JamStrCrc(Handle); JM^.HdlCrc := JamStrCrc(Handle);
JM^.CurrMsgNum := JM^.BaseHdr.BaseMsgNum - 1; JM^.CurrMsgNum := JM^.BaseHdr.BaseMsgNum - 1;
YoursNext; YoursNext;
End; End;
Procedure TMsgBaseJAM.YoursNext; Procedure TMsgBaseJAM.YoursNext;
Var Var
Found : Boolean; Found : Boolean;
@ -1412,8 +1409,10 @@ Begin
Found := False; Found := False;
Inc(JM^.CurrMsgNum); Inc(JM^.CurrMsgNum);
While ((Not Found) and (JM^.CurrMsgNum <= GetHighMsgNum) And (Error = 0)) Do Begin While ((Not Found) and (JM^.CurrMsgNum <= GetHighMsgNum) And (Error = 0)) Do Begin
Error := ReReadIdx(IdxLoc); Error := ReReadIdx(IdxLoc);
If Error = 0 Then Begin {Check CRC values} If Error = 0 Then Begin {Check CRC values}
If ((JamIdx^[IdxLoc - JM^.IdxStart].MsgToCrc = JM^.NameCrc) or If ((JamIdx^[IdxLoc - JM^.IdxStart].MsgToCrc = JM^.NameCrc) or
(JamIdx^[IdxLoc - JM^.IdxStart].MsgToCrc = JM^.HdlCrc)) Then Begin (JamIdx^[IdxLoc - JM^.IdxStart].MsgToCrc = JM^.HdlCrc)) Then Begin
@ -1450,56 +1449,58 @@ Begin
End; End;
End; End;
Function TMsgBaseJAM.YoursFound: Boolean; Function TMsgBaseJAM.YoursFound: Boolean;
Begin Begin
YoursFound := ((JM^.CurrMsgNum >= JM^.BaseHdr.BaseMsgNum) and YoursFound := ((JM^.CurrMsgNum >= JM^.BaseHdr.BaseMsgNum) and (JM^.CurrMsgNum <= GetHighMsgNum));
(JM^.CurrMsgNum <= GetHighMsgNum)); End;
End;
Procedure TMsgBaseJAM.StartNewMsg; Procedure TMsgBaseJAM.StartNewMsg;
Begin Begin
JM^.TxtBufStart := 0; JM^.TxtBufStart := 0;
JM^.TxtPos := 0; JM^.TxtPos := 0;
FillChar(MsgHdr^, SizeOf(MsgHdr^), #0); FillChar(MsgHdr^, SizeOf(MsgHdr^), #0);
MsgHdr^.JamHdr.SubFieldLen := 0;
MsgHdr^.JamHdr.MsgIdCrc := -1; // MsgHdr^.JamHdr.SubFieldLen := 0;
MsgHdr^.JamHdr.ReplyCrc := -1; MsgHdr^.JamHdr.MsgIdCrc := -1;
MsgHdr^.JamHdr.PwdCrc := -1; MsgHdr^.JamHdr.ReplyCrc := -1;
JM^.MsgTo := ''; MsgHdr^.JamHdr.PwdCrc := -1;
JM^.MsgTo := '';
JM^.MsgFrom := ''; JM^.MsgFrom := '';
JM^.MsgSubj := ''; JM^.MsgSubj := '';
FillChar(JM^.Orig, SizeOf(JM^.Orig), #0); FillChar(JM^.Orig, SizeOf(JM^.Orig), #0);
FillChar(JM^.Dest, SizeOf(JM^.Dest), #0); FillChar(JM^.Dest, SizeOf(JM^.Dest), #0);
JM^.MsgDate := DateDos2Str(CurDateDos, 1); JM^.MsgDate := DateDos2Str(CurDateDos, 1);
JM^.MsgTime := TimeDos2Str(CurDateDos, False); JM^.MsgTime := TimeDos2Str(CurDateDos, False);
// writeln(jm^.msgdate); End;
End;
Function TMsgBaseJAM.MsgBaseExists: Boolean; //Function TMsgBaseJAM.MsgBaseExists: Boolean;
Begin // Begin
MsgBaseExists := (FileExist(JM^.MsgPath + '.jhr')); // MsgBaseExists := (FileExist(JM^.MsgPath + '.jhr'));
End; // End;
Function TMsgBaseJAM.ReadIdx: Word; Function TMsgBaseJAM.ReadIdx: Word;
Begin Begin
If JM^.IdxStart < 0 Then JM^.IdxStart := 0; If JM^.IdxStart < 0 Then JM^.IdxStart := 0;
Seek(JM^.IdxFile, JM^.IdxStart);
BlockRead(JM^.IdxFile, JamIdx^, JamIdxBufSize, JM^.IdxRead);
ReadIdx := IoResult;
End;
Seek (JM^.IdxFile, JM^.IdxStart);
BlockRead (JM^.IdxFile, JamIdx^, JamIdxBufSize, JM^.IdxRead);
ReadIdx := IoResult;
End;
Function TMsgBaseJAM.WriteIdx: Word; Function TMsgBaseJAM.WriteIdx: Word;
Begin Begin
Seek(JM^.IdxFile, JM^.IdxStart); Seek (JM^.IdxFile, JM^.IdxStart);
BlockWrite(JM^.IdxFile, JamIdx^, JM^.IdxRead); BlockWrite (JM^.IdxFile, JamIdx^, JM^.IdxRead);
WriteIdx := IoResult;
End;
WriteIdx := IoResult;
End;
Function TMsgBaseJAM.OpenMsgBase: Boolean; Function TMsgBaseJAM.OpenMsgBase: Boolean;
Var Var
@ -1545,78 +1546,83 @@ End;
Procedure TMsgBaseJAM.CloseMsgBase; Procedure TMsgBaseJAM.CloseMsgBase;
Begin Begin
Close(JM^.HdrFile); Close (JM^.HdrFile);
Close(JM^.TxtFile); Close (JM^.TxtFile);
Close(JM^.IdxFile); Close (JM^.IdxFile);
End; End;
Function TMsgBaseJAM.CreateMsgBase(MaxMsg: Word; MaxDays: Word): Boolean; Function TMsgBaseJAM.CreateMsgBase (MaxMsg: Word; MaxDays: Word): Boolean;
Var Var
TmpHdr: ^JamHdrType; TmpHdr : ^JamHdrType;
CreateError: Word; CreateError : Word;
// i: Word;
Begin Begin
CreateError := 0; CreateError := 0;
New(TmpHdr); New(TmpHdr);
If TmpHdr = Nil Then If TmpHdr = Nil Then
CreateError := 500 CreateError := 500
Else Begin; Else Begin;
FillChar(TmpHdr^, SizeOf(TmpHdr^), #0); FillChar(TmpHdr^, SizeOf(TmpHdr^), #0);
TmpHdr^.Signature[1] := 'J'; TmpHdr^.Signature[1] := 'J';
TmpHdr^.Signature[2] := 'A'; TmpHdr^.Signature[2] := 'A';
TmpHdr^.Signature[3] := 'M'; TmpHdr^.Signature[3] := 'M';
TmpHdr^.BaseMsgNum := 1; TmpHdr^.BaseMsgNum := 1;
TmpHdr^.Created := ToUnixDate(CurDateDos); TmpHdr^.Created := ToUnixDate(CurDateDos);
TmpHdr^.PwdCrc := -1; TmpHdr^.PwdCrc := -1;
CreateError := SaveFile(JM^.MsgPath + '.jhr', TmpHdr^, SizeOf(TmpHdr^)); CreateError := SaveFile(JM^.MsgPath + '.jhr', TmpHdr^, SizeOf(TmpHdr^));
Dispose(TmpHdr); Dispose(TmpHdr);
If CreateError = 0 Then If CreateError = 0 Then
CreateError := SaveFile(JM^.MsgPath + '.jlr', CreateError, 0); CreateError := SaveFile(JM^.MsgPath + '.jlr', CreateError, 0);
If CreateError = 0 Then If CreateError = 0 Then
CreateError := SaveFile(JM^.MsgPath + '.jdt', CreateError, 0); CreateError := SaveFile(JM^.MsgPath + '.jdt', CreateError, 0);
If CreateError = 0 Then If CreateError = 0 Then
CreateError := SaveFile(JM^.MsgPath + '.jdx', CreateError , 0); CreateError := SaveFile(JM^.MsgPath + '.jdx', CreateError , 0);
If IoResult <> 0 Then; If IoResult <> 0 Then;
End; End;
CreateMsgBase := CreateError = 0; CreateMsgBase := CreateError = 0;
End; End;
Procedure TMsgBaseJAM.SetMailType(MT: MsgMailType); Procedure TMsgBaseJAM.SetMailType(MT: MsgMailType);
Begin Begin
JM^.MailType := MT; JM^.MailType := MT;
End; End;
Function TMsgBaseJAM.GetSubArea: Word;
Begin
GetSubArea := 0;
End;
//Function TMsgBaseJAM.GetSubArea: Word;
//Begin
// GetSubArea := 0;
//End;
Procedure TMsgBaseJAM.ReWriteHdr; Procedure TMsgBaseJAM.ReWriteHdr;
Var Var
IdxLoc: LongInt; IdxLoc : LongInt;
Begin Begin
If LockMsgBase Then If LockMsgBase Then
Error := 0 Error := 0
Else Else
Error := 5; Error := 5;
Error := ReReadIdx(IdxLoc);
If Error = 0 Then Begin
Seek(JM^.HdrFile, JamIdx^[IdxLoc - JM^.IdxStart].HdrLoc);
Error := IoResult;
End;
If Error = 0 Then Begin
BlockWrite(JM^.HdrFile, MsgHdr^.JamHdr, SizeOf(MsgHdr^.JamHdr));
Error := IoResult;
End;
If UnLockMsgBase Then;
End;
Error := ReReadIdx(IdxLoc);
If Error = 0 Then Begin
Seek (JM^.HdrFile, JamIdx^[IdxLoc - JM^.IdxStart].HdrLoc);
Error := IoResult;
End;
If Error = 0 Then Begin
BlockWrite (JM^.HdrFile, MsgHdr^.JamHdr, SizeOf(MsgHdr^.JamHdr));
Error := IoResult;
End;
UnLockMsgBase;
End;
Procedure TMsgBaseJAM.DeleteMsg; Procedure TMsgBaseJAM.DeleteMsg;
Var Var
@ -1628,20 +1634,25 @@ Begin
DelError := 0 DelError := 0
Else Else
DelError := 5; DelError := 5;
If DelError = 0 Then Begin If DelError = 0 Then Begin
SetAttr1(Jam_Deleted, True); SetAttr1 (Jam_Deleted, True);
Dec(JM^.BaseHdr.ActiveMsgs); Dec (JM^.BaseHdr.ActiveMsgs);
DelError := ReReadIdx(IdxLoc); DelError := ReReadIdx(IdxLoc);
End; End;
If DelError = 0 Then ReWriteHdr; If DelError = 0 Then ReWriteHdr;
If DelError = 0 Then Begin If DelError = 0 Then Begin
Inc(JM^.BaseHdr.ModCounter); Inc(JM^.BaseHdr.ModCounter);
{these three were commented out for some reason }
JamIdx^[IdxLoc - JM^.IdxStart].MsgToCrc := -1; JamIdx^[IdxLoc - JM^.IdxStart].MsgToCrc := -1;
JamIdx^[IdxLoc - JM^.IdxStart].HdrLoc := -1; JamIdx^[IdxLoc - JM^.IdxStart].HdrLoc := -1;
If WriteIdx = 0 Then;
WriteIdx;
End; End;
If UnLockMsgBase Then;
UnLockMsgBase;
End; End;
End; End;
@ -1650,122 +1661,145 @@ Begin
NumberOfMsgs := JM^.BaseHdr.ActiveMsgs; NumberOfMsgs := JM^.BaseHdr.ActiveMsgs;
End; End;
Function TMsgBaseJAM.FindLastRead (Var LastFile: File; UNum: LongInt): LongInt;
Function TMsgBaseJAM.FindLastRead(Var LastFile: File; UNum: LongInt): LongInt; Const
Const LastSize = 100;
LastSize = 100; Type
LastArray = Array[1..LastSize] of JamLastType;
Type LastArray = Array[1..LastSize] of JamLastType; Var
LastBuf : ^LastArray;
Var LastError : Word;
LastBuf: ^LastArray; NumRead : LongInt;
LastError: Word; Found : Boolean;
NumRead: LongInt; Count : Word;
Found: Boolean; LastStart : LongInt;
i: Word; Begin
LastStart: LongInt;
Begin
FindLastRead := -1; FindLastRead := -1;
Found := False; Found := False;
New(LastBuf);
Seek(LastFile, 0); New (LastBuf);
Seek (LastFile, 0);
LastError := IoResult; LastError := IoResult;
While ((Not Eof(LastFile)) and (LastError = 0) And (Not Found)) Do
Begin While ((Not Eof(LastFile)) and (LastError = 0) And (Not Found)) Do Begin
LastStart := FilePos(LastFile); LastStart := FilePos(LastFile);
BlockRead(LastFile, LastBuf^, LastSize, NumRead);
BlockRead (LastFile, LastBuf^, LastSize, NumRead);
LastError := IoResult; LastError := IoResult;
For i := 1 to NumRead Do Begin
If LastBuf^[i].UserNum = UNum Then For Count := 1 to NumRead Do Begin
Begin If LastBuf^[Count].UserNum = UNum Then Begin
Found := True; Found := True;
FindLastRead := LastStart + i - 1; FindLastRead := LastStart + Count - 1;
End;
End; End;
End; End;
Dispose(LastBuf);
End; End;
Dispose (LastBuf);
End;
Function TMsgBaseJAM.GetLastRead(UNum: LongInt): LongInt; Function TMsgBaseJAM.GetLastRead (UNum: LongInt) : LongInt;
Var Var
RecNum: LongInt; RecNum : LongInt;
LastFile: File; LastFile : File;
TmpLast: JamLastType; TmpLast : JamLastType;
Begin Begin
Assign(LastFile, JM^.MsgPath + '.jlr'); Assign (LastFile, JM^.MsgPath + '.jlr');
FileMode := fmReadWrite + fmDenyNone; FileMode := fmReadWrite + fmDenyNone;
Reset(LastFile, SizeOf(JamLastType));
Error := IoResult; Reset (LastFile, SizeOf(JamLastType));
Error := IoResult;
RecNum := FindLastRead(LastFile, UNum); RecNum := FindLastRead(LastFile, UNum);
If RecNum >= 0 Then Begin If RecNum >= 0 Then Begin
Seek(LastFile, RecNum); Seek (LastFile, RecNum);
If Error = 0 Then Begin If Error = 0 Then Begin
BlockRead(LastFile, TmpLast, 1); BlockRead (LastFile, TmpLast, 1);
Error := IoResult;
Error := IoResult;
GetLastRead := TmpLast.HighRead; GetLastRead := TmpLast.HighRead;
End; End;
End Else End Else
GetLastRead := 0; GetLastRead := 0;
Close(LastFile); Close (LastFile);
Error := IoResult; Error := IoResult;
End; End;
Procedure TMsgBaseJAM.SetLastRead(UNum: LongInt; LR: LongInt); Procedure TMsgBaseJAM.SetLastRead (UNum: LongInt; LR: LongInt);
Var Var
RecNum: LongInt; RecNum : LongInt;
LastFile: File; LastFile : File;
TmpLast: JamLastType; TmpLast : JamLastType;
Begin
Assign (LastFile, JM^.MsgPath + '.jlr');
Begin
Assign(LastFile, JM^.MsgPath + '.jlr');
FileMode := fmReadWrite + fmDenyNone; FileMode := fmReadWrite + fmDenyNone;
Reset(LastFile, SizeOf(JamLastType));
Reset (LastFile, SizeOf(JamLastType));
Error := IoResult; Error := IoResult;
If Error <> 0 Then ReWrite(LastFile, SizeOf(JamLastType)); If Error <> 0 Then ReWrite(LastFile, SizeOf(JamLastType));
Error := IoResult;
Error := IoResult;
RecNum := FindLastRead(LastFile, UNum); RecNum := FindLastRead(LastFile, UNum);
If RecNum >= 0 Then Begin If RecNum >= 0 Then Begin
Seek(LastFile, RecNum); Seek (LastFile, RecNum);
If Error = 0 Then Begin If Error = 0 Then Begin
BlockRead(LastFile, TmpLast, 1); BlockRead (LastFile, TmpLast, 1);
Error := IoResult; Error := IoResult;
TmpLast.HighRead := LR; TmpLast.HighRead := LR;
TmpLast.LastRead := LR; TmpLast.LastRead := LR;
If Error = 0 Then Begin If Error = 0 Then Begin
Seek(LastFile, RecNum); Seek (LastFile, RecNum);
Error := IoResult; Error := IoResult;
End; End;
If Error = 0 Then Begin If Error = 0 Then Begin
BlockWrite(LastFile, TmpLast, 1); BlockWrite (LastFile, TmpLast, 1);
Error := IoResult; Error := IoResult;
End; End;
End; End;
End Else Begin End Else Begin
TmpLast.UserNum := UNum; TmpLast.UserNum := UNum;
TmpLast.HighRead := Lr; TmpLast.HighRead := Lr;
TmpLast.NameCrc := UNum; TmpLast.NameCrc := UNum;
TmpLast.LastRead := Lr; TmpLast.LastRead := Lr;
Seek(LastFile, FileSize(LastFile));
Seek (LastFile, FileSize(LastFile));
Error := IoResult; Error := IoResult;
If Error = 0 Then Begin If Error = 0 Then Begin
BlockWrite(LastFile, TmpLast, 1); BlockWrite (LastFile, TmpLast, 1);
Error := IoResult; Error := IoResult;
End; End;
End; End;
Close(LastFile);
Close (LastFile);
Error := IoResult; Error := IoResult;
End; End;
Function TMsgBaseJAM.GetTxtPos : LongInt;
Function TMsgBaseJAM.GetTxtPos: LongInt;
Begin Begin
GetTxtPos := JM^.TxtPos; GetTxtPos := JM^.TxtPos;
End; End;
Procedure TMsgBaseJAM.SetTxtPos(TP: LongInt); Procedure TMsgBaseJAM.SetTxtPos (TP: LongInt);
Begin Begin
JM^.TxtPos := TP; JM^.TxtPos := TP;
End; End;
@ -1797,7 +1831,9 @@ Var
LockError: Word; LockError: Word;
Begin Begin
LockError := 0; LockError := 0;
If JM^.LockCount > 0 Then Dec(JM^.LockCount); If JM^.LockCount > 0 Then Dec(JM^.LockCount);
If JM^.LockCount = 0 Then Begin If JM^.LockCount = 0 Then Begin
If LockError = 0 Then Begin If LockError = 0 Then Begin
// LockError := UnLockFile(JM^.HdrFile, 0, 1); // LockError := UnLockFile(JM^.HdrFile, 0, 1);
@ -1811,6 +1847,7 @@ Begin
LockError := IoResult; LockError := IoResult;
End; End;
End; End;
UnLockMsgBase := (LockError = 0); UnLockMsgBase := (LockError = 0);
End; End;
@ -1829,10 +1866,13 @@ End;
Function TMsgBaseJAM.ReReadIdx(Var IdxLoc : LongInt) : Word; Function TMsgBaseJAM.ReReadIdx(Var IdxLoc : LongInt) : Word;
Begin Begin
ReReadIdx := 0; ReReadIdx := 0;
IdxLoc := JM^.CurrMsgNum - JM^.BaseHdr.BaseMsgNum; IdxLoc := JM^.CurrMsgNum - JM^.BaseHdr.BaseMsgNum;
If ((IdxLoc < JM^.IdxStart) OR (IdxLoc >= (JM^.IdxStart+JM^.IdxRead))) Then Begin
If ((IdxLoc < JM^.IdxStart) OR (IdxLoc >= (JM^.IdxStart + JM^.IdxRead))) Then Begin
JM^.IdxStart := IdxLoc - 30; JM^.IdxStart := IdxLoc - 30;
If JM^.IdxStart < 0 Then JM^.IdxStart := 0; If JM^.IdxStart < 0 Then JM^.IdxStart := 0;
ReReadIdx := ReadIdx; ReReadIdx := ReadIdx;
End; End;
End; End;

364
mystic/bbs_msgbase_squish.pas
View File

@ -135,7 +135,6 @@ Type
End; End;
Type Type
PMsgBaseSquish = ^TMsgBaseSquish; PMsgBaseSquish = ^TMsgBaseSquish;
TMsgBaseSquish = Object(TMsgBaseAbs) TMsgBaseSquish = Object(TMsgBaseAbs)
SqInfo : ^SqInfoType; SqInfo : ^SqInfoType;
@ -247,13 +246,13 @@ Type
Procedure MsgStartUp; Virtual; {Set up message} Procedure MsgStartUp; Virtual; {Set up message}
Procedure MsgTxtStartUp; Virtual; {Set up for msg text} Procedure MsgTxtStartUp; Virtual; {Set up for msg text}
Procedure SetMailType(MT: MsgMailType); Virtual; {Set message base type} Procedure SetMailType(MT: MsgMailType); Virtual; {Set message base type}
Function GetSubArea: Word; Virtual; {Get sub area number} // Function GetSubArea: Word; Virtual; {Get sub area number}
Procedure ReWriteHdr; Virtual; {Rewrite msg header after changes} Procedure ReWriteHdr; Virtual; {Rewrite msg header after changes}
Procedure DeleteMsg; Virtual; {Delete current message} Procedure DeleteMsg; Virtual; {Delete current message}
Procedure LoadFree; Virtual; {Load freelist into memory} Procedure LoadFree; Virtual; {Load freelist into memory}
Function NumberOfMsgs: LongInt; Virtual; {Number of messages} Function NumberOfMsgs: LongInt; Virtual; {Number of messages}
Procedure SetEcho(ES: Boolean); Virtual; {Set echo status} 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} Function GetLastRead(UNum: LongInt): LongInt; Virtual; {Get last read for user num}
Procedure SetLastRead(UNum: LongInt; LR: LongInt); Virtual; {Set last read} Procedure SetLastRead(UNum: LongInt; LR: LongInt); Virtual; {Set last read}
Function GetMsgLoc: LongInt; Virtual; {To allow reseeking to message} Function GetMsgLoc: LongInt; Virtual; {To allow reseeking to message}
@ -329,48 +328,53 @@ End;
Procedure TMsgBaseSquish.SetMsgPath(FN: String); Procedure TMsgBaseSquish.SetMsgPath(FN: String);
Begin Begin
SqInfo^.FN := FExpand(FN); SqInfo^.FN := FExpand(FN);
If Pos('.', SqInfo^.FN) > 0 Then
SqInfo^.FN := Copy(SqInfo^.FN,1,Pos('.', SqInfo^.FN) - 1); If Pos('.', SqInfo^.FN) > 0 Then
SqInfo^.FN := Copy(SqInfo^.FN,1,Pos('.', SqInfo^.FN) - 1);
End; End;
Function TMsgBaseSquish.OpenMsgBase: Boolean; Function TMsgBaseSquish.OpenMsgBase: Boolean;
Begin Begin
If SqiOpen Then Begin If SqiOpen Then Begin
OpenMsgBase := SqdOpen; OpenMsgBase := SqdOpen;
ReadIdx;
End Else ReadIdx;
OpenMsgBase := False; End Else
OpenMsgBase := False;
End; End;
Function TMsgBaseSquish.SqdOpen: Boolean; Function TMsgBaseSquish.SqdOpen: Boolean;
Var Var
NumRead: LongInt; NumRead: LongInt;
Begin Begin
If Not SqInfo^.SqdOpened Then Begin If Not SqInfo^.SqdOpened Then Begin
Assign(SqInfo^.SqdFile, SqInfo^.FN + '.sqd');
FileMode := 66; {ReadWrite + DenyNone} Assign(SqInfo^.SqdFile, SqInfo^.FN + '.sqd');
If Not ioReset(SqInfo^.SqdFile, 1, fmreadwrite + fmdenynone) Then
SqdOpen := False FileMode := 66; {ReadWrite + DenyNone}
Else Begin
SqInfo^.SqdOpened := True; If Not ioReset(SqInfo^.SqdFile, 1, fmreadwrite + fmdenynone) Then
SqdOpen := True; SqdOpen := False
If Not ioBlockRead(SqInfo^.SqdFile, SqInfo^.SqBase, 2, NumRead) Then Else Begin
SqdOpen := False SqInfo^.SqdOpened := True;
Else Begin SqdOpen := True;
If SqInfo^.SqBase.Len = 0 Then If Not ioBlockRead(SqInfo^.SqdFile, SqInfo^.SqBase, 2, NumRead) Then
SqInfo^.SqBase.Len := SqBSize; SqdOpen := False
If SqInfo^.SqBase.Len > (SizeOf(SqBaseType) + 100) Then Else Begin
SqdOpen := False If SqInfo^.SqBase.Len = 0 Then
Else Begin SqInfo^.SqBase.Len := SqBSize;
SqBSize := SqInfo^.SqBase.Len; If SqInfo^.SqBase.Len > (SizeOf(SqBaseType) + 100) Then
ReadBase; SqdOpen := False
End; Else Begin
End; SqBSize := SqInfo^.SqBase.Len;
End; ReadBase;
End Else End;
SqdOpen := True; End;
End; End;
End Else
SqdOpen := True;
End;
Function TMsgBaseSquish.SqiOpen: Boolean; Function TMsgBaseSquish.SqiOpen: Boolean;
Begin Begin
@ -391,18 +395,21 @@ Procedure TMsgBaseSquish.CloseMsgBase;
Begin Begin
SqdClose; SqdClose;
SqiClose; SqiClose;
FileMode := fmReadWrite + fmDenyNone; { shouldn't be needed... }
FileMode := fmRWDN; { shouldn't be needed... }
End; End;
Function TMsgBaseSquish.CreateMsgBase(MaxMsg: Word; MaxDays: Word): Boolean; Function TMsgBaseSquish.CreateMsgBase(MaxMsg: Word; MaxDays: Word): Boolean;
Begin Begin
If Not SqInfo^.SqdOpened Then Begin If Not SqInfo^.SqdOpened Then Begin
FillChar(SqInfo^.SqBase, SizeOf(SqInfo^.SqBase), 0); FillChar(SqInfo^.SqBase, SizeOf(SqInfo^.SqBase), 0);
SqInfo^.SqBase.Len := 256; SqInfo^.SqBase.Len := 256;
SqInfo^.SqBase.SqHdrSize := SqFSize; SqInfo^.SqBase.SqHdrSize := SqFSize;
SqInfo^.SqBase.UID := 1; SqInfo^.SqBase.UID := 1;
SqInfo^.SqBase.NumMsg := 0; SqInfo^.SqBase.NumMsg := 0;
SqInfo^.SqBase.Base := SqInfo^.FN; SqInfo^.SqBase.Base := SqInfo^.FN;
Str2Az(SqInfo^.FN, 78, SqInfo^.SqBase.Base); Str2Az(SqInfo^.FN, 78, SqInfo^.SqBase.Base);
SqInfo^.SqBase.MaxMsg := MaxMsg; SqInfo^.SqBase.MaxMsg := MaxMsg;
@ -410,8 +417,9 @@ Begin
SqInfo^.SqBase.EndFrame := SqInfo^.SqBase.Len; SqInfo^.SqBase.EndFrame := SqInfo^.SqBase.Len;
CreateMsgBase := (SaveFile(SqInfo^.FN + '.sqd', SqInfo^.SqBase, SqInfo^.SqBase.Len) = 0); CreateMsgBase := (SaveFile(SqInfo^.FN + '.sqd', SqInfo^.SqBase, SqInfo^.SqBase.Len) = 0);
If SaveFile(SqInfo^.FN + '.sqi', SqInfo^.SqBase, 0) = 0 Then;
If SaveFile(SqInfo^.FN + '.sql', SqInfo^.SqBase, 0) = 0 Then; SaveFile (SqInfo^.FN + '.sqi', SqInfo^.SqBase, 0);
SaveFile (SqInfo^.FN + '.sql', SqInfo^.SqBase, 0);
End Else End Else
CreateMsgBase := False; CreateMsgBase := False;
End; End;
@ -424,7 +432,9 @@ End;
Procedure TMsgBaseSquish.SqdClose; Procedure TMsgBaseSquish.SqdClose;
Begin Begin
If SqInfo^.SqdOpened Then Close(SqInfo^.SqdFile); If SqInfo^.SqdOpened Then Close(SqInfo^.SqdFile);
If IOResult <> 0 Then; If IOResult <> 0 Then;
SqInfo^.SqdOpened := False; SqInfo^.SqdOpened := False;
End; End;
@ -494,153 +504,165 @@ End;
Function TMsgBaseSquish.GetFrom: String; {Get message from} Function TMsgBaseSquish.GetFrom: String; {Get message from}
Begin Begin
GetFrom := strWide2Str(SqInfo^.MsgHdr.MsgFrom, 35); GetFrom := strWide2Str(SqInfo^.MsgHdr.MsgFrom, 35);
End; End;
Function TMsgBaseSquish.GetTo: String; {Get message to} Function TMsgBaseSquish.GetTo: String; {Get message to}
Begin Begin
GetTo := strWide2Str(SqInfo^.MsgHdr.MsgTo, 35); GetTo := strWide2Str(SqInfo^.MsgHdr.MsgTo, 35);
End; End;
Function TMsgBaseSquish.GetSubj: String; {Get message subject} Function TMsgBaseSquish.GetSubj: String; {Get message subject}
Begin Begin
GetSubj := strWide2Str(SqInfo^.MsgHdr.Subj, 72); GetSubj := strWide2Str(SqInfo^.MsgHdr.Subj, 72);
End; End;
Function TMsgBaseSquish.GetTextLen: LongInt; {Get text length} Function TMsgBaseSquish.GetTextLen: LongInt; {Get text length}
Begin Begin
{ GetTextLen := SqInfo^.TxtCtr;} { GetTextLen := SqInfo^.TxtCtr;}
GetTextLen := SqInfo^.Frame.MsgLength - 320; GetTextLen := SqInfo^.Frame.MsgLength - 320;
End; End;
Procedure TMsgBaseSquish.SetFrom(Str: String); {Set message from} Procedure TMsgBaseSquish.SetFrom(Str: String); {Set message from}
Begin Begin
Str2Az(Str, 35, SqInfo^.MsgHdr.MsgFrom); Str2Az(Str, 35, SqInfo^.MsgHdr.MsgFrom);
End; End;
Procedure TMsgBaseSquish.SetTo(Str: String); {Set message to} Procedure TMsgBaseSquish.SetTo(Str: String); {Set message to}
Begin Begin
Str2Az(Str,35, SqInfo^.MsgHdr.MsgTo); Str2Az(Str,35, SqInfo^.MsgHdr.MsgTo);
End; End;
Procedure TMsgBaseSquish.SetSubj(Str: String); {Set message subject} Procedure TMsgBaseSquish.SetSubj(Str: String); {Set message subject}
Begin Begin
Str2Az(Str,72, SqInfo^.MSgHdr.Subj); Str2Az(Str,72, SqInfo^.MSgHdr.Subj);
End; End;
Function TMsgBaseSquish.GetDate: String; {Get message date mm-dd-yy} Function TMsgBaseSquish.GetDate: String; {Get message date mm-dd-yy}
Var Var
TmpDate: LongInt; TmpDate: LongInt;
Begin Begin
TmpDate := (SqInfo^.MsgHdr.DateWritten shr 16) + TmpDate := (SqInfo^.MsgHdr.DateWritten shr 16) + ((SqInfo^.MsgHdr.DateWritten and $ffff) shl 16);
((SqInfo^.MsgHdr.DateWritten and $ffff) shl 16); GetDate := DateDos2Str(TmpDate, 1);
GetDate := DateDos2Str(TmpDate, 1);
End; End;
Function TMsgBaseSquish.GetTime: String; {Get message time hh:mm} Function TMsgBaseSquish.GetTime: String; {Get message time hh:mm}
Var Var
TmpDate: LongInt; TmpDate: LongInt;
Begin Begin
TmpDate := (SqInfo^.MsgHdr.DateWritten shr 16) + TmpDate := (SqInfo^.MsgHdr.DateWritten shr 16) + ((SqInfo^.MsgHdr.DateWritten and $ffff) shl 16);
((SqInfo^.MsgHdr.DateWritten and $ffff) shl 16); GetTime := TimeDos2Str(TmpDate, False);
GetTime := TimeDos2Str(TmpDate, False);
End; End;
Procedure TMsgBaseSquish.SetDate(Str: String); Procedure TMsgBaseSquish.SetDate(Str: String);
Begin Begin
SqInfo^.StrDate := Copy(Str,1,8); SqInfo^.StrDate := Copy(Str,1,8);
End; End;
Procedure TMsgBaseSquish.SetTime(Str: String); Procedure TMsgBaseSquish.SetTime(Str: String);
Begin Begin
SqInfo^.StrTime := Copy(Str,1,8); SqInfo^.StrTime := Copy(Str,1,8);
End; End;
Procedure TMsgBaseSquish.GetOrig(Var Addr: RecEchoMailAddr); Procedure TMsgBaseSquish.GetOrig(Var Addr: RecEchoMailAddr);
Begin Begin
Addr := SqInfo^.MsgHdr.Orig; Addr := SqInfo^.MsgHdr.Orig;
End; End;
Procedure TMsgBaseSquish.SetOrig(Var Addr: RecEchoMailAddr); Procedure TMsgBaseSquish.SetOrig(Var Addr: RecEchoMailAddr);
Begin Begin
SqInfo^.MsgHdr.Orig := Addr; SqInfo^.MsgHdr.Orig := Addr;
End; End;
Procedure TMsgBaseSquish.GetDest(Var Addr: RecEchoMailAddr); Procedure TMsgBaseSquish.GetDest(Var Addr: RecEchoMailAddr);
Begin Begin
Addr := SqInfo^.MsgHdr.Dest; Addr := SqInfo^.MsgHdr.Dest;
End; End;
Procedure TMsgBaseSquish.SetDest(Var Addr: RecEchoMailAddr); Procedure TMsgBaseSquish.SetDest(Var Addr: RecEchoMailAddr);
Begin Begin
SqInfo^.MsgHdr.Dest := Addr; SqInfo^.MsgHdr.Dest := Addr;
End; End;
Function TMsgBaseSquish.SqHashName(Name: String): LongInt; Function TMsgBaseSquish.SqHashName(Name: String): LongInt;
Var Var
Hash : LongInt; Hash : LongInt;
Tmp : LongInt; Tmp : LongInt;
Counter : Word; Counter : Word;
Begin Begin
Hash := 0; Hash := 0;
Counter := 1; Counter := 1;
While Counter <= Length(Name) Do Begin
Hash := (Hash shl 4) + Ord(LoCase(Name[Counter])); While Counter <= Length(Name) Do Begin
Tmp := Hash and $F0000000;
If (Tmp <> 0) Then Hash := (Hash or (Tmp shr 24)) or Tmp; Hash := (Hash shl 4) + Ord(LoCase(Name[Counter]));
Inc(Counter); Tmp := Hash and $F0000000;
End;
SqHashName := Hash and $7fffffff; If (Tmp <> 0) Then Hash := (Hash or (Tmp shr 24)) or Tmp;
Inc (Counter);
End;
SqHashName := Hash and $7fffffff;
End; End;
Procedure TMsgBaseSquish.ReadFrame(FPos: LongInt); {Read frame at FPos} Procedure TMsgBaseSquish.ReadFrame(FPos: LongInt); {Read frame at FPos}
Begin Begin
ReadVarFrame(SqInfo^.Frame, FPos); ReadVarFrame (SqInfo^.Frame, FPos);
End; End;
Procedure TMsgBaseSquish.ReadVarFrame(Var Frame: SqFrameHdrType; FPos: LongInt); {Read frame at FPos} Procedure TMsgBaseSquish.ReadVarFrame(Var Frame: SqFrameHdrType; FPos: LongInt); {Read frame at FPos}
Var Var
NumRead : LongInt; NumRead : LongInt;
Begin Begin
Seek(SqInfo^.SqdFile, FPos); Seek (SqInfo^.SqdFile, FPos);
SqInfo^.Error := IoResult;
If SqInfo^.Error = 0 Then Begin SqInfo^.Error := IoResult;
If Not ioBlockRead(SqInfo^.SqdFile, Frame, SizeOf(SqFrameHdrType), NumRead) Then
SqInfo^.Error := ioCode; If SqInfo^.Error = 0 Then Begin
End; If Not ioBlockRead (SqInfo^.SqdFile, Frame, SizeOf(SqFrameHdrType), NumRead) Then
SqInfo^.Error := ioCode;
End;
End; End;
Procedure TMsgBaseSquish.WriteFrame(FPos: LongInt); {Read frame at FPos} Procedure TMsgBaseSquish.WriteFrame(FPos: LongInt); {Read frame at FPos}
Begin Begin
WriteVarFrame(SqInfo^.Frame, FPos); WriteVarFrame(SqInfo^.Frame, FPos);
End; End;
Procedure TMsgBaseSquish.WriteVarFrame(Var Frame: SqFrameHdrType; FPos: LongInt); {Write frame at FPos} Procedure TMsgBaseSquish.WriteVarFrame(Var Frame: SqFrameHdrType; FPos: LongInt); {Write frame at FPos}
Var Var
Res : LongInt; Res : LongInt;
Begin Begin
Seek(SqInfo^.SqdFile, FPos); Seek (SqInfo^.SqdFile, FPos);
SqInfo^.Error := IoResult;
If SqInfo^.Error = 0 Then Begin SqInfo^.Error := IoResult;
If Not ioBlockWrite(SqInfo^.SqdFile, Frame, SizeOf(SqFrameHdrType), Res) Then
SqInfo^.Error := ioCode; If SqInfo^.Error = 0 Then Begin
End; If Not ioBlockWrite(SqInfo^.SqdFile, Frame, SizeOf(SqFrameHdrType), Res) Then
SqInfo^.Error := ioCode;
End;
End; End;
Procedure TMsgBaseSquish.UnlinkFrame(Var Frame: SqFrameHdrType); Procedure TMsgBaseSquish.UnlinkFrame(Var Frame: SqFrameHdrType);
Var Var
TmpFrame: SqFrameHdrType; TmpFrame: SqFrameHdrType;
Begin Begin
If Frame.PrevFrame <> 0 Then Begin If Frame.PrevFrame <> 0 Then Begin
ReadVarFrame(TmpFrame, Frame.PrevFrame); ReadVarFrame(TmpFrame, Frame.PrevFrame);
TmpFrame.NextFrame := Frame.NextFrame;
WriteVarFrame(TmpFrame, Frame.PrevFrame); TmpFrame.NextFrame := Frame.NextFrame;
End;
If Frame.NextFrame <> 0 Then Begin WriteVarFrame(TmpFrame, Frame.PrevFrame);
ReadVarFrame(TmpFrame, Frame.NextFrame); End;
TmpFrame.PrevFrame := Frame.PrevFrame;
WriteVarFrame(TmpFrame, Frame.NextFrame); If Frame.NextFrame <> 0 Then Begin
End; ReadVarFrame(TmpFrame, Frame.NextFrame);
TmpFrame.PrevFrame := Frame.PrevFrame;
WriteVarFrame(TmpFrame, Frame.NextFrame);
End;
End; End;
Procedure TMsgBaseSquish.LoadFree; Procedure TMsgBaseSquish.LoadFree;
@ -649,91 +671,95 @@ Var
TmpFrame : SqFrameHdrType; TmpFrame : SqFrameHdrType;
TmpPos : LongInt; TmpPos : LongInt;
Begin Begin
For i := 1 to MaxFree Do Begin For i := 1 to MaxFree Do Begin
FreeArray^[i].FreePos := 0; FreeArray^[i].FreePos := 0;
FreeArray^[i].FreeSize := 0; FreeArray^[i].FreeSize := 0;
End; End;
SqInfo^.FreeLoaded := True;
i := 0; SqInfo^.FreeLoaded := True;
TmpPos := SqInfo^.SqBase.FirstFree; i := 0;
While ((TmpPos <> 0) and (i < MaxFree)) Do Begin TmpPos := SqInfo^.SqBase.FirstFree;
ReadVarFrame(TmpFrame, TmpPos);
Inc(i); While ((TmpPos <> 0) and (i < MaxFree)) Do Begin
FreeArray^[i].FreeSize := TmpFrame.FrameLength; ReadVarFrame(TmpFrame, TmpPos);
FreeArray^[i].FreePos := TmpPos; Inc(i);
TmpPos := TmpFrame.NextFrame; FreeArray^[i].FreeSize := TmpFrame.FrameLength;
End; FreeArray^[i].FreePos := TmpPos;
SqInfo^.HighestFree := i; TmpPos := TmpFrame.NextFrame;
End;
SqInfo^.HighestFree := i;
End; End;
Procedure TMsgBaseSquish.FindFrame(Var FL: LongInt; Var FramePos: LongInt); Procedure TMsgBaseSquish.FindFrame (Var FL: LongInt; Var FramePos: LongInt);
Var Var
TmpFrame : SqFrameHdrType; TmpFrame : SqFrameHdrType;
BestFoundPos : LongInt; BestFoundPos : LongInt;
BestFoundSize : LongInt; BestFoundSize : LongInt;
BestIdx : Word; BestIdx : Word;
i : Word; i : Word;
Begin Begin
If Not SqInfo^.FreeLoaded Then LoadFree; If Not SqInfo^.FreeLoaded Then LoadFree;
BestFoundPos := 0; BestFoundPos := 0;
BestFoundSize := 0; BestFoundSize := 0;
For i := 1 to SqInfo^.HighestFree Do Begin For i := 1 to SqInfo^.HighestFree Do Begin
If (FreeArray^[i].FreeSize > FL) Then Begin If (FreeArray^[i].FreeSize > FL) Then Begin
If ((BestFoundSize = 0) or (FreeArray^[i].FreeSize < BestFoundSize)) Then Begin If ((BestFoundSize = 0) or (FreeArray^[i].FreeSize < BestFoundSize)) Then Begin
BestFoundSize := FreeArray^[i].FreeSize; BestFoundSize := FreeArray^[i].FreeSize;
BestFoundPos := FreeArray^[i].FreePos; BestFoundPos := FreeArray^[i].FreePos;
BestIdx := i; BestIdx := i;
End; End;
End End
End; End;
FramePos := BestFoundPos; FramePos := BestFoundPos;
If FramePos <> 0 Then Begin If FramePos <> 0 Then Begin
ReadVarFrame(TmpFrame, FramePos); ReadVarFrame(TmpFrame, FramePos);
FreeArray^[BestIdx].FreePos := 0;
FreeArray^[BestIdx].FreeSize := 0;
End;
If FramePos = 0 Then Begin FreeArray^[BestIdx].FreePos := 0;
FL := 0; FreeArray^[BestIdx].FreeSize := 0;
FramePos := SqInfo^.SqBase.EndFrame; End;
End Else Begin
UnLinkFrame(TmpFrame);
If TmpFrame.PrevFrame = 0 Then SqInfo^.SqBase.FirstFree := TmpFrame.NextFrame; If FramePos = 0 Then Begin
If TmpFrame.NextFrame = 0 Then SqInfo^.SqBase.LastFree := TmpFrame.PrevFrame; FL := 0;
FramePos := SqInfo^.SqBase.EndFrame;
End Else Begin
UnLinkFrame(TmpFrame);
FL := TmpFrame.FrameLength; If TmpFrame.PrevFrame = 0 Then SqInfo^.SqBase.FirstFree := TmpFrame.NextFrame;
End; If TmpFrame.NextFrame = 0 Then SqInfo^.SqBase.LastFree := TmpFrame.PrevFrame;
FL := TmpFrame.FrameLength;
End;
End; End;
Procedure TMsgBaseSquish.LinkFrameNext(Var Frame: SqFrameHdrType; OtherFrame: LongInt; FramePos: LongInt); Procedure TMsgBaseSquish.LinkFrameNext(Var Frame: SqFrameHdrType; OtherFrame: LongInt; FramePos: LongInt);
Var Var
TmpFrame: SqFrameHdrType; TmpFrame: SqFrameHdrType;
Begin Begin
If OtherFrame <> 0 Then Begin If OtherFrame <> 0 Then Begin
ReadVarFrame(TmpFrame, OtherFrame); ReadVarFrame (TmpFrame, OtherFrame);
TmpFrame.NextFrame := FramePos; TmpFrame.NextFrame := FramePos;
Frame.PrevFrame := OtherFrame; Frame.PrevFrame := OtherFrame;
WriteVarFrame(TmpFrame, OtherFrame); WriteVarFrame (TmpFrame, OtherFrame);
End; End;
End; End;
Procedure TMsgBaseSquish.KillMsg(MsgNum: LongInt); Procedure TMsgBaseSquish.KillMsg(MsgNum: LongInt);
Var Var
i: Word; i: Word;
KillPos: LongInt; KillPos: LongInt;
IndexPos: LongInt; IndexPos: LongInt;
KillFrame: SqFrameHdrType; KillFrame: SqFrameHdrType;
TmpFrame: SqFrameHdrType; TmpFrame: SqFrameHdrType;
CurrMove: LongInt; CurrMove: LongInt;
AlreadyLocked: Boolean; AlreadyLocked: Boolean;
FreeCtr: Word; FreeCtr: Word;
Begin Begin
AlreadyLocked := SqInfo^.Locked; AlreadyLocked := SqInfo^.Locked;
If Not AlreadyLocked Then If Not AlreadyLocked Then
@ -1301,10 +1327,10 @@ Begin
IsPriv := ((SqInfo^.MsgHdr.Attr and SqMsgPriv) <> 0); IsPriv := ((SqInfo^.MsgHdr.Attr and SqMsgPriv) <> 0);
End; End;
Function TMsgBaseSquish.IsEchoed: Boolean; //Function TMsgBaseSquish.IsEchoed: Boolean;
Begin //Begin
IsEchoed := ((SqInfo^.MsgHdr.Attr and SqMsgScanned) = 0); // IsEchoed := ((SqInfo^.MsgHdr.Attr and SqMsgScanned) = 0);
End; //End;
Function TMsgBaseSquish.IsDeleted: Boolean; {Is current msg deleted} Function TMsgBaseSquish.IsDeleted: Boolean; {Is current msg deleted}
Begin Begin
@ -1423,10 +1449,10 @@ Procedure TMsgBaseSquish.SetMailType(MT: MsgMailType);
Begin Begin
End; End;
Function TMsgBaseSquish.GetSubArea: Word; //Function TMsgBaseSquish.GetSubArea: Word;
Begin //Begin
GetSubArea := 0; // GetSubArea := 0;
End; //End;
Procedure TMsgBaseSquish.ReWriteHdr; Procedure TMsgBaseSquish.ReWriteHdr;
Var Var

2
mystic/mis.pas
View File

@ -256,6 +256,8 @@ Begin
Client := TIOSocket.Create; Client := TIOSocket.Create;
Client.FTelnetClient := True;
If Not Client.Connect('127.0.0.1', bbsConfig.InetTNPort) Then If Not Client.Connect('127.0.0.1', bbsConfig.InetTNPort) Then
Console.WriteLine('Unable to connect') Console.WriteLine('Unable to connect')
Else Begin Else Begin

2
mystic/mis_client_nntp.pas
View File

@ -104,7 +104,7 @@ Var
NewCmd : String; NewCmd : String;
NewData : String; NewData : String;
Begin Begin
NewCmd := strWordGet(1, Data, ' '); NewCmd := strUpper(strWordGet(1, Data, ' '));
NewData := Copy(Data, Pos(' ', Data) + 1, 255); NewData := Copy(Data, Pos(' ', Data) + 1, 255);
If NewCmd = 'USER' Then Begin If NewCmd = 'USER' Then Begin

277
mystic/mpl_common.pas
View File

@ -152,146 +152,149 @@ Begin
0 : Begin 0 : Begin
IW := 0; IW := 0;
AddProc ({$IFDEF MPLPARSER} 'write', {$ENDIF} 's', iNone); // 0 AddProc ({$IFDEF MPLPARSER} 'write', {$ENDIF} 's', iNone); // 0
AddProc ({$IFDEF MPLPARSER} 'writeln', {$ENDIF} 's', iNone); // 1 AddProc ({$IFDEF MPLPARSER} 'writeln', {$ENDIF} 's', iNone); // 1
AddProc ({$IFDEF MPLPARSER} 'clrscr', {$ENDIF} '', iNone); // 2 AddProc ({$IFDEF MPLPARSER} 'clrscr', {$ENDIF} '', iNone); // 2
AddProc ({$IFDEF MPLPARSER} 'clreol', {$ENDIF} '', iNone); // 3 AddProc ({$IFDEF MPLPARSER} 'clreol', {$ENDIF} '', iNone); // 3
AddProc ({$IFDEF MPLPARSER} 'gotoxy', {$ENDIF} 'bb', iNone); // 4 AddProc ({$IFDEF MPLPARSER} 'gotoxy', {$ENDIF} 'bb', iNone); // 4
AddProc ({$IFDEF MPLPARSER} 'wherex', {$ENDIF} '', iByte); // 5 AddProc ({$IFDEF MPLPARSER} 'wherex', {$ENDIF} '', iByte); // 5
AddProc ({$IFDEF MPLPARSER} 'wherey', {$ENDIF} '', iByte); // 6 AddProc ({$IFDEF MPLPARSER} 'wherey', {$ENDIF} '', iByte); // 6
AddProc ({$IFDEF MPLPARSER} 'readkey', {$ENDIF} '', iString); // 7 AddProc ({$IFDEF MPLPARSER} 'readkey', {$ENDIF} '', iString); // 7
AddProc ({$IFDEF MPLPARSER} 'delay', {$ENDIF} 'l', iNone); // 8 AddProc ({$IFDEF MPLPARSER} 'delay', {$ENDIF} 'l', iNone); // 8
AddProc ({$IFDEF MPLPARSER} 'random', {$ENDIF} 'l', iLongInt); // 9 AddProc ({$IFDEF MPLPARSER} 'random', {$ENDIF} 'l', iLongInt); // 9
AddProc ({$IFDEF MPLPARSER} 'chr', {$ENDIF} 'b', iChar); // 10 AddProc ({$IFDEF MPLPARSER} 'chr', {$ENDIF} 'b', iChar); // 10
AddProc ({$IFDEF MPLPARSER} 'ord', {$ENDIF} 's', iByte); // 11 AddProc ({$IFDEF MPLPARSER} 'ord', {$ENDIF} 's', iByte); // 11
AddProc ({$IFDEF MPLPARSER} 'copy', {$ENDIF} 'sll', iString); // 12 AddProc ({$IFDEF MPLPARSER} 'copy', {$ENDIF} 'sll', iString); // 12
AddProc ({$IFDEF MPLPARSER} 'delete', {$ENDIF} 'Sll', iNone); // 13 AddProc ({$IFDEF MPLPARSER} 'delete', {$ENDIF} 'Sll', iNone); // 13
AddProc ({$IFDEF MPLPARSER} 'insert', {$ENDIF} 'sSl', iNone); // 14 AddProc ({$IFDEF MPLPARSER} 'insert', {$ENDIF} 'sSl', iNone); // 14
AddProc ({$IFDEF MPLPARSER} 'length', {$ENDIF} 's', iLongInt); // 15 AddProc ({$IFDEF MPLPARSER} 'length', {$ENDIF} 's', iLongInt); // 15
AddProc ({$IFDEF MPLPARSER} 'odd', {$ENDIF} 'l', iBool); // 16 AddProc ({$IFDEF MPLPARSER} 'odd', {$ENDIF} 'l', iBool); // 16
AddProc ({$IFDEF MPLPARSER} 'pos', {$ENDIF} 'ss', iLongInt); // 17 AddProc ({$IFDEF MPLPARSER} 'pos', {$ENDIF} 'ss', iLongInt); // 17
AddProc ({$IFDEF MPLPARSER} 'keypressed', {$ENDIF} '', iBool); // 18 AddProc ({$IFDEF MPLPARSER} 'keypressed', {$ENDIF} '', iBool); // 18
AddProc ({$IFDEF MPLPARSER} 'padrt', {$ENDIF} 'sbs', iString); // 19 AddProc ({$IFDEF MPLPARSER} 'padrt', {$ENDIF} 'sbs', iString); // 19
AddProc ({$IFDEF MPLPARSER} 'padlt', {$ENDIF} 'sbs', iString); // 20 AddProc ({$IFDEF MPLPARSER} 'padlt', {$ENDIF} 'sbs', iString); // 20
AddProc ({$IFDEF MPLPARSER} 'padct', {$ENDIF} 'sbs', iString); // 21 AddProc ({$IFDEF MPLPARSER} 'padct', {$ENDIF} 'sbs', iString); // 21
AddProc ({$IFDEF MPLPARSER} 'upper', {$ENDIF} 's', iString); // 22 AddProc ({$IFDEF MPLPARSER} 'upper', {$ENDIF} 's', iString); // 22
AddProc ({$IFDEF MPLPARSER} 'lower', {$ENDIF} 's', iString); // 23 AddProc ({$IFDEF MPLPARSER} 'lower', {$ENDIF} 's', iString); // 23
AddProc ({$IFDEF MPLPARSER} 'strrep', {$ENDIF} 'sb', iString); // 24 AddProc ({$IFDEF MPLPARSER} 'strrep', {$ENDIF} 'sb', iString); // 24
AddProc ({$IFDEF MPLPARSER} 'strcomma', {$ENDIF} 'l', iString); // 25 AddProc ({$IFDEF MPLPARSER} 'strcomma', {$ENDIF} 'l', iString); // 25
AddProc ({$IFDEF MPLPARSER} 'int2str', {$ENDIF} 'l', iString); // 26 AddProc ({$IFDEF MPLPARSER} 'int2str', {$ENDIF} 'l', iString); // 26
AddProc ({$IFDEF MPLPARSER} 'str2int', {$ENDIF} 's', iLongInt); // 27 AddProc ({$IFDEF MPLPARSER} 'str2int', {$ENDIF} 's', iLongInt); // 27
AddProc ({$IFDEF MPLPARSER} 'int2hex', {$ENDIF} 'l', iString); // 28 AddProc ({$IFDEF MPLPARSER} 'int2hex', {$ENDIF} 'l', iString); // 28
AddProc ({$IFDEF MPLPARSER} 'wordget', {$ENDIF} 'bss', iString); // 29 AddProc ({$IFDEF MPLPARSER} 'wordget', {$ENDIF} 'bss', iString); // 29
AddProc ({$IFDEF MPLPARSER} 'wordpos', {$ENDIF} 'bss', iByte); // 30 AddProc ({$IFDEF MPLPARSER} 'wordpos', {$ENDIF} 'bss', iByte); // 30
AddProc ({$IFDEF MPLPARSER} 'wordcount', {$ENDIF} 'ss', iByte); // 31 AddProc ({$IFDEF MPLPARSER} 'wordcount', {$ENDIF} 'ss', iByte); // 31
AddProc ({$IFDEF MPLPARSER} 'stripl', {$ENDIF} 'ss', iString); // 32 AddProc ({$IFDEF MPLPARSER} 'stripl', {$ENDIF} 'ss', iString); // 32
AddProc ({$IFDEF MPLPARSER} 'stripr', {$ENDIF} 'ss', iString); // 33 AddProc ({$IFDEF MPLPARSER} 'stripr', {$ENDIF} 'ss', iString); // 33
AddProc ({$IFDEF MPLPARSER} 'stripb', {$ENDIF} 'ss', iString); // 34 AddProc ({$IFDEF MPLPARSER} 'stripb', {$ENDIF} 'ss', iString); // 34
AddProc ({$IFDEF MPLPARSER} 'striplow', {$ENDIF} 's', iString); // 35 AddProc ({$IFDEF MPLPARSER} 'striplow', {$ENDIF} 's', iString); // 35
AddProc ({$IFDEF MPLPARSER} 'stripmci', {$ENDIF} 's', iString); // 36 AddProc ({$IFDEF MPLPARSER} 'stripmci', {$ENDIF} 's', iString); // 36
AddProc ({$IFDEF MPLPARSER} 'mcilength', {$ENDIF} 's', iByte); // 37 AddProc ({$IFDEF MPLPARSER} 'mcilength', {$ENDIF} 's', iByte); // 37
AddProc ({$IFDEF MPLPARSER} 'initials', {$ENDIF} 's', iString); // 38 AddProc ({$IFDEF MPLPARSER} 'initials', {$ENDIF} 's', iString); // 38
AddProc ({$IFDEF MPLPARSER} 'strwrap', {$ENDIF} 'SSb', iByte); // 39 AddProc ({$IFDEF MPLPARSER} 'strwrap', {$ENDIF} 'SSb', iByte); // 39
AddProc ({$IFDEF MPLPARSER} 'replace', {$ENDIF} 'sss', iString); // 40 AddProc ({$IFDEF MPLPARSER} 'replace', {$ENDIF} 'sss', iString); // 40
AddProc ({$IFDEF MPLPARSER} 'readenv', {$ENDIF} 's', iString); // 41 AddProc ({$IFDEF MPLPARSER} 'readenv', {$ENDIF} 's', iString); // 41
AddProc ({$IFDEF MPLPARSER} 'fileexist', {$ENDIF} 's', iBool); // 42 AddProc ({$IFDEF MPLPARSER} 'fileexist', {$ENDIF} 's', iBool); // 42
AddProc ({$IFDEF MPLPARSER} 'fileerase', {$ENDIF} 's', iNone); // 43 AddProc ({$IFDEF MPLPARSER} 'fileerase', {$ENDIF} 's', iNone); // 43
AddProc ({$IFDEF MPLPARSER} 'direxist', {$ENDIF} 's', iBool); // 44 AddProc ({$IFDEF MPLPARSER} 'direxist', {$ENDIF} 's', iBool); // 44
AddProc ({$IFDEF MPLPARSER} 'timermin', {$ENDIF} '', iLongInt); // 45 AddProc ({$IFDEF MPLPARSER} 'timermin', {$ENDIF} '', iLongInt); // 45
AddProc ({$IFDEF MPLPARSER} 'timer', {$ENDIF} '', iLongInt); // 46 AddProc ({$IFDEF MPLPARSER} 'timer', {$ENDIF} '', iLongInt); // 46
AddProc ({$IFDEF MPLPARSER} 'datetime', {$ENDIF} '', iLongInt); // 47 AddProc ({$IFDEF MPLPARSER} 'datetime', {$ENDIF} '', iLongInt); // 47
AddProc ({$IFDEF MPLPARSER} 'datejulian', {$ENDIF} '', iLongInt); // 48 AddProc ({$IFDEF MPLPARSER} 'datejulian', {$ENDIF} '', iLongInt); // 48
AddProc ({$IFDEF MPLPARSER} 'datestr', {$ENDIF} 'lb', iString); // 49 AddProc ({$IFDEF MPLPARSER} 'datestr', {$ENDIF} 'lb', iString); // 49
AddProc ({$IFDEF MPLPARSER} 'datestrjulian', {$ENDIF} 'lb', iString); // 50 AddProc ({$IFDEF MPLPARSER} 'datestrjulian', {$ENDIF} 'lb', iString); // 50
AddProc ({$IFDEF MPLPARSER} 'date2dos', {$ENDIF} 's', iLongInt); // 51 AddProc ({$IFDEF MPLPARSER} 'date2dos', {$ENDIF} 's', iLongInt); // 51
AddProc ({$IFDEF MPLPARSER} 'date2julian', {$ENDIF} 's', iLongInt); // 52 AddProc ({$IFDEF MPLPARSER} 'date2julian', {$ENDIF} 's', iLongInt); // 52
AddProc ({$IFDEF MPLPARSER} 'dateg2j', {$ENDIF} 'lllL', iNone); // 53 AddProc ({$IFDEF MPLPARSER} 'dateg2j', {$ENDIF} 'lllL', iNone); // 53
AddProc ({$IFDEF MPLPARSER} 'datej2g', {$ENDIF} 'liii', iNone); // 54 AddProc ({$IFDEF MPLPARSER} 'datej2g', {$ENDIF} 'liii', iNone); // 54
AddProc ({$IFDEF MPLPARSER} 'datevalid', {$ENDIF} 's', iString); // 55 AddProc ({$IFDEF MPLPARSER} 'datevalid', {$ENDIF} 's', iString); // 55
AddProc ({$IFDEF MPLPARSER} 'timestr', {$ENDIF} 'lo', iString); // 56 AddProc ({$IFDEF MPLPARSER} 'timestr', {$ENDIF} 'lo', iString); // 56
AddProc ({$IFDEF MPLPARSER} 'dayofweek', {$ENDIF} 'l', iByte); // 57 AddProc ({$IFDEF MPLPARSER} 'dayofweek', {$ENDIF} 'l', iByte); // 57
AddProc ({$IFDEF MPLPARSER} 'daysago', {$ENDIF} 'l', iLongInt); // 58 AddProc ({$IFDEF MPLPARSER} 'daysago', {$ENDIF} 'l', iLongInt); // 58
AddProc ({$IFDEF MPLPARSER} 'justfile', {$ENDIF} 's', iString); // 59 AddProc ({$IFDEF MPLPARSER} 'justfile', {$ENDIF} 's', iString); // 59
AddProc ({$IFDEF MPLPARSER} 'justfilename', {$ENDIF} 's', iString); // 60 AddProc ({$IFDEF MPLPARSER} 'justfilename', {$ENDIF} 's', iString); // 60
AddProc ({$IFDEF MPLPARSER} 'justfileext', {$ENDIF} 's', iString); // 61 AddProc ({$IFDEF MPLPARSER} 'justfileext', {$ENDIF} 's', iString); // 61
AddProc ({$IFDEF MPLPARSER} 'fassign', {$ENDIF} 'Fsl', iNone); // 62 AddProc ({$IFDEF MPLPARSER} 'fassign', {$ENDIF} 'Fsl', iNone); // 62
AddProc ({$IFDEF MPLPARSER} 'freset', {$ENDIF} 'F', iNone); // 63 AddProc ({$IFDEF MPLPARSER} 'freset', {$ENDIF} 'F', iNone); // 63
AddProc ({$IFDEF MPLPARSER} 'frewrite', {$ENDIF} 'F', iNone); // 64 AddProc ({$IFDEF MPLPARSER} 'frewrite', {$ENDIF} 'F', iNone); // 64
AddProc ({$IFDEF MPLPARSER} 'fclose', {$ENDIF} 'F', iNone); // 65 AddProc ({$IFDEF MPLPARSER} 'fclose', {$ENDIF} 'F', iNone); // 65
AddProc ({$IFDEF MPLPARSER} 'fseek', {$ENDIF} 'Fl', iNone); // 66 AddProc ({$IFDEF MPLPARSER} 'fseek', {$ENDIF} 'Fl', iNone); // 66
AddProc ({$IFDEF MPLPARSER} 'feof', {$ENDIF} 'F', iBool); // 67 AddProc ({$IFDEF MPLPARSER} 'feof', {$ENDIF} 'F', iBool); // 67
AddProc ({$IFDEF MPLPARSER} 'fsize', {$ENDIF} 'F', iLongInt); // 68 AddProc ({$IFDEF MPLPARSER} 'fsize', {$ENDIF} 'F', iLongInt); // 68
AddProc ({$IFDEF MPLPARSER} 'fpos', {$ENDIF} 'F', iLongInt); // 69 AddProc ({$IFDEF MPLPARSER} 'fpos', {$ENDIF} 'F', iLongInt); // 69
AddProc ({$IFDEF MPLPARSER} 'fread', {$ENDIF} 'F*w', iNone); // 70 AddProc ({$IFDEF MPLPARSER} 'fread', {$ENDIF} 'F*w', iNone); // 70
AddProc ({$IFDEF MPLPARSER} 'fwrite', {$ENDIF} 'F*w', iNone); // 71 AddProc ({$IFDEF MPLPARSER} 'fwrite', {$ENDIF} 'F*w', iNone); // 71
AddProc ({$IFDEF MPLPARSER} 'freadln', {$ENDIF} 'FS', iNone); // 72 AddProc ({$IFDEF MPLPARSER} 'freadln', {$ENDIF} 'FS', iNone); // 72
AddProc ({$IFDEF MPLPARSER} 'fwriteln', {$ENDIF} 'Fs', iNone); // 73 AddProc ({$IFDEF MPLPARSER} 'fwriteln', {$ENDIF} 'Fs', iNone); // 73
AddProc ({$IFDEF MPLPARSER} 'pathchar', {$ENDIF} '', iChar); // 74 AddProc ({$IFDEF MPLPARSER} 'pathchar', {$ENDIF} '', iChar); // 74
AddProc ({$IFDEF MPLPARSER} 'bitcheck', {$ENDIF} 'b*', iBool); // 75 AddProc ({$IFDEF MPLPARSER} 'bitcheck', {$ENDIF} 'b*', iBool); // 75
AddProc ({$IFDEF MPLPARSER} 'bittoggle', {$ENDIF} 'b*', iNone); // 76 AddProc ({$IFDEF MPLPARSER} 'bittoggle', {$ENDIF} 'b*', iNone); // 76
AddProc ({$IFDEF MPLPARSER} 'bitset', {$ENDIF} 'b*o', iNone); // 77 AddProc ({$IFDEF MPLPARSER} 'bitset', {$ENDIF} 'b*o', iNone); // 77
AddProc ({$IFDEF MPLPARSER} 'findfirst', {$ENDIF} 'sw', iNone); // 78 AddProc ({$IFDEF MPLPARSER} 'findfirst', {$ENDIF} 'sw', iNone); // 78
AddProc ({$IFDEF MPLPARSER} 'findnext', {$ENDIF} '', iNone); // 79 AddProc ({$IFDEF MPLPARSER} 'findnext', {$ENDIF} '', iNone); // 79
AddProc ({$IFDEF MPLPARSER} 'findclose', {$ENDIF} '', iNone); // 80 AddProc ({$IFDEF MPLPARSER} 'findclose', {$ENDIF} '', iNone); // 80
AddProc ({$IFDEF MPLPARSER} 'justpath', {$ENDIF} 's', iString); // 81 AddProc ({$IFDEF MPLPARSER} 'justpath', {$ENDIF} 's', iString); // 81
AddProc ({$IFDEF MPLPARSER} 'randomize', {$ENDIF} '', iNone); // 82 AddProc ({$IFDEF MPLPARSER} 'randomize', {$ENDIF} '', iNone); // 82
AddProc ({$IFDEF MPLPARSER} 'paramcount', {$ENDIF} '', iByte); // 83 AddProc ({$IFDEF MPLPARSER} 'paramcount', {$ENDIF} '', iByte); // 83
AddProc ({$IFDEF MPLPARSER} 'paramstr', {$ENDIF} 'b', iString); // 84 AddProc ({$IFDEF MPLPARSER} 'paramstr', {$ENDIF} 'b', iString); // 84
AddProc ({$IFDEF MPLPARSER} 'textattr', {$ENDIF} '', iByte); // 85 AddProc ({$IFDEF MPLPARSER} 'textattr', {$ENDIF} '', iByte); // 85
AddProc ({$IFDEF MPLPARSER} 'textcolor', {$ENDIF} 'b', iNone); // 86 AddProc ({$IFDEF MPLPARSER} 'textcolor', {$ENDIF} 'b', iNone); // 86
AddProc ({$IFDEF MPLPARSER} 'addslash', {$ENDIF} 's', iString); // 87 AddProc ({$IFDEF MPLPARSER} 'addslash', {$ENDIF} 's', iString); // 87
AddProc ({$IFDEF MPLPARSER} 'strippipe', {$ENDIF} 's', iString); // 88 AddProc ({$IFDEF MPLPARSER} 'strippipe', {$ENDIF} 's', iString); // 88
AddProc ({$IFDEF MPLPARSER} 'sizeof', {$ENDIF} '*', iLongInt); // 89 AddProc ({$IFDEF MPLPARSER} 'sizeof', {$ENDIF} '*', iLongInt); // 89
AddProc ({$IFDEF MPLPARSER} 'fillchar', {$ENDIF} '*lc', iNone); // 90 AddProc ({$IFDEF MPLPARSER} 'fillchar', {$ENDIF} '*lc', iNone); // 90
AddProc ({$IFDEF MPLPARSER} 'fwriterec', {$ENDIF} 'Fx', iNone); // 91 AddProc ({$IFDEF MPLPARSER} 'fwriterec', {$ENDIF} 'Fx', iNone); // 91
AddProc ({$IFDEF MPLPARSER} 'freadrec', {$ENDIF} 'Fx', iNone); // 92 AddProc ({$IFDEF MPLPARSER} 'freadrec', {$ENDIF} 'Fx', iNone); // 92
IW := 500; // BEGIN BBS-SPECIFIC STUFF IW := 500; // BEGIN BBS-SPECIFIC STUFF
AddProc ({$IFDEF MPLPARSER} 'input', {$ENDIF} 'bbbs', iString); // 500 AddProc ({$IFDEF MPLPARSER} 'input', {$ENDIF} 'bbbs', iString); // 500
AddProc ({$IFDEF MPLPARSER} 'getuser', {$ENDIF} 'l', iBool); // 501 AddProc ({$IFDEF MPLPARSER} 'getuser', {$ENDIF} 'l', iBool); // 501
AddProc ({$IFDEF MPLPARSER} 'onekey', {$ENDIF} 'so', iChar); // 502 AddProc ({$IFDEF MPLPARSER} 'onekey', {$ENDIF} 'so', iChar); // 502
AddProc ({$IFDEF MPLPARSER} 'getthisuser', {$ENDIF} '', iNone); // 503 AddProc ({$IFDEF MPLPARSER} 'getthisuser', {$ENDIF} '', iNone); // 503
AddProc ({$IFDEF MPLPARSER} 'inputyn', {$ENDIF} 's', iBool); // 504 AddProc ({$IFDEF MPLPARSER} 'inputyn', {$ENDIF} 's', iBool); // 504
AddProc ({$IFDEF MPLPARSER} 'inputny', {$ENDIF} 's', iBool); // 505 AddProc ({$IFDEF MPLPARSER} 'inputny', {$ENDIF} 's', iBool); // 505
AddProc ({$IFDEF MPLPARSER} 'dispfile', {$ENDIF} 's', iBool); // 506 AddProc ({$IFDEF MPLPARSER} 'dispfile', {$ENDIF} 's', iBool); // 506
AddProc ({$IFDEF MPLPARSER} 'filecopy', {$ENDIF} 'ss', iBool); // 507 AddProc ({$IFDEF MPLPARSER} 'filecopy', {$ENDIF} 'ss', iBool); // 507
AddProc ({$IFDEF MPLPARSER} 'menucmd', {$ENDIF} 'ss', iNone); // 508 AddProc ({$IFDEF MPLPARSER} 'menucmd', {$ENDIF} 'ss', iNone); // 508
AddProc ({$IFDEF MPLPARSER} 'stuffkey', {$ENDIF} 's', iNone); // 509 AddProc ({$IFDEF MPLPARSER} 'stuffkey', {$ENDIF} 's', iNone); // 509
AddProc ({$IFDEF MPLPARSER} 'acs', {$ENDIF} 's', iBool); // 510 AddProc ({$IFDEF MPLPARSER} 'acs', {$ENDIF} 's', iBool); // 510
AddProc ({$IFDEF MPLPARSER} 'upuser', {$ENDIF} 'i', iNone); // 511 AddProc ({$IFDEF MPLPARSER} 'upuser', {$ENDIF} 'i', iNone); // 511
AddProc ({$IFDEF MPLPARSER} 'setusertime', {$ENDIF} 'i', iNone); // 512 AddProc ({$IFDEF MPLPARSER} 'setusertime', {$ENDIF} 'i', iNone); // 512
AddProc ({$IFDEF MPLPARSER} 'hangup', {$ENDIF} '', iNone); // 513 AddProc ({$IFDEF MPLPARSER} 'hangup', {$ENDIF} '', iNone); // 513
AddProc ({$IFDEF MPLPARSER} 'getmbase', {$ENDIF} 'l', iBool); // 514 AddProc ({$IFDEF MPLPARSER} 'getmbase', {$ENDIF} 'l', iBool); // 514
AddProc ({$IFDEF MPLPARSER} 'getprompt', {$ENDIF} 'l', iString); // 515 AddProc ({$IFDEF MPLPARSER} 'getprompt', {$ENDIF} 'l', iString); // 515
AddProc ({$IFDEF MPLPARSER} 'getmgroup', {$ENDIF} 'l', iBool); // 516 AddProc ({$IFDEF MPLPARSER} 'getmgroup', {$ENDIF} 'l', iBool); // 516
AddProc ({$IFDEF MPLPARSER} 'purgeinput', {$ENDIF} '', iNone); // 517 AddProc ({$IFDEF MPLPARSER} 'purgeinput', {$ENDIF} '', iNone); // 517
AddProc ({$IFDEF MPLPARSER} 'getfbase', {$ENDIF} 'l', iBool); // 518 AddProc ({$IFDEF MPLPARSER} 'getfbase', {$ENDIF} 'l', iBool); // 518
AddProc ({$IFDEF MPLPARSER} 'getfgroup', {$ENDIF} 'l', iBool); // 519 AddProc ({$IFDEF MPLPARSER} 'getfgroup', {$ENDIF} 'l', iBool); // 519
AddProc ({$IFDEF MPLPARSER} 'sysoplog', {$ENDIF} 's', iNone); // 520 AddProc ({$IFDEF MPLPARSER} 'sysoplog', {$ENDIF} 's', iNone); // 520
AddProc ({$IFDEF MPLPARSER} 'movex', {$ENDIF} 'b', iNone); // 521 AddProc ({$IFDEF MPLPARSER} 'movex', {$ENDIF} 'b', iNone); // 521
AddProc ({$IFDEF MPLPARSER} 'movey', {$ENDIF} 'b', iNone); // 522 AddProc ({$IFDEF MPLPARSER} 'movey', {$ENDIF} 'b', iNone); // 522
AddProc ({$IFDEF MPLPARSER} 'writepipe', {$ENDIF} 's', iNone); // 523 AddProc ({$IFDEF MPLPARSER} 'writepipe', {$ENDIF} 's', iNone); // 523
AddProc ({$IFDEF MPLPARSER} 'writepipeln', {$ENDIF} 's', iNone); // 524 AddProc ({$IFDEF MPLPARSER} 'writepipeln', {$ENDIF} 's', iNone); // 524
AddProc ({$IFDEF MPLPARSER} 'writeraw', {$ENDIF} 's', iNone); // 525 AddProc ({$IFDEF MPLPARSER} 'writeraw', {$ENDIF} 's', iNone); // 525
AddProc ({$IFDEF MPLPARSER} 'writerawln', {$ENDIF} 's', iNone); // 526 AddProc ({$IFDEF MPLPARSER} 'writerawln', {$ENDIF} 's', iNone); // 526
AddProc ({$IFDEF MPLPARSER} 'mci2str', {$ENDIF} 's', iString); // 527 AddProc ({$IFDEF MPLPARSER} 'mci2str', {$ENDIF} 's', iString); // 527
AddProc ({$IFDEF MPLPARSER} 'getusertime', {$ENDIF} '', iInteger); // 528 AddProc ({$IFDEF MPLPARSER} 'getusertime', {$ENDIF} '', iInteger); // 528
AddProc ({$IFDEF MPLPARSER} 'getscreeninfo', {$ENDIF} 'bBBB', iNone); // 529 AddProc ({$IFDEF MPLPARSER} 'getscreeninfo', {$ENDIF} 'bBBB', iNone); // 529
AddProc ({$IFDEF MPLPARSER} 'setprompt', {$ENDIF} 'bs', iNone); // 530 AddProc ({$IFDEF MPLPARSER} 'setprompt', {$ENDIF} 'bs', iNone); // 530
AddProc ({$IFDEF MPLPARSER} 'moreprompt', {$ENDIF} '', iChar); // 531 AddProc ({$IFDEF MPLPARSER} 'moreprompt', {$ENDIF} '', iChar); // 531
AddProc ({$IFDEF MPLPARSER} 'pause', {$ENDIF} '', iNone); // 532 AddProc ({$IFDEF MPLPARSER} 'pause', {$ENDIF} '', iNone); // 532
AddProc ({$IFDEF MPLPARSER} 'setpromptinfo', {$ENDIF} 'bs', iNone); // 533 AddProc ({$IFDEF MPLPARSER} 'setpromptinfo', {$ENDIF} 'bs', iNone); // 533
AddProc ({$IFDEF MPLPARSER} 'bufflush', {$ENDIF} '', iNone); // 534 AddProc ({$IFDEF MPLPARSER} 'bufflush', {$ENDIF} '', iNone); // 534
AddProc ({$IFDEF MPLPARSER} 'strmci', {$ENDIF} 's', iString); // 535 AddProc ({$IFDEF MPLPARSER} 'strmci', {$ENDIF} 's', iString); // 535
AddProc ({$IFDEF MPLPARSER} 'getcharxy', {$ENDIF} 'bb', iChar); // 536 AddProc ({$IFDEF MPLPARSER} 'getcharxy', {$ENDIF} 'bb', iChar); // 536
AddProc ({$IFDEF MPLPARSER} 'getattrxy', {$ENDIF} 'bb', iByte); // 537 AddProc ({$IFDEF MPLPARSER} 'getattrxy', {$ENDIF} 'bb', iByte); // 537
AddProc ({$IFDEF MPLPARSER} 'putthisuser', {$ENDIF} '', iNone); // 538 AddProc ({$IFDEF MPLPARSER} 'putthisuser', {$ENDIF} '', iNone); // 538
AddProc ({$IFDEF MPLPARSER} 'putuser', {$ENDIF} 'l', iNone); // 539 AddProc ({$IFDEF MPLPARSER} 'putuser', {$ENDIF} 'l', iNone); // 539
AddProc ({$IFDEF MPLPARSER} 'isuser', {$ENDIF} 's', iBool); // 540 AddProc ({$IFDEF MPLPARSER} 'isuser', {$ENDIF} 's', iBool); // 540
AddProc ({$IFDEF MPLPARSER} 'getmbasestats', {$ENDIF} 'lLLL', iBool); // 541 AddProc ({$IFDEF MPLPARSER} 'getmbasestats', {$ENDIF} 'lLLL', iBool); // 541
AddProc ({$IFDEF MPLPARSER} 'writexy', {$ENDIF} 'bbbs', iNone); // 542 AddProc ({$IFDEF MPLPARSER} 'writexy', {$ENDIF} 'bbbs', iNone); // 542
AddProc ({$IFDEF MPLPARSER} 'writexypipe', {$ENDIF} 'bbbis', iNone); // 543 AddProc ({$IFDEF MPLPARSER} 'writexypipe', {$ENDIF} 'bbbis', iNone); // 543
AddProc ({$IFDEF MPLPARSER} 'msgeditor', {$ENDIF} 'iIiiosS', iBool); // 544
AddProc ({$IFDEF MPLPARSER} 'msgeditget', {$ENDIF} 'i', iString); // 545
AddProc ({$IFDEF MPLPARSER} 'msgeditset', {$ENDIF} 'is', iNone); // 546
{ END OF PROCEDURE DEFINITIONS } { END OF PROCEDURE DEFINITIONS }

10
mystic/mpl_compile.pas
View File

@ -837,7 +837,17 @@ Begin
If RecData[VarData[VN]^.RecID]^.Fields[Count].ArrDem > 0 Then Begin If RecData[VarData[VN]^.RecID]^.Fields[Count].ArrDem > 0 Then Begin
GetStr(tkw[wOpenArray], True, False); GetStr(tkw[wOpenArray], True, False);
// output if zero based here asdf asdf
For X := 1 to RecData[VarData[VN]^.RecID]^.Fields[Count].ArrDem Do Begin For X := 1 to RecData[VarData[VN]^.RecID]^.Fields[Count].ArrDem Do Begin
OutWord(RecData[VarData[VN]^.RecID]^.Fields[Count].ArrStart[X]);
// If RecData[VarData[VN]^.RecID]^.Fields[Count].ArrStart[X] = 0 Then
// OutWord(0)
// Else
// OutWord(1);
ParseVarNumber(True); ParseVarNumber(True);
If X < RecData[VarData[VN]^.RecID]^.Fields[Count].ArrDem Then If X < RecData[VarData[VN]^.RecID]^.Fields[Count].ArrDem Then

52
mystic/mpl_execute.pas
View File

@ -449,9 +449,10 @@ End;
Procedure TInterpEngine.CheckArray (VN: Word; Var A: TArrayInfo; Var R: TRecInfo); Procedure TInterpEngine.CheckArray (VN: Word; Var A: TArrayInfo; Var R: TRecInfo);
Var Var
Count : Word; Count : Word;
Temp : TArrayInfo; Temp : TArrayInfo;
Offset : Word; Offset : Word;
ArrStart : Word;
Begin Begin
For Count := 1 to mplMaxArrayDem Do A[Count] := 1; For Count := 1 to mplMaxArrayDem Do A[Count] := 1;
@ -484,13 +485,17 @@ Begin
R.ArrDem := W; R.ArrDem := W;
If R.ArrDem > 0 Then Begin If R.ArrDem > 0 Then Begin
For Count := 1 to R.ArrDem Do
Temp[Count] := Trunc(EvaluateNumber);
Offset := 0; Offset := 0;
For Count := 1 to R.ArrDem Do For Count := 1 to R.ArrDem Do Begin
Offset := Offset + ((Temp[Count] - 1) * R.OneSize); NextWord;
ArrStart := W;
Temp[Count] := Trunc(EvaluateNumber);
Offset := Offset + ((Temp[Count] - ArrStart) * R.OneSize);
End;
R.Offset := R.Offset + Offset; R.Offset := R.Offset + Offset;
End; End;
@ -1018,16 +1023,8 @@ Begin
RecID := FindVariable(W); RecID := FindVariable(W);
CheckArray (RecID, AD, RI); CheckArray (RecID, AD, RI);
//asdf DEBUG DEBUG
// how do we get the real size of the shit here?
// i added Checkarray here and ParseElement in ParseVarRecord for compiler
//session.io.outfullln('datasize=' + stri2s(vardata[recid]^.datasize));
//session.io.outfullln('varsize=' + stri2s(vardata[recid]^.varsize));
//session.io.outfullln('|PN');
Move (GetDataPtr(RecID, AD, RI)^, GetDataPtr(VarNum, ArrayData, RecInfo)^, RecInfo.OneSize {VarData[RecID]^.VarSize}); Move (GetDataPtr(RecID, AD, RI)^, GetDataPtr(VarNum, ArrayData, RecInfo)^, RecInfo.OneSize {VarData[RecID]^.VarSize});
// Move (VarData[RecID]^.Data^, GetDataPtr(VarNum, ArrayData, RecInfo)^, VarData[RecID]^.DataSize);
End; End;
End; End;
End; End;
@ -1144,7 +1141,7 @@ Begin
Result := DataSize; Result := DataSize;
GetMem (Data, DataSize); GetMem (Data, DataSize);
FillChar (Data^, DataSize, 0); FillChar (Data^, DataSize, #0);
Kill := True; Kill := True;
End; End;
@ -1389,7 +1386,7 @@ Begin
VarData[VarNum]^.Kill := False; VarData[VarNum]^.Kill := False;
GetMem (VarData[VarNum]^.Data, VarData[VarNum]^.DataSize); GetMem (VarData[VarNum]^.Data, VarData[VarNum]^.DataSize);
FillChar (VarData[VarNum]^.Data^, VarData[VarNum]^.DataSize, 0); FillChar (VarData[VarNum]^.Data^, VarData[VarNum]^.DataSize, #0);
End; End;
ExecuteBlock (SavedVar); ExecuteBlock (SavedVar);
@ -1903,6 +1900,25 @@ Begin
End; End;
542 : WriteXY (Param[1].B, Param[2].B, Param[3].B, Param[4].S); 542 : WriteXY (Param[1].B, Param[2].B, Param[3].B, Param[4].S);
543 : WriteXYPipe (Param[1].B, Param[2].B, Param[3].B, Param[4].I, Param[5].S); 543 : WriteXYPipe (Param[1].B, Param[2].B, Param[3].B, Param[4].I, Param[5].S);
544 : Begin
TempBool := Editor(SmallInt(Pointer(Param[2].vData)^),
Param[3].I,
Param[4].I,
Param[5].O,
Param[6].S,
String(Pointer(Param[7].vData)^));
Store (TempBool, 1);
End;
545 : Begin
If (Param[1].I > 0) and (Param[1].I <= mysMaxMsgLines) Then
TempStr := Session.Msgs.MsgText[Param[1].I]
Else
TempStr := '';
Store (TempStr, 255);
End;
546 : If (Param[1].I > 0) and (Param[1].I <= mysMaxMsgLines) Then
Session.Msgs.MsgText[Param[1].I] := Param[2].S;
End; End;
End; End;

2
mystic/mpl_types.pas
View File

@ -77,7 +77,7 @@ Type
); );
Const Const
mplVer = '11B'; mplVer = '11C';
mplVersion = '[MPX ' + mplVer +']' + #26; mplVersion = '[MPX ' + mplVer +']' + #26;
mplVerLength = 10; mplVerLength = 10;
mplExtSource = '.mps'; mplExtSource = '.mps';

55
mystic/mutil.cfg
View File

@ -22,6 +22,7 @@
; - Mass upload files to all file bases (with FILE_ID.DIZ import) ; - Mass upload files to all file bases (with FILE_ID.DIZ import)
; - Generate Top 1 up to 99 Callers, Posters, Downloaders, Uploaders, PCR ; - Generate Top 1 up to 99 Callers, Posters, Downloaders, Uploaders, PCR
; - Import FILES.BBS into file bases ; - Import FILES.BBS into file bases
; - Generate all files listing
; ;
; ========================================================================== ; ==========================================================================
; ========================================================================== ; ==========================================================================
@ -41,13 +42,13 @@
Import_FIDONET.NA = false Import_FIDONET.NA = false
Import_FILEBONE.NA = false Import_FILEBONE.NA = false
Import_FILES.BBS = false Import_FILES.BBS = false
MassUpload = false MassUpload = true
GenerateTopLists = false GenerateTopLists = false
GenerateAllFiles = false
; WIP next to be added: ; work in progress below
GenerateAllFiles = true PurgeMessageBases = false
PurgeMessageBases = false PackMessageBases = false
PackMessageBases = false
; ========================================================================== ; ==========================================================================
@ -139,26 +140,26 @@
[Import_FILES.BBS] [Import_FILES.BBS]
; This function searches the filebase directories for existance of a ; This function searches the filebase directories for existance of a
; FILES.BBS file. If the file is found, MUTIL will process all files ; FILES.BBS file. If the file is found, MUTIL will process all files
; within it and upload any new files into the BBS using the description ; within it and upload any new files into the BBS using the description
; from the FILES.BBS. The files must physically exist in the same ; from the FILES.BBS. The files must physically exist in the same
; directory as the FILES.BBS in order for them to be uploaded to the BBS ; directory as the FILES.BBS in order for them to be uploaded to the BBS
uploader_name = Mystic BBS uploader_name = Mystic BBS
; for custom files.bbs importing. desc_char is the character that denotes ; for custom files.bbs importing. desc_char is the character that denotes
; extended description (blank = space). desc_charpos is the position in ; extended description (blank = space). desc_charpos is the position in
; which the character exists. desc_start is the position where the ; which the character exists. desc_start is the position where the
; description actually starts. ; description actually starts.
desc_char = desc_char =
desc_charpos = 1 desc_charpos = 1
desc_start = 14 desc_start = 14
; erase files.bbs after processing? 0=no, 1=yes ; erase files.bbs after processing? 0=no, 1=yes
delete_after = 0 delete_after = 0
; ========================================================================== ; ==========================================================================
; ========================================================================== ; ==========================================================================
@ -262,16 +263,16 @@
[GenerateAllFiles] [GenerateAllFiles]
; Generate all files list [NOT COMPLETED] ; Generate all files list
; Path / filename of output filename. If the path is not included then the ; Path / filename of output filename. If the path is not included then the
; file will be created in whatever the current working directory is. ; file will be created in whatever the current working directory is.
filename = allfiles.txt filename = allfiles.txt
; features needed: ; ideas/features for the future?
; header, footer, baseheader, basefooter, exclude bases, uploader optional ; header, footer, baseheader, basefooter, exclude bases, uploader optional
; uploader line, format list line 1st,2nd line, space between files? ; uploader line, format list line 1st,2nd line, space between files?
[PurgeMessageBases] [PurgeMessageBases]

118
mystic/mutil_allfiles.pas
View File

@ -9,19 +9,133 @@ Procedure uAllFilesList;
Implementation Implementation
Uses Uses
m_DateTime,
m_Strings, m_Strings,
m_FileIO,
mUtil_Common, mUtil_Common,
mUtil_Status; mUtil_Status;
Const Const
AddedFiles : Cardinal = 0; TotalFiles : Cardinal = 0;
TotalSize : Cardinal = 0;
TotalBases : Cardinal = 0;
BaseFiles : Cardinal = 0;
BaseSize : Cardinal = 0;
Procedure uAllFilesList; Procedure uAllFilesList;
Var
OutFile : Text;
Buffer : Array[1..1024 * 4] of Char;
BaseFile : File of RecFileBase;
ListFile : File of RecFileList;
DescFile : File;
Base : RecFileBase;
List : RecFileList;
DescStr : String[50];
Count : LongInt;
Begin Begin
ProcessName ('Generating AllFiles List', True); ProcessName ('Generating AllFiles List', True);
ProcessResult (rWORKING, False); ProcessResult (rWORKING, False);
ProcessStatus ('Added |15' + strI2S(AddedFiles) + ' |07file(s)'); Assign (OutFile, INI.ReadString(Header_ALLFILES, 'filename', 'allfiles.txt'));
SetTextBuf (OutFile, Buffer);
ReWrite (OutFile);
If IoResult <> 0 Then Begin
ProcessStatus ('Cannot create output file');
ProcessResult (rWARN, True);
Exit;
End;
Assign (BaseFile, bbsConfig.DataPath + 'fbases.dat');
If Not ioReset (BaseFile, SizeOf(RecFileBase), fmRWDN) Then Begin
ProcessStatus ('Cannot open fbases.dat');
ProcessResult (rWARN, True);
Close (OutFile);
Exit;
End;
While Not Eof(BaseFile) Do Begin
BaseFiles := 0;
BaseSize := 0;
Read (BaseFile, Base);
// If Excludedbase then continue;
Assign (ListFile, bbsConfig.DataPath + Base.FileName + '.dir');
Assign (DescFile, bbsConfig.DataPath + Base.FileName + '.des');
If Not ioReset (ListFile, SizeOf(RecFileList), fmRWDN) Then Continue;
If Not ioReset (DescFile, 1, fmRWDN) Then Begin
Close (ListFile);
Continue;
End;
While Not Eof(ListFile) Do Begin
Read (ListFile, List);
If List.Flags AND FDirDeleted <> 0 Then Continue;
// check exclude offline, exclude failed, etc
If BaseFiles = 0 Then Begin
Inc (TotalBases);
WriteLn (OutFile, '');
WriteLn (OutFile, strStripPipe(Base.Name));
WriteLn (OutFile, strRep('=', strMCILen(Base.Name)));
WriteLn (OutFile, '');
WriteLn (OutFile, 'Filename Size Date Description');
WriteLn (OutFile, strrep('-', 79));
End;
Inc (BaseFiles);
Inc (TotalFiles);
Inc (BaseSize, List.Size DIV 1024);
Inc (TotalSize, List.Size DIV 1024);
WriteLn (OutFile, List.FileName);
Write (OutFile, ' ' + strPadL(strComma(List.Size), 11, ' ') + ' ' + DateDos2Str(List.DateTime, 1 {dateformat}) + ' ');
Seek (DescFile, List.DescPtr);
For Count := 1 to List.DescLines Do Begin
BlockRead (DescFile, DescStr[0], 1);
BlockRead (DescFile, DescStr[1], Ord(DescStr[0]));
If Count = 1 Then
WriteLn (OutFile, DescStr)
Else
WriteLn (OutFile, strRep(' ', 27) + DescStr);
End;
End;
Close (ListFile);
Close (DescFile);
If BaseFiles > 0 Then Begin
WriteLn (OutFile, strRep('-', 79));
WriteLn (OutFile, 'Total files: ' + strComma(BaseFiles) + ' (' + strComma(BaseSize DIV 1024) + 'mb)');
End;
End;
If TotalFiles > 0 Then Begin
WriteLn (OutFile, '');
WriteLn (OutFile, '* Total bases: ' + strComma(TotalBases));
WriteLn (OutFile, '* Total files: ' + strComma(TotalFiles));
WriteLn (OutFile, '* Total size: ' + strComma(TotalSize DIV 1024) + 'mb');
End;
Close (BaseFile);
Close (OutFile);
ProcessStatus ('Added |15' + strI2S(TotalFiles) + ' |07file(s)');
ProcessResult (rDONE, True); ProcessResult (rDONE, True);
End; End;

2
mystic/mutil_common.pas
View File

@ -228,7 +228,7 @@ Begin
Read (ArcFile, Arc); Read (ArcFile, Arc);
If (Not Arc.Active) or (Arc.OSType <> OSType) Then Continue; If (Not Arc.Active) or ((Arc.OSType <> OSType) and (Arc.OSType <> 3)) Then Continue;
If strUpper(Arc.Ext) = Temp Then Break; If strUpper(Arc.Ext) = Temp Then Break;
Until False; Until False;

4
mystic/nodespy.pas
View File

@ -53,7 +53,7 @@ Const
UpdateNode = 500; UpdateNode = 500;
UpdateStats = 6000 * 10; // 10 minutes UpdateStats = 6000 * 10; // 10 minutes
AutoSnoop : Boolean = True; AutoSnoop : Boolean = False;
AutoSnoopID : LongInt = 0; AutoSnoopID : LongInt = 0;
Type Type
@ -613,6 +613,8 @@ Begin
Client := TIOSocket.Create; Client := TIOSocket.Create;
Client.FTelnetClient := True;
If Not Client.Connect('127.0.0.1', Config.INetTNPort) Then If Not Client.Connect('127.0.0.1', Config.INetTNPort) Then
ShowMsgBox (0, 'Unable to connect') ShowMsgBox (0, 'Unable to connect')
Else Begin Else Begin

2
mystic/records.pas
View File

@ -64,6 +64,8 @@ Const
fn_SemFileEcho = 'echomail.now'; fn_SemFileEcho = 'echomail.now';
fn_SemFileNews = 'newsmail.now'; fn_SemFileNews = 'newsmail.now';
fn_SemFileNet = 'netmail.now'; fn_SemFileNet = 'netmail.now';
fn_tplMsgEdit = 'ansiedit';
fn_tplTextEdit = 'ansitext';
Type Type
SmallWord = System.Word; SmallWord = System.Word;

22
mystic/todo.pas
View File

@ -14,18 +14,16 @@ BUGS AND POSSIBLE ISSUES
! After data file review, add missing variables to various MPL Get/Put ! After data file review, add missing variables to various MPL Get/Put
functions. functions.
! RAR internal viewer does not work with files that have embedded comments ! RAR internal viewer does not work with files that have embedded comments
! Investigate strange crashing when Mystic is built in the FPC editor vs
the makewin script. Something is out of whack with compiler options? OR
FPC BUG? DirAttr is suspect in MPL is it 1 byte or 4 in size?
! View archive not working if its external view? [Griffin]
! Test MIS blocking features or just rewrite MIS completely.
! Test midnight rollovers for time (flag for user to be immune to timecheck) ! Test midnight rollovers for time (flag for user to be immune to timecheck)
! Elasped time will need to be recalculated based on flag above ^^
! Validate that "groupX.ans" and "fgroupX.ans" actually work. ! Validate that "groupX.ans" and "fgroupX.ans" actually work.
! Test NNTP with Thunderbird specifically FUBAR dates on messages.
FUTURE / IDEAS / WORK IN PROGRESS / NOTES FUTURE / IDEAS / WORK IN PROGRESS / NOTES
========================================= =========================================
- Auto wrapping of quotes before the FS editor gets to it.
- Finish Threaded message reader
- Add "high roller Smack talk" into BlackJack
- Add better MIS logging per server (connect, refuse, blocked, etc) - Add better MIS logging per server (connect, refuse, blocked, etc)
- BBS email autoforwarded to Internet email - BBS email autoforwarded to Internet email
- Ability to send internet email to people from within the BBS. - Ability to send internet email to people from within the BBS.
@ -74,6 +72,8 @@ FUTURE / IDEAS / WORK IN PROGRESS / NOTES
- Template system similar to Mystic 2 (ansiedit.ans ansiedit.ans.cfg) - Template system similar to Mystic 2 (ansiedit.ans ansiedit.ans.cfg)
- Rename Template filenames to allow more than 8 characters (for clarity) - Rename Template filenames to allow more than 8 characters (for clarity)
- Does anyone use Version 7 compiled nodelists? Worth supporting? - Does anyone use Version 7 compiled nodelists? Worth supporting?
How do other softwares leverage nodelists? Reference TG, RG, RA,
SearchLight, PCBoard, etc, and come up with the best solution.
- ANSI message upload post processor option: Auto/Disabled/Ask - ANSI message upload post processor option: Auto/Disabled/Ask
- Prompt for disconect after UL or DL (and add option to filebase settings) - Prompt for disconect after UL or DL (and add option to filebase settings)
- Finish optional user prompts - Finish optional user prompts
@ -92,6 +92,7 @@ FUTURE / IDEAS / WORK IN PROGRESS / NOTES
- ^^ AREAFIX - ^^ AREAFIX
- ^^ TIC processing - ^^ TIC processing
- ^^ Needs to be powerful enough to HUB an entire FTN network - ^^ Needs to be powerful enough to HUB an entire FTN network
- QWK Networking support internally WHO CAN HELP THIS HAPPEN?
- MPL trunc/round? - MPL trunc/round?
- Internal Zmodem and TN/Link protocols or at least MBBSPROT executable - Internal Zmodem and TN/Link protocols or at least MBBSPROT executable
^^ driver that ships with Mystic and can be used by others. ^^ driver that ships with Mystic and can be used by others.
@ -119,6 +120,7 @@ Disconnect while posting design:
Line 5: Network address (or blank if none) Line 5: Network address (or blank if none)
Line 6: MsgText Line 6: MsgText
overwrite if exists overwrite if exists
NOTE WHAT ABOUT QUOTE TEXT
5. During LOGIN, check for msg_<UID>.txt or have menu command to do it? 5. During LOGIN, check for msg_<UID>.txt or have menu command to do it?
6. If exists, process and prompt user: 6. If exists, process and prompt user:
@ -163,9 +165,9 @@ mode library updates and screensave/restore changes)
1. terminal "screen length" is no longer an option of lines but a 1. terminal "screen length" is no longer an option of lines but a
selection: selection:
80x25 80x24
80x50 80x49
132x50 132x49
2. all display files and templates will have this logic added: 2. all display files and templates will have this logic added:
@ -193,7 +195,7 @@ ansiflst.50.an1 = ansiflist.50.an1.cfg
FILE rating / comments system FILE rating / comments system
1. what type? 4 or 5 start or 0-100 rating system? 1. what type? 4 or 5 stars, or 1-10, or 0-100 rating system?
2. records already updated to allow for either 2. records already updated to allow for either
----------------------------------------------------------------------- -----------------------------------------------------------------------