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
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
a person from accidentally logging into a node that is being used during
a local login.
@ -4739,3 +4739,70 @@
! MUTIL FILEBONE import was not adding the trailing slash when generating a
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.

11
mystic/aviewlzh.pas
View File

@ -18,7 +18,7 @@ Type
FileTime : LongInt;
Attr : Word;
FileName : String[12];
F32 : PathStr;
F32 : String[255];
DT : DateTime;
End;
@ -61,14 +61,17 @@ Begin
If _FHdr.HeadSize <> 0 Then
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.Time := _FHdr.FileTime;
End;
Procedure TLzhArchive.FindFirst (Var SR: ArcSearchRec);
Begin
_SL := 0;
GetHeader(SR);
End;
@ -77,4 +80,4 @@ Begin
GetHeader(SR);
End;
End.
End.

2
mystic/bbs_core.pas
View File

@ -201,7 +201,7 @@ Begin
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);
Close (HistoryFile);

9
mystic/bbs_edit_full.pas
View File

@ -4,7 +4,7 @@ Unit bbs_Edit_Full;
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
@ -18,7 +18,7 @@ Begin
Session.io.BufAddStr(S + #13#10);
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
MaxCutText = 100;
Type
@ -411,7 +411,9 @@ End;
Procedure FullReDraw;
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;
WinEnd := Session.io.ScreenInfo[2].Y;
@ -933,6 +935,7 @@ Begin
DeleteLine (CurLine);
TextRefreshPart;
End;
^Z,
^[ : Begin
Commands;

2
mystic/bbs_filebase.pas
View File

@ -3629,7 +3629,7 @@ Begin
Temp := 'Description Editor';
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.DescPtr := FileSize(DataFile);

10
mystic/bbs_general.pas
View File

@ -15,7 +15,7 @@ Uses
bbs_Edit_Full,
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 View_BBS_List (Long: Boolean; Data: String);
Procedure Add_BBS_List (Name : String);
@ -50,12 +50,12 @@ Uses
bbs_Core,
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
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
Editor := LineEditor(Lines, MaxLen, MaxLine, TEdit, Forced, Subj);
Editor := LineEditor(Lines, MaxLen, MaxLine, False, Forced, Subj);
End;
Procedure Upgrade_User_Level (Now: Boolean; Var U: RecUser; Sec: Byte);
@ -120,7 +120,7 @@ Begin
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+}
If IoResult <> 0 Then ReWrite (DF, 1);

143
mystic/bbs_msgbase.pas
View File

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

10
mystic/bbs_msgbase_abs.pas
View File

@ -100,7 +100,7 @@ Type
Function YoursFound: Boolean; Virtual; {Message found}
Function GetHighMsgNum: LongInt; Virtual; {Get highest msg number}
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 DeleteMsg; Virtual; {Delete current message}
Procedure SetEcho(ES: Boolean); Virtual; {Set echo status}
@ -521,10 +521,10 @@ Procedure TMsgBaseABS.SetMailType(MT: MsgMailType);
Begin
End;
Function TMsgBaseABS.GetSubArea: Word;
Begin
GetSubArea := 0;
End;
//Function TMsgBaseABS.GetSubArea: Word;
//Begin
// GetSubArea := 0;
//End;
Procedure TMsgBaseABS.ReWriteHdr;
Begin

436
mystic/bbs_msgbase_jam.pas
View File

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

364
mystic/bbs_msgbase_squish.pas
View File

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

4
mystic/mis.pas
View File

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

2
mystic/mis_client_nntp.pas
View File

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

277
mystic/mpl_common.pas
View File

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

10
mystic/mpl_compile.pas
View File

@ -837,7 +837,17 @@ Begin
If RecData[VarData[VN]^.RecID]^.Fields[Count].ArrDem > 0 Then Begin
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
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);
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);
Var
Count : Word;
Temp : TArrayInfo;
Offset : Word;
Count : Word;
Temp : TArrayInfo;
Offset : Word;
ArrStart : Word;
Begin
For Count := 1 to mplMaxArrayDem Do A[Count] := 1;
@ -484,13 +485,17 @@ Begin
R.ArrDem := W;
If R.ArrDem > 0 Then Begin
For Count := 1 to R.ArrDem Do
Temp[Count] := Trunc(EvaluateNumber);
Offset := 0;
For Count := 1 to R.ArrDem Do
Offset := Offset + ((Temp[Count] - 1) * R.OneSize);
For Count := 1 to R.ArrDem Do Begin
NextWord;
ArrStart := W;
Temp[Count] := Trunc(EvaluateNumber);
Offset := Offset + ((Temp[Count] - ArrStart) * R.OneSize);
End;
R.Offset := R.Offset + Offset;
End;
@ -1018,16 +1023,8 @@ Begin
RecID := FindVariable(W);
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 (VarData[RecID]^.Data^, GetDataPtr(VarNum, ArrayData, RecInfo)^, VarData[RecID]^.DataSize);
End;
End;
End;
@ -1144,7 +1141,7 @@ Begin
Result := DataSize;
GetMem (Data, DataSize);
FillChar (Data^, DataSize, 0);
FillChar (Data^, DataSize, #0);
Kill := True;
End;
@ -1389,7 +1386,7 @@ Begin
VarData[VarNum]^.Kill := False;
GetMem (VarData[VarNum]^.Data, VarData[VarNum]^.DataSize);
FillChar (VarData[VarNum]^.Data^, VarData[VarNum]^.DataSize, 0);
FillChar (VarData[VarNum]^.Data^, VarData[VarNum]^.DataSize, #0);
End;
ExecuteBlock (SavedVar);
@ -1903,6 +1900,25 @@ Begin
End;
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);
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;

2
mystic/mpl_types.pas
View File

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

55
mystic/mutil.cfg
View File

@ -22,6 +22,7 @@
; - Mass upload files to all file bases (with FILE_ID.DIZ import)
; - Generate Top 1 up to 99 Callers, Posters, Downloaders, Uploaders, PCR
; - Import FILES.BBS into file bases
; - Generate all files listing
;
; ==========================================================================
; ==========================================================================
@ -41,13 +42,13 @@
Import_FIDONET.NA = false
Import_FILEBONE.NA = false
Import_FILES.BBS = false
MassUpload = false
MassUpload = true
GenerateTopLists = false
GenerateAllFiles = false
; WIP next to be added:
GenerateAllFiles = true
PurgeMessageBases = false
PackMessageBases = false
; work in progress below
PurgeMessageBases = false
PackMessageBases = false
; ==========================================================================
@ -139,26 +140,26 @@
[Import_FILES.BBS]
; This function searches the filebase directories for existance of a
; 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
; 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
; This function searches the filebase directories for existance of a
; 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
; 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
uploader_name = Mystic BBS
uploader_name = Mystic BBS
; for custom files.bbs importing. desc_char is the character that denotes
; extended description (blank = space). desc_charpos is the position in
; which the character exists. desc_start is the position where the
; description actually starts.
; for custom files.bbs importing. desc_char is the character that denotes
; extended description (blank = space). desc_charpos is the position in
; which the character exists. desc_start is the position where the
; description actually starts.
desc_char =
desc_charpos = 1
desc_start = 14
desc_char =
desc_charpos = 1
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]
; Generate all files list [NOT COMPLETED]
; Generate all files list
; Path / filename of output filename. If the path is not included then the
; file will be created in whatever the current working directory is.
; Path / filename of output filename. If the path is not included then the
; file will be created in whatever the current working directory is.
filename = allfiles.txt
filename = allfiles.txt
; features needed:
; header, footer, baseheader, basefooter, exclude bases, uploader optional
; uploader line, format list line 1st,2nd line, space between files?
; ideas/features for the future?
; header, footer, baseheader, basefooter, exclude bases, uploader optional
; uploader line, format list line 1st,2nd line, space between files?
[PurgeMessageBases]

120
mystic/mutil_allfiles.pas
View File

@ -9,20 +9,134 @@ Procedure uAllFilesList;
Implementation
Uses
m_DateTime,
m_Strings,
m_FileIO,
mUtil_Common,
mUtil_Status;
Const
AddedFiles : Cardinal = 0;
TotalFiles : Cardinal = 0;
TotalSize : Cardinal = 0;
TotalBases : Cardinal = 0;
BaseFiles : Cardinal = 0;
BaseSize : Cardinal = 0;
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
ProcessName ('Generating AllFiles List', True);
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);
End;
End.
End.

2
mystic/mutil_common.pas
View File

@ -228,7 +228,7 @@ Begin
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;
Until False;

4
mystic/nodespy.pas
View File

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

2
mystic/records.pas
View File

@ -64,6 +64,8 @@ Const
fn_SemFileEcho = 'echomail.now';
fn_SemFileNews = 'newsmail.now';
fn_SemFileNet = 'netmail.now';
fn_tplMsgEdit = 'ansiedit';
fn_tplTextEdit = 'ansitext';
Type
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
functions.
! 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)
! Elasped time will need to be recalculated based on flag above ^^
! Validate that "groupX.ans" and "fgroupX.ans" actually work.
! Test NNTP with Thunderbird specifically FUBAR dates on messages.
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)
- BBS email autoforwarded to Internet email
- 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)
- Rename Template filenames to allow more than 8 characters (for clarity)
- 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
- Prompt for disconect after UL or DL (and add option to filebase settings)
- Finish optional user prompts
@ -92,6 +92,7 @@ FUTURE / IDEAS / WORK IN PROGRESS / NOTES
- ^^ AREAFIX
- ^^ TIC processing
- ^^ Needs to be powerful enough to HUB an entire FTN network
- QWK Networking support internally WHO CAN HELP THIS HAPPEN?
- MPL trunc/round?
- Internal Zmodem and TN/Link protocols or at least MBBSPROT executable
^^ 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 6: MsgText
overwrite if exists
NOTE WHAT ABOUT QUOTE TEXT
5. During LOGIN, check for msg_<UID>.txt or have menu command to do it?
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
selection:
80x25
80x50
132x50
80x24
80x49
132x49
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
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
-----------------------------------------------------------------------