A35 begin

This commit is contained in:
mysticbbs 2013-05-20 05:35:04 -04:00
parent 387ac3c3f8
commit 1a40514261
33 changed files with 588 additions and 292 deletions

View File

@ -166,9 +166,9 @@ Begin
Case Form.Execute of Case Form.Execute of
'D' : MBase.NetAddr := Configuration_EchoMailAddress(False); 'D' : MBase.NetAddr := Configuration_EchoMailAddress(False);
'7' : Configuration_NodeExport (MBase); '7' : Configuration_NodeExport (MBase);
#27 : If (MBase.NetType > 0) And (MBase.EchoTag = '') And (MBase.NetType <> 3) Then #27 : {If (MBase.NetType > 0) And (MBase.EchoTag = '') And (MBase.NetType <> 3) Then
ShowMsgBox(0, 'Echo base requires echotag') ShowMsgBox(0, 'Echo base requires echotag')
Else Else}
Break; Break;
End; End;
Until False; Until False;

View File

@ -19,6 +19,7 @@ Uses
bbs_Common, bbs_Common,
bbs_Cfg_Common; bbs_Cfg_Common;
(*
Procedure CompileTheme (Var Theme: RecTheme); Procedure CompileTheme (Var Theme: RecTheme);
Var Var
LastPer : Byte = 0; LastPer : Byte = 0;
@ -110,6 +111,7 @@ Begin
End; End;
End; End;
End; End;
*)
Procedure EditPrompts (Var Theme: RecTheme); Procedure EditPrompts (Var Theme: RecTheme);
Const Const
@ -149,13 +151,13 @@ Var
Begin Begin
Result := False; Result := False;
Assign (InFile, Config.SystemPath + Theme.FileName + '.txt'); Assign (InFile, Config.DataPath + Theme.FileName + '.txt');
SetTextBuf (InFile, Buffer, SizeOf(Buffer)); SetTextBuf (InFile, Buffer, SizeOf(Buffer));
{$I-} Reset (InFile); {$I+} {$I-} Reset (InFile); {$I+}
If IoResult <> 0 Then Begin If IoResult <> 0 Then Begin
ShowMsgBox (0, 'Unable to open ' + Config.SystemPath + Theme.FileName + '.txt'); ShowMsgBox (0, 'Unable to open ' + Config.DataPath + Theme.FileName + '.txt');
Exit; Exit;
End; End;
@ -454,7 +456,7 @@ Var
UndoStr : String; UndoStr : String;
CurStr : String[3]; CurStr : String[3];
Changed : Boolean = False; Changed : Boolean = False;
Saved : Boolean = False; // Saved : Boolean = False;
Count : Integer; Count : Integer;
Image : TConsoleImageRec; Image : TConsoleImageRec;
SavedTheme : RecTheme; SavedTheme : RecTheme;
@ -567,9 +569,9 @@ Begin
If Changed Then If Changed Then
If ShowMsgBox(1, 'Save changes?') Then Begin If ShowMsgBox(1, 'Save changes?') Then Begin
Saved := True; // Saved := True;
Assign (InFile, Config.SystemPath + Theme.FileName + '.txt'); Assign (InFile, Config.DataPath + Theme.FileName + '.txt');
ReWrite (InFile); ReWrite (InFile);
For Count := 1 to TotalText Do Begin For Count := 1 to TotalText Do Begin
@ -582,8 +584,8 @@ Begin
DisposeStringData; DisposeStringData;
If Saved Then // If Saved Then
CompileTheme(Theme); // CompileTheme(Theme);
Box.Free; Box.Free;
Input.Free; Input.Free;

View File

@ -126,7 +126,7 @@ Begin
Form.AddByte ('S', ' Security' , 7, 6, 23, 6, 14, 3, 0, 255, @U.Security, Topic + 'User''s security level'); Form.AddByte ('S', ' Security' , 7, 6, 23, 6, 14, 3, 0, 255, @U.Security, Topic + 'User''s security level');
Form.AddFlag ('1', ' Flags #1' , 7, 7, 23, 7, 14, @U.AF1, Topic + 'User''s access flags: Set 1'); Form.AddFlag ('1', ' Flags #1' , 7, 7, 23, 7, 14, @U.AF1, Topic + 'User''s access flags: Set 1');
Form.AddFlag ('2', ' Flags #2' , 7, 8, 23, 8, 14, @U.AF2, Topic + 'User''s access flags: Set 2'); Form.AddFlag ('2', ' Flags #2' , 7, 8, 23, 8, 14, @U.AF2, Topic + 'User''s access flags: Set 2');
Form.AddWord ('T', ' Time Left' , 7, 9, 23, 9, 14, 4, 0, 9999, @U.TimeLeft, Topic + 'Total number of minutes left for today'); Form.AddWord ('T', ' Time Left' , 7, 9, 23, 9, 14, 4, 0, 1440, @U.TimeLeft, Topic + 'Total number of minutes left for today');
Form.AddWord ('I', ' Time Bank' , 7, 10, 23, 10, 14, 5, 0, 65000, @U.TimeBank, Topic + 'Total minutes in time bank'); Form.AddWord ('I', ' Time Bank' , 7, 10, 23, 10, 14, 5, 0, 65000, @U.TimeBank, Topic + 'Total minutes in time bank');
Form.AddDate ('X', ' Expires' , 7, 11, 23, 11, 14, @U.Expires, Topic + 'User''s account expiration date (00/00/00: Disabled)'); Form.AddDate ('X', ' Expires' , 7, 11, 23, 11, 14, @U.Expires, Topic + 'User''s account expiration date (00/00/00: Disabled)');
Form.AddByte ('O', ' To' , 7, 12, 23, 12, 14, 3, 0, 255, @U.ExpiresTo, Topic + 'Security profile to give user after expiration'); Form.AddByte ('O', ' To' , 7, 12, 23, 12, 14, 3, 0, 255, @U.ExpiresTo, Topic + 'Security profile to give user after expiration');

View File

@ -250,7 +250,7 @@ Begin
Close (Session.User.UserFile); Close (Session.User.UserFile);
End; End;
Reset (Session.PromptFile); // Reset (Session.PromptFile);
{$IFNDEF UNIX} {$IFNDEF UNIX}
If Screen.Active Then If Screen.Active Then
@ -273,7 +273,7 @@ Begin
0 : Screen.WriteXY (1, 25, Config.StatusColor3, strPadC(Str, 80, ' ')); 0 : Screen.WriteXY (1, 25, Config.StatusColor3, strPadC(Str, 80, ' '));
1 : Begin 1 : Begin
Screen.WriteXY ( 1, 25, Config.StatusColor1, ' Alias ' + strRep(' ', 35) + 'Age SecLevel TimeLeft '); Screen.WriteXY ( 1, 25, Config.StatusColor1, ' Alias ' + strRep(' ', 35) + 'Age SecLevel TimeLeft ');
Screen.WriteXY ( 8, 25, Config.StatusColor2, Session.User.ThisUser.Handle); Screen.WriteXY ( 8, 25, Config.StatusColor2, Session.User.ThisUser.Handle + ' #' + strI2S(Session.User.ThisUser.PermIdx));
Screen.WriteXY (47, 25, Config.StatusColor2, Session.User.ThisUser.Gender + '/' + strI2S(DaysAgo(Session.User.ThisUser.Birthday, 1) DIV 365)); Screen.WriteXY (47, 25, Config.StatusColor2, Session.User.ThisUser.Gender + '/' + strI2S(DaysAgo(Session.User.ThisUser.Birthday, 1) DIV 365));
Screen.WriteXY (62, 25, Config.StatusColor2, strI2S(Session.User.ThisUser.Security)); Screen.WriteXY (62, 25, Config.StatusColor2, strI2S(Session.User.ThisUser.Security));
Screen.WriteXY (76, 25, Config.StatusColor2, strI2S(Session.TimeLeft)); Screen.WriteXY (76, 25, Config.StatusColor2, strI2S(Session.TimeLeft));

View File

@ -78,10 +78,11 @@ Type
HistoryULs : Word; HistoryULs : Word;
HistoryULKB : LongInt; HistoryULKB : LongInt;
HistoryHour : SmallInt; HistoryHour : SmallInt;
PromptFile : File of RecPrompt; // PromptFile : File of RecPrompt;
Prompt : RecPrompt; // Prompt : RecPrompt;
LastScanHadNew : Boolean; LastScanHadNew : Boolean;
LastScanHadYou : Boolean; LastScanHadYou : Boolean;
PromptData : Array[0..mysMaxThemeText] of Pointer;
Constructor Create; Constructor Create;
Destructor Destroy; Override; Destructor Destroy; Override;
@ -159,7 +160,7 @@ Begin
User.Free; User.Free;
IO.Free; IO.Free;
Close (PromptFile); // Close (PromptFile);
{$IFNDEF UNIX} {$IFNDEF UNIX}
Client.Free; Client.Free;
@ -241,42 +242,6 @@ Begin
Close (EventFile); Close (EventFile);
End; End;
Function TBBSCore.GetPrompt (N : Word) : String;
Begin
{$I-}
Seek (PromptFile, N);
Read (PromptFile, Prompt);
{$I+}
If IoResult <> 0 Then Begin
FileMode := 66;
{$I-}
Assign (PromptFile, Config.DataPath + Theme.FileName + '.thm');
Reset (PromptFile);
Seek (PromptFile, N);
Read (PromptFile, Prompt);
{$I+}
If IoResult <> 0 Then Begin
io.OutFull ('|CR|12Error reading prompt ' + strI2S(N) + '|DE|DE');
SystemLog ('Error reading prompt ' + strI2S(N));
Halt (1);
End;
End;
If Prompt[1] = '@' Then Begin
io.OutFile (Copy(Prompt, 2, Length(Prompt)), True, 0);
Prompt := '';
End Else
If Prompt[1] = '!' Then Begin
ExecuteMPL (NIL, Copy(Prompt, 2, Length(Prompt)));
Prompt := '';
End;
Result := Prompt;
End;
Procedure TBBSCore.SystemLog (Str: String); Procedure TBBSCore.SystemLog (Str: String);
Var Var
tLOG : Text; tLOG : Text;
@ -358,6 +323,149 @@ Begin
TimeLeft := TimerEnd - TimerMinutes; TimeLeft := TimerEnd - TimerMinutes;
End; End;
Function TBBSCore.GetPrompt (N: Word) : String;
Begin
Result := String(PromptData[N]^);
If Result[1] = '@' Then Begin
io.OutFile (Copy(Result, 2, Length(Result)), True, 0);
Result := '';
End Else
If Result[1] = '!' Then Begin
ExecuteMPL (NIL, Copy(Result, 2, Length(Result)));
Result := '';
End;
End;
Function TBBSCore.LoadThemeData (Str: String) : Boolean;
Procedure DisposeThemeData;
Var
Count : LongInt;
Begin
For Count := mysMaxThemeText DownTo 0 Do Begin
If Assigned(PromptData[Count]) Then
FreeMem(PromptData[Count]);
PromptData[Count] := NIL;
End;
End;
Var
Count : LongInt;
PromptFile : Text;
Buffer : Array[1..1024 * 8] of Char;
Temp : String;
TempTheme : RecTheme;
Begin
Result := False;
Reset (ThemeFile);
While Not Eof(ThemeFile) Do Begin
Read (ThemeFile, TempTheme);
If strUpper(TempTheme.FileName) = strUpper(Str) Then Begin
Result := True;
Theme := TempTheme;
Break;
End;
End;
Close (ThemeFile);
If Not Result Then Exit;
Result := False;
FileMode := 66;
Assign (PromptFile, Config.DataPath + Theme.FileName + '.txt');
SetTextBuf (PromptFile, Buffer);
{$I-} Reset (PromptFile); {$I+}
If IoResult <> 0 Then Exit;
DisposeThemeData;
While Not Eof(PromptFile) Do Begin
ReadLn (PromptFile, Temp);
If Copy(Temp, 1, 3) = '000' Then
Count := 0
Else
If strS2I(Copy(Temp, 1, 3)) > 0 Then
Count := strS2I(Copy(Temp, 1, 3))
Else
Count := -1;
If Count <> -1 Then Begin
Temp := Copy(Temp, 5, Length(Temp));
If Assigned (PromptData[Count]) Then
FreeMem(PromptData[Count], SizeOf(PromptData[Count]^));
GetMem (PromptData[Count], Length(Temp) + 1);
Move (Temp, PromptData[Count]^, Length(Temp) + 1);
End;
End;
Close (PromptFile);
Result := True;
For Count := 1 to mysMaxThemeText Do
If Not Assigned(PromptData[Count]) Then Begin
SystemLog ('Missing prompt #' + strI2S(Count));
IO.OutFullLn('|12Missing prompt #' + strI2S(Count));
Result := False;
End;
If Not Result Then Halt(1);
End;
(*
Function TBBSCore.GetPrompt (N : Word) : String;
Begin
{$I-}
Seek (PromptFile, N);
Read (PromptFile, Prompt);
{$I+}
If IoResult <> 0 Then Begin
FileMode := 66;
{$I-}
Assign (PromptFile, Config.DataPath + Theme.FileName + '.thm');
Reset (PromptFile);
Seek (PromptFile, N);
Read (PromptFile, Prompt);
{$I+}
If IoResult <> 0 Then Begin
io.OutFull ('|CR|12Error reading prompt ' + strI2S(N) + '|DE|DE');
SystemLog ('Error reading prompt ' + strI2S(N));
Halt (1);
End;
End;
If Prompt[1] = '@' Then Begin
io.OutFile (Copy(Prompt, 2, Length(Prompt)), True, 0);
Prompt := '';
End Else
If Prompt[1] = '!' Then Begin
ExecuteMPL (NIL, Copy(Prompt, 2, Length(Prompt)));
Prompt := '';
End;
Result := Prompt;
End;
Function TBBSCore.LoadThemeData (Str: String) : Boolean; Function TBBSCore.LoadThemeData (Str: String) : Boolean;
Var Var
TempTheme : RecTheme; TempTheme : RecTheme;
@ -392,5 +500,6 @@ Begin
If Result Then Theme := TempTheme; If Result Then Theme := TempTheme;
End; End;
*)
End. End.

View File

@ -394,6 +394,8 @@ Procedure TEditorANSI.ReDrawTemplate (Reset: Boolean);
Var Var
Count : LongInt; Count : LongInt;
Begin Begin
FillChar (Session.io.ScreenInfo, SizeOf(Session.io.ScreenInfo), 0);
TBBSCore(Owner).io.AllowArrow := True; TBBSCore(Owner).io.AllowArrow := True;
Session.io.PromptInfo[2] := Subject; Session.io.PromptInfo[2] := Subject;
@ -683,18 +685,31 @@ Begin
End; End;
Procedure TEditorANSI.DoChar (Ch: Char); Procedure TEditorANSI.DoChar (Ch: Char);
Var
CharAttr : Byte;
Begin Begin
If (Session.io.ScreenInfo[6].A <> 0) and (Pos(Ch, '0123456789') > 0) Then
CharAttr := Session.io.ScreenInfo[6].A
Else
If (Session.io.ScreenInfo[5].A <> 0) and (Pos(Ch, '.,!@#$%^&*()_+-=~`''"?;:<>\/[]{}|') > 0) Then
CharAttr := Session.io.ScreenInfo[5].A
Else
If (Session.io.ScreenInfo[4].A <> 0) and (Ch = UpCase(Ch)) Then
CharAttr := Session.io.ScreenInfo[4].A
Else
CharAttr := CurAttr;
If InsertMode Then Begin If InsertMode Then Begin
Move (ANSI.Data[CurLine][CurX], ANSI.Data[CurLine][CurX + 1], SizeOf(RecAnsiBufferChar) * (CurLength - CurX + 1)); Move (ANSI.Data[CurLine][CurX], ANSI.Data[CurLine][CurX + 1], SizeOf(RecAnsiBufferChar) * (CurLength - CurX + 1));
ANSI.Data[CurLine][CurX].Ch := Ch; ANSI.Data[CurLine][CurX].Ch := Ch;
ANSI.Data[CurLine][CurX].Attr := CurAttr; ANSI.Data[CurLine][CurX].Attr := CharAttr;
If CurLength < RowSize {-1} Then Begin If CurLength < RowSize {-1} Then Begin
If CurX <= CurLength Then If CurX <= CurLength Then
DrawLine (CurLine, CurX, CurY) DrawLine (CurLine, CurX, CurY)
Else Begin Else Begin
TBBSCore(Owner).io.AnsiColor (CurAttr); TBBSCore(Owner).io.AnsiColor (CharAttr);
TBBSCore(Owner).io.BufAddChar (Ch); TBBSCore(Owner).io.BufAddChar (Ch);
End; End;
@ -707,9 +722,9 @@ Begin
End Else End Else
If CurX <= RowSize Then Begin If CurX <= RowSize Then Begin
ANSI.Data[CurLine][CurX].Ch := Ch; ANSI.Data[CurLine][CurX].Ch := Ch;
ANSI.Data[CurLine][CurX].Attr := CurAttr; ANSI.Data[CurLine][CurX].Attr := CharAttr;
TBBSCore(Owner).io.AnsiColor (CurAttr); TBBSCore(Owner).io.AnsiColor (CharAttr);
TBBSCore(Owner).io.BufAddChar (Ch); TBBSCore(Owner).io.BufAddChar (Ch);
Inc (CurX); Inc (CurX);
@ -895,6 +910,7 @@ End;
Procedure TEditorANSI.QuoteWindow; Procedure TEditorANSI.QuoteWindow;
Var Var
QText : Array[1..mysMaxMsgLines] of String[79]; QText : Array[1..mysMaxMsgLines] of String[79];
QTextSize : Byte;
InFile : Text; InFile : Text;
QuoteLines : Integer; QuoteLines : Integer;
NoMore : Boolean; NoMore : Boolean;
@ -904,7 +920,7 @@ Var
Session.io.AnsiGotoXY (1, QuoteCurLine + Session.io.ScreenInfo[2].Y); Session.io.AnsiGotoXY (1, QuoteCurLine + Session.io.ScreenInfo[2].Y);
If On Then If On Then
Session.io.AnsiColor (Session.Theme.QuoteColor) Session.io.AnsiColor (Session.io.ScreenInfo[3].A)
Else Else
Session.io.AnsiColor (Session.io.ScreenInfo[2].A); Session.io.AnsiColor (Session.io.ScreenInfo[2].A);
@ -918,7 +934,7 @@ Var
Session.io.AnsiGotoXY (1, Session.io.ScreenInfo[2].Y); Session.io.AnsiGotoXY (1, Session.io.ScreenInfo[2].Y);
Session.io.AnsiColor (Session.io.ScreenInfo[2].A); Session.io.AnsiColor (Session.io.ScreenInfo[2].A);
For Count := QuoteTopPage to QuoteTopPage + 5 Do Begin For Count := QuoteTopPage to QuoteTopPage + QTextSize - 1 Do Begin
If Count <= QuoteLines Then Session.io.BufAddStr (QText[Count]); If Count <= QuoteLines Then Session.io.BufAddStr (QText[Count]);
Session.io.AnsiClrEOL; Session.io.AnsiClrEOL;
@ -953,7 +969,7 @@ Var
Var Var
Count : Byte; Count : Byte;
Begin Begin
Session.io.AnsiColor (QuoteAttr); Session.io.AnsiColor (Session.io.ScreenInfo[1].A);
For Count := 1 to QWinSize + 1 Do Begin For Count := 1 to QWinSize + 1 Do Begin
Session.io.AnsiGotoXY (WinX1, WinY1 + Count - 1); Session.io.AnsiGotoXY (WinX1, WinY1 + Count - 1);
@ -988,7 +1004,8 @@ Begin
FillChar (QWinData, SizeOf(QWinData), 0); FillChar (QWinData, SizeOf(QWinData), 0);
QWinSize := Session.io.ScreenInfo[1].Y - WinY1 + 1; QTextSize := Session.io.ScreenInfo[3].Y - Session.io.ScreenInfo[2].Y + 1;
QWinSize := Session.io.ScreenInfo[1].Y - WinY1 + 1;
For Temp := CurLine - ((QWinSize DIV 2) + 1) To CurLine - 1 Do For Temp := CurLine - ((QWinSize DIV 2) + 1) To CurLine - 1 Do
If Temp >= 1 Then AddQuoteWin(GetLineText(Temp)); If Temp >= 1 Then AddQuoteWin(GetLineText(Temp));
@ -1004,6 +1021,7 @@ Begin
#71 : If QuoteCurLine > 0 Then Begin #71 : If QuoteCurLine > 0 Then Begin
QuoteTopPage := 1; QuoteTopPage := 1;
QuoteCurLine := 0; QuoteCurLine := 0;
NoMore := False;
UpdateWindow; UpdateWindow;
End; End;
@ -1025,8 +1043,8 @@ Begin
End; End;
#73, #73,
#75 : Begin #75 : Begin
If QuoteTopPage > 6 Then If QuoteTopPage > QTextSize Then
Dec (QuoteTopPage, 6) Dec (QuoteTopPage, QTextSize)
Else Begin Else Begin
QuoteTopPage := 1; QuoteTopPage := 1;
QuoteCurLine := 0; QuoteCurLine := 0;
@ -1037,17 +1055,17 @@ Begin
UpdateWindow; UpdateWindow;
End; End;
#79 : Begin #79 : Begin
If QuoteLines <= 6 Then If QuoteLines <= QTextSize Then
QuoteCurLine := QuoteLines - QuoteTopPage QuoteCurLine := QuoteLines - QuoteTopPage
Else Begin Else Begin
QuoteTopPage := QuoteLines - 5; QuoteTopPage := QuoteLines - QTextSize + 1;
QuoteCurLine := 5; QuoteCurLine := QTextSize - 1;
End; End;
UpdateWindow; UpdateWindow;
End; End;
#80 : If QuoteTopPage + QuoteCurLine < QuoteLines Then Begin #80 : If QuoteTopPage + QuoteCurLine < QuoteLines Then Begin
If QuoteCurLine = 5 Then Begin If QuoteCurLine = QTextSize - 1 Then Begin
Inc (QuoteTopPage); Inc (QuoteTopPage);
UpdateWindow; UpdateWindow;
@ -1061,14 +1079,14 @@ Begin
End; End;
#77, #77,
#81 : Begin #81 : Begin
If QuoteLines <= 6 Then If QuoteLines <= QTextSize Then
QuoteCurLine := QuoteLines - QuoteTopPage QuoteCurLine := QuoteLines - QuoteTopPage
Else Else
If QuoteTopPage + 6 < QuoteLines - 6 Then If QuoteTopPage + QTextSize - 1 < QuoteLines - QTextSize + 1 Then
Inc (QuoteTopPage, 6) Inc (QuoteTopPage, QTextSize)
Else Begin Else Begin
QuoteTopPage := QuoteLines - 5; QuoteTopPage := QuoteLines - QTextSize + 1;
QuoteCurLine := 5; QuoteCurLine := QTextSize - 1;
End; End;
UpdateWindow; UpdateWindow;
@ -1096,7 +1114,7 @@ Begin
DrawQWin; DrawQWin;
If QuoteTopPage + QuoteCurLine < QuoteLines Then If QuoteTopPage + QuoteCurLine < QuoteLines Then
If QuoteCurLine = 5 Then Begin If QuoteCurLine = QTextSize - 1 Then Begin
Inc (QuoteTopPage); Inc (QuoteTopPage);
UpdateWindow; UpdateWindow;

View File

@ -736,6 +736,7 @@ Begin
If FBase.FileName <> '' Then Begin If FBase.FileName <> '' Then Begin
GetFileScan; GetFileScan;
L := FScan.LastNew; L := FScan.LastNew;
End Else End Else
L := CurDateDos; L := CurDateDos;
@ -746,7 +747,7 @@ Begin
L := DateStr2Dos(Str); L := DateStr2Dos(Str);
If Session.io.GetYN (Session.GetPrompt(256), True) Then Begin If Session.io.GetYN (Session.GetPrompt(256), False) Then Begin
Reset (FBaseFile); Reset (FBaseFile);
Old := FBase; Old := FBase;
@ -2981,25 +2982,30 @@ Begin
End; End;
Procedure TFileBase.UploadFile; Procedure TFileBase.UploadFile;
// ignore group with configured upload base is an issue...
// how do we fix this up?
Var Var
FileName : String; FileName : String;
A : LongInt; A : LongInt;
OLD : RecFileBase; OLD : RecFileBase;
Blind : Boolean; Blind : Boolean;
Temp : String; Temp : String;
FullName : String; FullName : String;
DataFile : File; DataFile : File;
Found : Boolean; Found : Boolean;
LogFile : Text; LogFile : Text;
FileStatus : Boolean; FileStatus : Boolean;
SavedIgnore : Boolean;
{$IFNDEF UNIX} {$IFNDEF UNIX}
D : DirStr; D : DirStr;
N : NameStr; N : NameStr;
E : ExtStr; E : ExtStr;
{$ENDIF} {$ENDIF}
Begin Begin
OLD := FBase; OLD := FBase;
Found := False; Found := False;
SavedIgnore := Session.User.IgnoreGroup;
If Config.UploadBase > 0 Then Begin If Config.UploadBase > 0 Then Begin
Session.User.IgnoreGroup := True; { just in case ul area is in another group } Session.User.IgnoreGroup := True; { just in case ul area is in another group }
@ -3011,7 +3017,7 @@ Begin
Close (FBaseFile); Close (FBaseFile);
// reset ignoregroup here? Session.User.IgnoreGroup := SavedIgnore;
End; End;
If Not Session.User.Access(FBase.ULacs) Then Begin If Not Session.User.Access(FBase.ULacs) Then Begin

View File

@ -1644,30 +1644,38 @@ Begin
Case Ch of Case Ch of
#71 : If TopLine > 1 Then Begin #71 : If TopLine > 1 Then Begin
TopLine := 1; TopLine := 1;
Update; Update;
End; End;
#72 : If TopLine > 1 Then Begin #72 : If TopLine > 1 Then Begin
Dec (TopLine); Dec (TopLine);
Update; Update;
End; End;
#73, #73,
#75 : If TopLine > 1 Then Begin #75 : If TopLine > 1 Then Begin
Dec (TopLine, WinSize); Dec (TopLine, WinSize);
If TopLine < 1 Then TopLine := 1; If TopLine < 1 Then TopLine := 1;
Update; Update;
End; End;
#79 : If TopLine + WinSize <= Ansi.Lines Then Begin #79 : If TopLine + WinSize <= Ansi.Lines Then Begin
TopLine := Ansi.Lines - WinSize + 1; TopLine := Ansi.Lines - WinSize + 1;
Update; Update;
End; End;
#80 : If TopLine + WinSize <= Ansi.Lines Then Begin #80 : If TopLine + WinSize <= Ansi.Lines Then Begin
Inc (TopLine); Inc (TopLine);
Update; Update;
End; End;
#77, #77,
#81 : If TopLine < Ansi.Lines - WinSize Then Begin #81 : If TopLine < Ansi.Lines - WinSize Then Begin
Inc (TopLine, WinSize); Inc (TopLine, WinSize);
If TopLine + WinSize > Ansi.Lines Then TopLine := Ansi.Lines - WinSize + 1; If TopLine + WinSize > Ansi.Lines Then TopLine := Ansi.Lines - WinSize + 1;
Update; Update;
End; End;
End; End;
@ -1687,6 +1695,14 @@ Begin
ReDraw; ReDraw;
End; End;
'P' : If TopLine < Ansi.Lines - WinSize Then Begin
Inc (TopLine, WinSize);
If TopLine + WinSize > Ansi.Lines Then TopLine := Ansi.Lines - WinSize + 1;
Update;
End;
'N',
#13 : If TopLine < Ansi.Lines - WinSize Then Begin #13 : If TopLine < Ansi.Lines - WinSize Then Begin
Inc (TopLine, WinSize); Inc (TopLine, WinSize);
@ -1701,7 +1717,7 @@ Begin
Ansi.Free; Ansi.Free;
Session.io.AnsiGotoXY(1, Session.User.ThisUser.ScreenSize); Session.io.AnsiGotoXY (1, Session.User.ThisUser.ScreenSize);
End; End;
End. End.

View File

@ -323,10 +323,12 @@ Begin
Session.io.OutFull (Session.GetPrompt(271)); Session.io.OutFull (Session.GetPrompt(271));
End; End;
'L' : If Session.io.GetPW (Session.GetPrompt(272), Session.GetPrompt(423), Config.MatrixPW) Then Begin 'L' : If Session.io.GetPW (Session.GetPrompt(272), Session.GetPrompt(423), Config.MatrixPW) Then Begin
// If Session.User.GetMatrixUser Then Begin If Session.User.GetMatrixUser Then Begin
Session.User.MatrixOK := True; Session.User.MatrixOK := True;
Result := True; Result := True;
// End; End;
// DEBUG FIX ABOVE COMMENT OUT GETMATRIXUSER
End; End;
'P' : {$IFNDEF UNIX} If Session.User.GetMatrixUser Then 'P' : {$IFNDEF UNIX} If Session.User.GetMatrixUser Then
PageForSysopChat (Pos('/F', strUpper(CmdData)) > 0) {$ENDIF}; PageForSysopChat (Pos('/F', strUpper(CmdData)) > 0) {$ENDIF};

View File

@ -1248,7 +1248,7 @@ Begin
Set_Node_Action (Session.GetPrompt(349)); Set_Node_Action (Session.GetPrompt(349));
IsPrivate := ReplyBase.Flags AND MBPrivate <> 0; IsPrivate := (ReplyBase.Flags AND MBPrivate <> 0) or (ReplyBase.NetType = 3);
If (ReplyBase.Flags AND MBPrivate = 0) AND (ReplyBase.Flags AND MBPrivReply <> 0) Then If (ReplyBase.Flags AND MBPrivate = 0) AND (ReplyBase.Flags AND MBPrivReply <> 0) Then
IsPrivate := Session.io.GetYN(Session.GetPrompt(514), False); IsPrivate := Session.io.GetYN(Session.GetPrompt(514), False);
@ -1263,7 +1263,7 @@ Begin
If ToWho = '' Then Exit; If ToWho = '' Then Exit;
If Not (Email or IsPrivate) Then Break; If (ReplyBase.NetType = 3) Or Not (Email or IsPrivate) Then Break;
If Not Session.User.FindUser(ToWho, False) Then Begin If Not Session.User.FindUser(ToWho, False) Then Begin
Session.io.PromptInfo[1] := ToWho; Session.io.PromptInfo[1] := ToWho;
@ -2801,10 +2801,11 @@ Begin
If Not (Mode in ['B', 'T', 'S', 'E', 'F', 'G', 'N', 'P', 'Y']) Then Begin If Not (Mode in ['B', 'T', 'S', 'E', 'F', 'G', 'N', 'P', 'Y']) Then Begin
Session.io.OutFull (Session.GetPrompt(112)); Session.io.OutFull (Session.GetPrompt(112));
Mode := Session.io.OneKey('BFNSYQ', True); Mode := Session.io.OneKey(#13 + 'BFNSYQ', True);
End; End;
Case Mode of Case Mode of
#13 : Mode := 'F';
'Q' : Exit; 'Q' : Exit;
'S' : If SearchStr = '' Then Begin 'S' : If SearchStr = '' Then Begin
Session.io.OutFull (Session.GetPrompt(396)); Session.io.OutFull (Session.GetPrompt(396));
@ -3255,7 +3256,7 @@ Var
Begin Begin
Session.io.OutFull (Session.GetPrompt(458)); Session.io.OutFull (Session.GetPrompt(458));
InDate := Session.io.GetInput(8, 8, 15, ''); InDate := Session.io.GetInput(8, 8, 15, DateDos2Str(CurDateDos, Session.User.ThisUser.DateType));
If Not DateValid(InDate) Then Exit; If Not DateValid(InDate) Then Exit;
@ -4603,3 +4604,18 @@ Begin
End; End;
End. End.
// need one of these for the file list compiler now too which MAYBE can be
// used in MUTIL also. lets template and build that out first.. then...
// create and upload QWK/REP packets without relying on BBS specific stuff
Type
TMsgBaseQWK = Class
User : RecUser;
Extended : Boolean;
Constructor Create (UD: RecUser; Ext: Boolean);
Function CreatePacket : Boolean;
Function ProcessReplies : Boolean;
Destructor Destroy; Override;
End;

View File

@ -83,7 +83,8 @@ Begin
Close (ChatFile); Close (ChatFile);
{$IFDEF WINDOWS} {$IFDEF WINDOWS}
Screen.SetWindowTitle (WinConsoleTitle + strI2S(Session.NodeNum) + ' - ' + Session.User.ThisUser.Handle + ' - ' + strStripPipe(Action)); Screen.SetWindowTitle (Config.BBSName + ' Node ' + strI2S(Session.NodeNum) + ' : ' + Session.User.ThisUser.Handle + ' : ' + strStripPipe(Action));
// Screen.SetWindowTitle (WinConsoleTitle + strI2S(Session.NodeNum) + ' - ' + Session.User.ThisUser.Handle + ' - ' + strStripPipe(Action));
{$ENDIF} {$ENDIF}
End; End;
@ -293,4 +294,4 @@ Begin
Session.InMessage := False; Session.InMessage := False;
End; End;
End. End.

View File

@ -129,6 +129,7 @@ Function TBBSUser.Access (Str: String) : Boolean;
Const Const
OpCmds = ['%', '^', '(', ')', '&', '!', '|']; OpCmds = ['%', '^', '(', ')', '&', '!', '|'];
AcsCmds = ['A', 'D', 'E', 'F', 'G', 'H', 'M', 'N', 'O', 'S', 'T', 'U', 'W', 'Z']; AcsCmds = ['A', 'D', 'E', 'F', 'G', 'H', 'M', 'N', 'O', 'S', 'T', 'U', 'W', 'Z'];
Var Var
Key : Char; Key : Char;
Data : String; Data : String;
@ -156,6 +157,7 @@ Var
First := True; First := True;
Check := False; Check := False;
Data := ''; Data := '';
Exit; Exit;
End Else End Else
Res := ThisUser.LastMGroup = strS2I(Data); Res := ThisUser.LastMGroup = strS2I(Data);
@ -166,17 +168,17 @@ Var
'A' : Res := Chat.Available; 'A' : Res := Chat.Available;
'I' : Res := Chat.Invisible; 'I' : Res := Chat.Invisible;
'K' : Res := AcsOkFlag; 'K' : Res := AcsOkFlag;
'N' : Res := Session.LastScanHadNew;
'M' : Begin 'M' : Begin
Res := Access(Session.Msgs.MBase.SysopACS); Res := Access(Session.Msgs.MBase.SysopACS);
If Session.Msgs.Reading Then If Session.Msgs.Reading Then
Res := Res or IsThisUser(Session.msgs.MsgBase^.GetFrom); Res := Res or IsThisUser(Session.msgs.MsgBase^.GetFrom);
End; End;
'N' : Res := Session.LastScanHadNew;
'P' : If (ThisUser.Calls > 0) And (ThisUser.Flags AND UserNoRatio = 0) Then Begin 'P' : If (ThisUser.Calls > 0) And (ThisUser.Flags AND UserNoRatio = 0) Then Begin
Temp1 := Round(Security.PCRatio / 100 * 100); Temp1 := Round(Security.PCRatio / 100 * 100);
Temp2 := Round(ThisUser.Posts / ThisUser.Calls * 100); Temp2 := Round(ThisUser.Posts / ThisUser.Calls * 100);
Res := (Temp2 >= Temp1); Res := (Temp2 >= Temp1);
End Else End Else
Res := True; Res := True;
'Y' : Res := Session.LastScanHadYou; 'Y' : Res := Session.LastScanHadYou;
@ -189,12 +191,16 @@ Var
Check := False; Check := False;
First := True; First := True;
Data := ''; Data := '';
Exit; Exit;
End Else End Else
Res := strS2I(Data) = ThisUser.LastFGroup; Res := strS2I(Data) = ThisUser.LastFGroup;
End; End;
If Res Then Out := Out + '^' Else Out := Out + '%'; If Res Then
Out := Out + '^'
Else
Out := Out + '%';
Check := False; Check := False;
First := True; First := True;
@ -202,12 +208,13 @@ Var
End; End;
Var Var
A : Byte; Count : Byte;
Paran1 : Byte; Paran1 : Byte;
Paran2 : Byte; Paran2 : Byte;
Ch1 : Char; Ch1 : Char;
Ch2 : Char; Ch2 : Char;
S1 : String; S1 : String;
Begin Begin
Data := ''; Data := '';
Out := ''; Out := '';
@ -215,54 +222,61 @@ Begin
Str := strUpper(Str); Str := strUpper(Str);
First := True; First := True;
For A := 1 to Length(Str) Do For Count := 1 to Length(Str) Do
If Str[A] in OpCmds Then Begin If Str[Count] in OpCmds Then Begin
If Check Then CheckCommand; If Check Then CheckCommand;
Out := Out + Str[A]; Out := Out + Str[Count];
End Else End Else
If (Str[A] in AcsCmds) and (First or Check) Then Begin If (Str[Count] in AcsCmds) and (First or Check) Then Begin
If Check Then CheckCommand; If Check Then CheckCommand;
Key := Str[A]; Key := Str[Count];
If First Then First := False; If First Then First := False;
End Else Begin End Else Begin
Data := Data + Str[A]; Data := Data + Str[Count];
Check := True; Check := True;
If A = Length(Str) Then CheckCommand;
If Count = Length(Str) Then CheckCommand;
End; End;
Out := '(' + Out + ')'; Out := '(' + Out + ')';
While Pos('&', Out) <> 0 Do Delete (Out, Pos('&', Out), 1); While Pos('&', Out) <> 0 Do Delete
(Out, Pos('&', Out), 1);
While Pos('(', Out) <> 0 Do Begin While Pos('(', Out) <> 0 Do Begin
Paran2 := 1; Paran2 := 1;
While ((Out[Paran2] <> ')') And (Paran2 <= Length(Out))) Do Begin While ((Out[Paran2] <> ')') And (Paran2 <= Length(Out))) Do Begin
If (Out[Paran2] = '(') Then Paran1 := Paran2; If (Out[Paran2] = '(') Then Paran1 := Paran2;
Inc (Paran2); Inc (Paran2);
End; End;
S1 := Copy(Out, Paran1 + 1, (Paran2 - Paran1) - 1); S1 := Copy(Out, Paran1 + 1, (Paran2 - Paran1) - 1);
While Pos('!', S1) <> 0 Do Begin While Pos('!', S1) <> 0 Do Begin
A := Pos('!', S1) + 1; Count := Pos('!', S1) + 1;
If S1[A] = '^' Then S1[A] := '%' Else
If S1[A] = '%' Then S1[A] := '^'; If S1[Count] = '^' Then S1[Count] := '%' Else
Delete (S1, A - 1, 1); If S1[Count] = '%' Then S1[Count] := '^';
Delete (S1, Count - 1, 1);
End; End;
While Pos('|', S1) <> 0 Do Begin While Pos('|', S1) <> 0 Do Begin
A := Pos('|', S1) - 1; Count := Pos('|', S1) - 1;
Ch1 := S1[A]; Ch1 := S1[Count];
Ch2 := S1[A + 2]; Ch2 := S1[Count + 2];
If (Ch1 in ['%', '^']) and (Ch2 in ['%', '^']) Then Begin If (Ch1 in ['%', '^']) and (Ch2 in ['%', '^']) Then Begin
Delete (S1, A, 3); Delete (S1, Count, 3);
If (Ch1 = '^') or (Ch2 = '^') Then If (Ch1 = '^') or (Ch2 = '^') Then
Insert ('^', S1, A) Insert ('^', S1, Count)
Else Else
Insert ('%', S1, A) Insert ('%', S1, Count)
End Else End Else
Delete (S1, A + 1, 1); Delete (S1, Count + 1, 1);
End; End;
While Pos('%%', S1) <> 0 Do Delete (S1, Pos('%%', S1), 1); While Pos('%%', S1) <> 0 Do Delete (S1, Pos('%%', S1), 1);
@ -328,7 +342,7 @@ Function TBBSUser.FindUser (Str: String; Adjust: Boolean) : Boolean;
Var Var
RecNum : LongInt; RecNum : LongInt;
Begin Begin
FindUser := False; Result := False;
If Str = '' Then Exit; If Str = '' Then Exit;
@ -340,10 +354,11 @@ Begin
While Not Eof(UserFile) Do Begin While Not Eof(UserFile) Do Begin
Read (UserFile, TempUser); Read (UserFile, TempUser);
If ((TempUser.PermIdx = RecNum) or (strUpper(TempUser.RealName) = Str) or (strUpper(TempUser.Handle) = Str)) and (TempUser.Flags And UserDeleted = 0) Then Begin If (((RecNum > 0) And (TempUser.PermIdx = RecNum)) or (strUpper(TempUser.RealName) = Str) or (strUpper(TempUser.Handle) = Str)) and (TempUser.Flags And UserDeleted = 0) Then Begin
If Adjust Then UserNum := FilePos(UserFile); If Adjust Then UserNum := FilePos(UserFile);
FindUser := True; Result := True;
Break; Break;
End; End;
End; End;
@ -359,7 +374,8 @@ Begin
Result := False; Result := False;
If UserNum <> -1 Then Begin If UserNum <> -1 Then Begin
GetMatrixUser := True; Result := True;
Exit; Exit;
End; End;
@ -427,6 +443,7 @@ Var
Begin Begin
If Session.Theme.Flags AND ThmAllowANSI = 0 Then Begin If Session.Theme.Flags AND ThmAllowANSI = 0 Then Begin
Session.io.Graphics := 0; Session.io.Graphics := 0;
Exit; Exit;
End; End;
@ -436,6 +453,7 @@ Begin
Session.io.Graphics := 1 Session.io.Graphics := 1
Else Begin Else Begin
Session.Client.PurgeInputData(100); Session.Client.PurgeInputData(100);
Session.io.OutRaw (#27 + '[6n'); Session.io.OutRaw (#27 + '[6n');
Session.io.BufFlush; Session.io.BufFlush;
@ -443,6 +461,7 @@ Begin
If Session.Client.WaitForData(1000) > 0 Then If Session.Client.WaitForData(1000) > 0 Then
If Session.Client.ReadChar in [#27, '[', '0'..'9', ';', 'R'] Then Begin If Session.Client.ReadChar in [#27, '[', '0'..'9', ';', 'R'] Then Begin
Session.io.Graphics := 1; Session.io.Graphics := 1;
Break; Break;
End; End;
End; End;
@ -457,6 +476,7 @@ End;
Procedure TBBSUser.GetGraphics; Procedure TBBSUser.GetGraphics;
Begin Begin
Session.io.OutFull (Session.GetPrompt(154)); Session.io.OutFull (Session.GetPrompt(154));
Session.io.Graphics := strS2I(Session.io.OneKey('01', True)); Session.io.Graphics := strS2I(Session.io.OneKey('01', True));
End; End;
@ -535,12 +555,16 @@ Begin
While Not Eof(tFile) Do Begin While Not Eof(tFile) Do Begin
ReadLn (tFile, Str); ReadLn (tFile, Str);
If strUpper(Str) = Name Then Begin If strUpper(Str) = Name Then Begin
Result := True; Result := True;
Session.io.OutFullLn (Session.GetPrompt(309)); Session.io.OutFullLn (Session.GetPrompt(309));
Break; Break;
End; End;
End; End;
Close (tFile); Close (tFile);
End; End;
@ -550,7 +574,9 @@ Var
Begin Begin
Repeat Repeat
Session.io.OutFull (Session.GetPrompt(6)); Session.io.OutFull (Session.GetPrompt(6));
Str := strStripB(Session.io.GetInput(30, 30, 18, ''), ' '); Str := strStripB(Session.io.GetInput(30, 30, 18, ''), ' ');
If Pos(' ', Str) = 0 Then Begin If Pos(' ', Str) = 0 Then Begin
Session.io.OutFullLn (Session.GetPrompt(7)); Session.io.OutFullLn (Session.GetPrompt(7));
Str := ''; Str := '';
@ -574,7 +600,9 @@ Var
Begin Begin
Repeat Repeat
Session.io.OutFull (Session.GetPrompt(9)); Session.io.OutFull (Session.GetPrompt(9));
Str := strStripB(Session.io.GetInput(30, 30, 18, Def), ' '); Str := strStripB(Session.io.GetInput(30, 30, 18, Def), ' ');
If Check_Trash(Str) Then If Check_Trash(Str) Then
Str := '' Str := ''
Else Else
@ -655,6 +683,7 @@ Begin
Else Else
Str := Session.io.GetInput(15, 15, 12, Str); Str := Session.io.GetInput(15, 15, 12, Str);
Until (Length(Str) = 12) or (Not Config.UseUSAPhone and (Str <> '')); Until (Length(Str) = 12) or (Not Config.UseUSAPhone and (Str <> ''));
ThisUser.HomePhone := Str; ThisUser.HomePhone := Str;
End; End;
@ -674,6 +703,7 @@ Begin
Else Else
Str := Session.io.GetInput(15, 15, 12, Str); Str := Session.io.GetInput(15, 15, 12, Str);
Until (Length(Str) = 12) or (Not Config.UseUSAPhone and (Str <> '')); Until (Length(Str) = 12) or (Not Config.UseUSAPhone and (Str <> ''));
ThisUser.DataPhone := Str; ThisUser.DataPhone := Str;
End; End;
@ -689,6 +719,7 @@ Begin
Session.io.OutFull (Session.GetPrompt(15)); Session.io.OutFull (Session.GetPrompt(15));
Str := Session.io.GetInput(8, 8, 15, ''); Str := Session.io.GetInput(8, 8, 15, '');
Until Length(Str) = 8; Until Length(Str) = 8;
ThisUser.Birthday := DateStr2Julian(Str); ThisUser.Birthday := DateStr2Julian(Str);
End; End;
@ -765,7 +796,9 @@ Var
Begin Begin
If Edit Then Begin If Edit Then Begin
Session.io.OutFull(Session.GetPrompt(151)); Session.io.OutFull(Session.GetPrompt(151));
Str1 := Session.io.GetInput(15, 15, 16, ''); Str1 := Session.io.GetInput(15, 15, 16, '');
If Str1 <> ThisUser.Password Then Begin If Str1 <> ThisUser.Password Then Begin
Session.io.OutFullLn (Session.GetPrompt(418)); Session.io.OutFullLn (Session.GetPrompt(418));
Exit; Exit;
@ -820,13 +853,18 @@ Begin
Session.io.OutFullLn (Session.GetPrompt(182)); Session.io.OutFullLn (Session.GetPrompt(182));
Reset (Session.ThemeFile); Reset (Session.ThemeFile);
Repeat Repeat
Read (Session.ThemeFile, Session.Theme); Read (Session.ThemeFile, Session.Theme);
If ((Session.Theme.Flags AND ThmAllowASCII = 0) and (Session.io.Graphics = 0)) or If ((Session.Theme.Flags AND ThmAllowASCII = 0) and (Session.io.Graphics = 0)) or
((Session.Theme.Flags AND ThmAllowANSI = 0) and (Session.io.Graphics = 1)) Then Continue; ((Session.Theme.Flags AND ThmAllowANSI = 0) and (Session.io.Graphics = 1)) Then Continue;
Inc (T); Inc (T);
Session.io.PromptInfo[1] := strI2S(T); Session.io.PromptInfo[1] := strI2S(T);
Session.io.PromptInfo[2] := Session.Theme.Desc; Session.io.PromptInfo[2] := Session.Theme.Desc;
Session.io.OutFullLn (Session.GetPrompt(183)); Session.io.OutFullLn (Session.GetPrompt(183));
Until Eof(Session.ThemeFile); Until Eof(Session.ThemeFile);
@ -839,17 +877,22 @@ Begin
If (A < 1) or (A > T) Then A := 1; If (A < 1) or (A > T) Then A := 1;
T := 0; T := 0;
Reset (Session.ThemeFile); Reset (Session.ThemeFile);
Repeat Repeat
Read (Session.ThemeFile, Session.Theme); Read (Session.ThemeFile, Session.Theme);
If ((Session.Theme.Flags AND ThmAllowASCII = 0) and (Session.io.Graphics = 0)) or If ((Session.Theme.Flags AND ThmAllowASCII = 0) and (Session.io.Graphics = 0)) or
((Session.Theme.Flags AND ThmAllowANSI = 0) and (Session.io.Graphics = 1)) Then Continue; ((Session.Theme.Flags AND ThmAllowANSI = 0) and (Session.io.Graphics = 1)) Then Continue;
Inc (T); Inc (T);
Until T = A; Until T = A;
{ Close (Session.LangFile);} { Close (Session.LangFile);}
If Not Session.LoadThemeData(Session.Theme.FileName) Then Begin If Not Session.LoadThemeData(Session.Theme.FileName) Then Begin
Session.io.OutFullLn (Session.GetPrompt(185)); Session.io.OutFullLn (Session.GetPrompt(185));
Session.Theme := Old; Session.Theme := Old;
End Else End Else
ThisUser.Theme := Session.Theme.FileName; ThisUser.Theme := Session.Theme.FileName;
@ -859,6 +902,7 @@ Procedure TBBSUser.CreateNewUser (DefName: String);
Begin Begin
If Not Config.AllowNewUsers Then Begin If Not Config.AllowNewUsers Then Begin
Session.io.OutFile ('nonewusr', True, 0); Session.io.OutFile ('nonewusr', True, 0);
Halt(0); Halt(0);
End; End;
@ -1061,16 +1105,22 @@ Begin
{ Check for forced voting questions } { Check for forced voting questions }
Reset (Session.VoteFile); Reset (Session.VoteFile);
While Not Eof(Session.VoteFile) Do Begin While Not Eof(Session.VoteFile) Do Begin
Read (Session.VoteFile, Session.Vote); Read (Session.VoteFile, Session.Vote);
If Access(Session.Vote.ACS) and Access(Session.Vote.ForceACS) and (ThisUser.Vote[FilePos(Session.VoteFile)] = 0) Then Begin If Access(Session.Vote.ACS) and Access(Session.Vote.ForceACS) and (ThisUser.Vote[FilePos(Session.VoteFile)] = 0) Then Begin
Count := FilePos(Session.VoteFile); Count := FilePos(Session.VoteFile);
Close (Session.VoteFile); Close (Session.VoteFile);
Voting_Booth (True, Count); Voting_Booth (True, Count);
Reset (Session.VoteFile); Reset (Session.VoteFile);
Seek (Session.VoteFile, Count); Seek (Session.VoteFile, Count);
End; End;
End; End;
Close (Session.VoteFile); Close (Session.VoteFile);
{ END forced voting check } { END forced voting check }
@ -1197,7 +1247,9 @@ Begin
If Config.SystemPW <> '' Then If Config.SystemPW <> '' Then
If Not Session.io.GetPW(Session.GetPrompt(4), Session.GetPrompt(417), Config.SystemPW) Then Begin If Not Session.io.GetPW(Session.GetPrompt(4), Session.GetPrompt(417), Config.SystemPW) Then Begin
Session.io.OutFile ('closed', True, 0); Session.io.OutFile ('closed', True, 0);
Session.SystemLog('Failed system password'); Session.SystemLog('Failed system password');
Halt(0); Halt(0);
End; End;
@ -1211,9 +1263,13 @@ Begin
Session.io.Graphics := 1 Session.io.Graphics := 1
Else Begin Else Begin
DetectGraphics; DetectGraphics;
If (Session.io.Graphics = 0) and (Config.DefTermMode = 2) Then GetGraphics; If (Session.io.Graphics = 0) and (Config.DefTermMode = 2) Then GetGraphics;
End; End;
If FileExist(Config.ScriptPath + 'startup.mpx') Then
ExecuteMPL(NIL, 'startup');
If Config.ThemeOnStart Then GetTheme; If Config.ThemeOnStart Then GetTheme;
If (Session.Theme.Flags AND ThmAllowASCII = 0) and (Session.io.Graphics = 0) Then Begin If (Session.Theme.Flags AND ThmAllowASCII = 0) and (Session.io.Graphics = 0) Then Begin
@ -1227,17 +1283,21 @@ Begin
Halt(0); Halt(0);
End; End;
If FileExist(Config.ScriptPath + 'startup.mpx') Then
ExecuteMPL(NIL, 'startup');
If Session.UserLoginName <> '' Then Begin If Session.UserLoginName <> '' Then Begin
// session.systemlog('DEBUG: auto login: ' + session.userloginname);
If Not FindUser(Session.UserLoginName, True) Then If Not FindUser(Session.UserLoginName, True) Then
Halt; Halt;
// session.systemlog('DEBUG: pw check: ' + tempuser.handle);
If strUpper(Session.UserLoginPW) <> TempUser.Password Then Begin If strUpper(Session.UserLoginPW) <> TempUser.Password Then Begin
UserNum := -1; UserNum := -1;
Halt; Halt;
End; End;
ThisUser := TempUser;
End Else Begin End Else Begin
If Config.UseMatrix Then Begin If Config.UseMatrix Then Begin
Repeat Repeat
@ -1248,6 +1308,8 @@ Begin
Session.io.OutFile ('prelogon', True, 0); Session.io.OutFile ('prelogon', True, 0);
If UserNum = -1 Then Begin
Count := 1; Count := 1;
Repeat Repeat
@ -1292,11 +1354,13 @@ Begin
End; End;
ThisUser := TempUser; ThisUser := TempUser;
End;
Session.SystemLog ('User: ' + ThisUser.Handle + ' logged in'); Session.SystemLog ('User: ' + ThisUser.Handle + ' logged in');
If Not Session.LoadThemeData(ThisUser.Theme) Then Begin If Not Session.LoadThemeData(ThisUser.Theme) Then Begin
Session.io.OutFullLn (Session.GetPrompt(186)); Session.io.OutFullLn (Session.GetPrompt(186));
If Session.LoadThemeData(Config.DefThemeFile) Then If Session.LoadThemeData(Config.DefThemeFile) Then
ThisUser.Theme := Config.DefThemeFile; ThisUser.Theme := Config.DefThemeFile;
End; End;
@ -1305,6 +1369,7 @@ Begin
If MPE <> '' Then Begin If MPE <> '' Then Begin
ExecuteMPL(NIL, MPE); ExecuteMPL(NIL, MPE);
Halt; Halt;
End Else End Else
UserLogon3; UserLogon3;

View File

@ -6,7 +6,7 @@
# #
# Language text that begins with "!" will run an MPE program: # Language text that begins with "!" will run an MPE program:
# Example: 000 !askname # Example: 000 !askname
# The above line would execute ASKNAME.MPE from the scripts directory. # The above line would execute ASKNAME.MPX from the scripts directory.
# #
# Language text that begins with "@" will display a display file. # Language text that begins with "@" will display a display file.
# Example: 001 @askname # Example: 001 @askname
@ -155,7 +155,8 @@
066 |CR|12Disconnect after file transfer? |11 066 |CR|12Disconnect after file transfer? |11
; Disconneting in 10 seconds, press a key to abort ; Disconneting in 10 seconds, press a key to abort
067 |CR|09Disconnecting in 10 seconds: Press a key to abort. 067 |CR|09Disconnecting in 10 seconds: Press a key to abort.
068 |CR|12You do not have access to upload here! ; No access to upload to a base
068 |CR|12You do not have access to upload here!|CR|CR|PA
069 |CR|12Illegal filename.|DE|DE|DE 069 |CR|12Illegal filename.|DE|DE|DE
070 |CR|14Searching for duplicate files ... 070 |CR|14Searching for duplicate files ...
071 None found. 071 None found.
@ -217,6 +218,7 @@
109 |CR|15Message aborted... 109 |CR|15Message aborted...
110 |CR|12You must select a message base first! 110 |CR|12You must select a message base first!
111 |CR|12You don't have access to read in this base! 111 |CR|12You don't have access to read in this base!
; Message reading: select read mode
112 |CR|07(|14F|07)|15orward, |07(|14N|07)|15ew, |07(|14B|07)|15y You, |07(|14Y|07)|15ours, |07(|14S|07)|15earch, |07(|14Q|07)|15uit? |XX 112 |CR|07(|14F|07)|15orward, |07(|14N|07)|15ew, |07(|14B|07)|15y You, |07(|14Y|07)|15ours, |07(|14S|07)|15earch, |07(|14Q|07)|15uit? |XX
113 |15No messages found. 113 |15No messages found.
114 |CR|12There are no messages in |MB.|DE|DE|DE 114 |CR|12There are no messages in |MB.|DE|DE|DE

View File

@ -322,6 +322,7 @@ Begin
Dispose (Txt[A]); Dispose (Txt[A]);
End; End;
(*
Procedure CompileLanguageFile; Procedure CompileLanguageFile;
Type Type
PromptRec = String[255]; PromptRec = String[255];
@ -355,6 +356,7 @@ Begin
Close (PromptFile); Close (PromptFile);
Close (InFile); Close (InFile);
End; End;
*)
Procedure CreateDirectories; Procedure CreateDirectories;
Begin Begin
@ -472,7 +474,7 @@ Begin
Close (LangFile); Close (LangFile);
CompileLanguageFile; //CompileLanguageFile;
End; End;
Procedure DoInstall; Procedure DoInstall;

View File

@ -881,13 +881,13 @@ Begin
MBaseFile := TFileBuffer.Create(8192); MBaseFile := TFileBuffer.Create(8192);
If MBaseFile.OpenStream (Config.DataPath + 'mbases.dat', fmOpen, fmRWDN) Then Begin If MBaseFile.OpenStream (Config.DataPath + 'mbases.dat', SizeOf(MBase), fmOpen, fmRWDN) Then Begin
MBaseFile.BlockRead (MBase, SizeOf(MBase)); MBaseFile.ReadRecord (MBase);
While Not MBaseFile.EOF Do Begin While Not MBaseFile.EOF Do Begin
MBaseFile.BlockRead (MBase, SizeOf(MBase)); MBaseFile.ReadRecord (MBase);
Update_Bar (MBaseFile.FilePos, MBaseFile.FileSize); Update_Bar (MBaseFile.FilePosRecord, MBaseFile.FileSizeRecord);
Update_Status (strStripPipe(MBase.Name)); Update_Status (strStripPipe(MBase.Name));
If MBase.NetType <> 1 Then Continue; If MBase.NetType <> 1 Then Continue;
@ -929,6 +929,7 @@ Var
If (TempBase.Index = Idx) and (FilePos(MBaseFile) <> SavedPos) Then Begin If (TempBase.Index = Idx) and (FilePos(MBaseFile) <> SavedPos) Then Begin
Result := True; Result := True;
Break; Break;
End; End;
End; End;
@ -940,7 +941,9 @@ Var
Var Var
TempUser : RecUser; TempUser : RecUser;
Begin Begin
Result := False; Result := Idx = 0;
If Result Then Exit;
// Close (UserFile); // Close (UserFile);
Reset (UserFile); Reset (UserFile);
@ -950,6 +953,7 @@ Var
If (TempUser.PermIdx = Idx) and (FilePos(UserFile) <> SavedPos) Then Begin If (TempUser.PermIdx = Idx) and (FilePos(UserFile) <> SavedPos) Then Begin
Result := True; Result := True;
Break; Break;
End; End;
End; End;
@ -982,6 +986,8 @@ Var
NewIndex : Cardinal; NewIndex : Cardinal;
MaxUser : Cardinal; MaxUser : Cardinal;
Begin Begin
FileMode := 66;
Write ('Fixing Indexes :'); Write ('Fixing Indexes :');
Assign (ConfigFile, 'mystic.dat'); Assign (ConfigFile, 'mystic.dat');
@ -1068,7 +1074,7 @@ Begin
Update_Bar (FilePos(UserFile), FileSize(UserFile)); Update_Bar (FilePos(UserFile), FileSize(UserFile));
If IsDupeUserIndex(FilePos(UserFile), User.PermIdx) Then Begin If IsDupeUserIndex(FilePos(UserFile), User.PermIdx) Then Begin
NewIndex := 0; NewIndex := 1;
While IsDupeUserIndex(FilePos(UserFile), NewIndex) Do While IsDupeUserIndex(FilePos(UserFile), NewIndex) Do
Inc (NewIndex); Inc (NewIndex);

View File

@ -55,7 +55,7 @@
; For rootpath, you need to include the directory where the MYSTIC binary ; For rootpath, you need to include the directory where the MYSTIC binary
; exists. ; exists.
rootpath = c:\mystic\ rootpath = \dev\code\mystic\
username = guest username = g00r00
password = guest password = asdf

View File

@ -81,12 +81,12 @@ Var
Begin Begin
FileConfig := TFileBuffer.Create(SizeOf(RecConfig)); FileConfig := TFileBuffer.Create(SizeOf(RecConfig));
If Not FileConfig.OpenStream ('mystic.dat', fmOpen, fmRWDN) Then Begin If Not FileConfig.OpenStream ('mystic.dat', 1, fmOpen, fmRWDN) Then Begin
DatLoc := GetEnv('mysticbbs'); DatLoc := GetEnv('mysticbbs');
If DatLoc <> '' Then DatLoc := DirSlash(DatLoc); If DatLoc <> '' Then DatLoc := DirSlash(DatLoc);
If Not FileConfig.OpenStream (DatLoc + 'mystic.dat', fmOpen, fmRWDN) Then Begin If Not FileConfig.OpenStream (DatLoc + 'mystic.dat', 1, fmOpen, fmRWDN) Then Begin
If Not DaemonMode Then Begin If Not DaemonMode Then Begin
Console.WriteLine (#13#10 + 'ERROR: Unable to read MYSTIC.DAT. This file must exist in the same'); Console.WriteLine (#13#10 + 'ERROR: Unable to read MYSTIC.DAT. This file must exist in the same');
Console.WriteLine ('directory as MIS'); Console.WriteLine ('directory as MIS');
@ -101,7 +101,7 @@ Begin
End; End;
End; End;
FileConfig.BlockRead (bbsConfig, SizeOf(bbsConfig)); FileConfig.ReadBlock (bbsConfig, SizeOf(bbsConfig));
FileConfig.Free; FileConfig.Free;
If bbsConfig.DataChanged <> mysDataChanged Then Begin If bbsConfig.DataChanged <> mysDataChanged Then Begin
@ -109,12 +109,6 @@ Begin
Halt(1); Halt(1);
End; End;
TempPath := bbsConfig.SystemPath + 'temp0' + PathChar;
{$I-} MkDir (TempPath); {$I+}
If IoResult <> 0 Then;
DirChange(bbsConfig.SystemPath); DirChange(bbsConfig.SystemPath);
End; End;
@ -260,13 +254,13 @@ Var
Begin Begin
Console.TextAttr := 7; Console.TextAttr := 7;
Console.ClearScreen; Console.ClearScreen;
Console.WriteStr ('Connecting to 127.0.0.1... '); // Console.WriteStr ('Connecting to 127.0.0.1... ');
Client := TIOSocket.Create; Client := TIOSocket.Create;
Client.FTelnetClient := True; Client.FTelnetClient := True;
If Not Client.Connect('127.0.0.1', bbsConfig.InetTNPort) Then If Not Client.Connect(bbsConfig.inetInterface{'127.0.0.1'}, bbsConfig.InetTNPort) Then
Console.WriteLine('Unable to connect') Console.WriteLine('Unable to connect')
Else Begin Else Begin
Done := False; Done := False;
@ -403,6 +397,10 @@ Begin
{$IFDEF UNIX} {$IFDEF UNIX}
SetUserOwner; SetUserOwner;
{$ENDIF} {$ENDIF}
TempPath := bbsConfig.SystemPath + 'temp0' + PathChar;
DirCreate(TempPath);
End; End;
{$IFDEF UNIX} {$IFDEF UNIX}

View File

@ -350,14 +350,14 @@ Begin
FBaseFile := TFileBuffer.Create(FileBufSize); FBaseFile := TFileBuffer.Create(FileBufSize);
If FBaseFile.OpenStream (bbsConfig.DataPath + 'fbases.dat', fmOpen, fmRWDN) Then Begin If FBaseFile.OpenStream (bbsConfig.DataPath + 'fbases.dat', SizeOf(TempBase), fmOpen, fmRWDN) Then Begin
Found := False; Found := False;
While Not FBaseFile.EOF Do Begin While Not FBaseFile.EOF Do Begin
FBaseFile.BlockRead(TempBase, SizeOf(TempBase)); FBaseFile.ReadRecord (TempBase);
If (strUpper(TempBase.FtpName) = strUpper(Data)) and ValidDirectory(TempBase) Then Begin If (strUpper(TempBase.FtpName) = strUpper(Data)) and ValidDirectory(TempBase) Then Begin
Result := FBaseFile.FilePos; Result := FBaseFile.FilePosRecord;
Found := True; Found := True;
Break; Break;
End; End;
@ -537,9 +537,9 @@ Begin
DirFile := TFileBuffer.Create(FileBufSize); DirFile := TFileBuffer.Create(FileBufSize);
If DirFile.OpenStream (bbsConfig.DataPath + TempBase.FileName + '.dir', fmOpenCreate, fmRWDN) Then Begin If DirFile.OpenStream (bbsConfig.DataPath + TempBase.FileName + '.dir', SizeOf(RecFileList), fmOpenCreate, fmRWDN) Then Begin
While Not DirFile.EOF Do Begin While Not DirFile.EOF Do Begin
DirFile.BlockRead(Dir, SizeOf(RecFileList)); DirFile.ReadRecord (Dir);
If (Dir.Flags And FDirDeleted <> 0) Then Continue; If (Dir.Flags And FDirDeleted <> 0) Then Continue;
If (Dir.Flags And FDirInvalid <> 0) And (Not CheckAccess(User, True, bbsConfig.AcsSeeUnvalid)) Then Continue; If (Dir.Flags And FDirInvalid <> 0) And (Not CheckAccess(User, True, bbsConfig.AcsSeeUnvalid)) Then Continue;
@ -592,9 +592,9 @@ Begin
FBaseFile := TFileBuffer.Create(FileBufSize); FBaseFile := TFileBuffer.Create(FileBufSize);
If FBaseFile.OpenStream (bbsConfig.DataPath + 'fbases.dat', fmOpen, fmRWDN) Then Begin If FBaseFile.OpenStream (bbsConfig.DataPath + 'fbases.dat', SizeOf(RecFileBase), fmOpen, fmRWDN) Then Begin
While Not FBaseFile.EOF Do Begin While Not FBaseFile.EOF Do Begin
FBaseFile.BlockRead(TempBase, SizeOf(RecFileBase)); FBaseFile.ReadRecord (TempBase);
If ValidDirectory(TempBase) and WildMatch(FileMask, TempBase.FtpName, False) Then If ValidDirectory(TempBase) and WildMatch(FileMask, TempBase.FtpName, False) Then
DataSocket.WriteLine('drwxr-xr-x 1 ftp ftp 0 Jul 11 23:35 ' + TempBase.FtpName) DataSocket.WriteLine('drwxr-xr-x 1 ftp ftp 0 Jul 11 23:35 ' + TempBase.FtpName)
@ -612,9 +612,9 @@ Begin
DirFile := TFileBuffer.Create(FileBufSize); DirFile := TFileBuffer.Create(FileBufSize);
If DirFile.OpenStream (bbsConfig.DataPath + TempBase.FileName + '.dir', fmOpenCreate, fmRWDN) Then Begin If DirFile.OpenStream (bbsConfig.DataPath + TempBase.FileName + '.dir', SizeOf(RecFileList), fmOpenCreate, fmRWDN) Then Begin
While Not DirFile.EOF Do Begin While Not DirFile.EOF Do Begin
DirFile.BlockRead(Dir, SizeOf(RecFileList)); DirFile.ReadRecord (Dir);
If (Dir.Flags And FDirDeleted <> 0) Then Continue; If (Dir.Flags And FDirDeleted <> 0) Then Continue;
If (Dir.Flags and FDirOffline <> 0) And (Not CheckAccess(User, True, bbsConfig.AcsSeeOffline)) Then Continue; If (Dir.Flags and FDirOffline <> 0) And (Not CheckAccess(User, True, bbsConfig.AcsSeeOffline)) Then Continue;
@ -656,12 +656,12 @@ Begin
DirFile := TFileBuffer.Create(FileBufSize); DirFile := TFileBuffer.Create(FileBufSize);
Found := -1; Found := -1;
If DirFile.OpenStream (bbsConfig.DataPath + TempBase.FileName + '.dir', fmOpenCreate, fmRWDN) Then Begin If DirFile.OpenStream (bbsConfig.DataPath + TempBase.FileName + '.dir', SizeOf(RecFileList), fmOpenCreate, fmRWDN) Then Begin
While Not DirFile.EOF Do Begin While Not DirFile.EOF Do Begin
DirFile.BlockRead (Dir, SizeOf(RecFileList)); DirFile.ReadRecord (Dir);
If WildMatch(FileMask, Dir.FileName, False) Then Begin If WildMatch(FileMask, Dir.FileName, False) Then Begin
Found := DirFile.FilePos; Found := DirFile.FilePosRecord;
Break; Break;
End; End;
End; End;

View File

@ -59,7 +59,7 @@ Uses
bbs_MsgBase_Squish; bbs_MsgBase_Squish;
Const Const
FileReadBuffer = 2048; FileReadBuffer = 8 * 1024;
HackThreshold = 10000; HackThreshold = 10000;
re_Greeting = '200 Mystic BBS NNTP server ready'; re_Greeting = '200 Mystic BBS NNTP server ready';
@ -170,11 +170,11 @@ Begin
MBaseFile := TFileBuffer.Create(FileReadBuffer); MBaseFile := TFileBuffer.Create(FileReadBuffer);
If MBaseFile.OpenStream (bbsConfig.DataPath + 'mbases.dat', fmOpen, fmRWDN) Then Begin If MBaseFile.OpenStream (bbsConfig.DataPath + 'mbases.dat', SizeOf(TempBase), fmOpen, fmRWDN) Then Begin
MBaseFile.BlockRead(TempBase, SizeOf(TempBase)); MBaseFile.ReadRecord (TempBase);
While Not MBaseFile.EOF Do Begin While Not MBaseFile.EOF Do Begin
MBaseFile.BlockRead(TempBase, SizeOf(TempBase)); MBaseFile.ReadRecord (TempBase);
If (TempBase.NewsName = Data) and CheckAccess(User, True, TempBase.ReadACS) Then Begin If (TempBase.NewsName = Data) and CheckAccess(User, True, TempBase.ReadACS) Then Begin
Found := True; Found := True;
@ -196,7 +196,7 @@ Begin
Dispose (MsgBase, Done); Dispose (MsgBase, Done);
MBase := TempBase; MBase := TempBase;
MBasePos := MBaseFile.FilePos; MBasePos := MBaseFile.FilePosRecord;
CurArticle := 0; // does GROUP reset cur article? find out CurArticle := 0; // does GROUP reset cur article? find out
ClientWriteLine('211 ' + strI2S(Active) + ' ' + strI2S(Low) + ' ' + strI2S(High) + ' ' + TempBase.NewsName); ClientWriteLine('211 ' + strI2S(Active) + ' ' + strI2S(Low) + ' ' + strI2S(High) + ' ' + TempBase.NewsName);
@ -243,11 +243,11 @@ Begin
MBaseFile := TFileBuffer.Create(FileReadBuffer); MBaseFile := TFileBuffer.Create(FileReadBuffer);
If MBaseFile.OpenStream (bbsConfig.DataPath + 'mbases.dat', fmOpen, fmRWDN) Then Begin If MBaseFile.OpenStream (bbsConfig.DataPath + 'mbases.dat', SizeOf(TempBase), fmOpen, fmRWDN) Then Begin
MBaseFile.BlockRead(TempBase, SizeOf(TempBase)); MBaseFile.ReadRecord (TempBase);
While Not MBaseFile.EOF Do Begin While Not MBaseFile.EOF Do Begin
MBaseFile.BlockRead(TempBase, SizeOf(TempBase)); MBaseFile.ReadRecord (TempBase);
If TempBase.NewsName = '' Then Continue; If TempBase.NewsName = '' Then Continue;

View File

@ -4,8 +4,14 @@ Unit MIS_Client_Telnet;
Interface Interface
{$IFNDEF CPUARM} {$IFDEF DARWIN}
{$IFDEF LINUX} {$DEFINE USEPROCESS}
{$ELSE}
{$IFDEF UNIX}
{$DEFINE USEFORK}
{$ENDIF}
{$IFDEF USEFORK}
{$IFDEF CPU32} {$IFDEF CPU32}
{$LinkLib libutil.a} {$LinkLib libutil.a}
{$ENDIF} {$ENDIF}
@ -16,7 +22,7 @@ Interface
{$ENDIF} {$ENDIF}
Uses Uses
{$IFDEF DARWIN} {$IFDEF USEPROCESS}
Process, Process,
m_DateTime, m_DateTime,
{$ENDIF} {$ENDIF}
@ -35,7 +41,7 @@ Uses
MIS_NodeData, MIS_NodeData,
MIS_Server; MIS_Server;
{$IFDEF LINUX} {$IFDEF USEFORK}
function forkpty(__amaster:Plongint; __name:Pchar; __termp:Pointer; __winp:Pointer):longint;cdecl;external 'c' name 'forkpty'; function forkpty(__amaster:Plongint; __name:Pchar; __termp:Pointer; __winp:Pointer):longint;cdecl;external 'c' name 'forkpty';
{$ENDIF} {$ENDIF}
@ -121,7 +127,7 @@ Begin
End; End;
{$ENDIF} {$ENDIF}
{$IFDEF LINUX} {$IFDEF USEFORK}
Procedure TTelnetServer.Execute; Procedure TTelnetServer.Execute;
Var Var
Num : LongInt; Num : LongInt;
@ -201,7 +207,7 @@ Begin
End; End;
{$ENDIF} {$ENDIF}
{$IFDEF DARWIN} {$IFDEF USEPROCESS}
Procedure TTelnetServer.Execute; Procedure TTelnetServer.Execute;
Var Var
Cmd : String; Cmd : String;

View File

@ -38,14 +38,14 @@ Begin
UserFile := TFileBuffer.Create (8 * 1024); UserFile := TFileBuffer.Create (8 * 1024);
If UserFile.OpenStream (bbsConfig.DataPath + 'users.dat', fmOpen, fmRWDN) Then If UserFile.OpenStream (bbsConfig.DataPath + 'users.dat', SizeOf(RecUser), fmOpen, fmRWDN) Then
While Not UserFile.EOF Do Begin While Not UserFile.EOF Do Begin
UserFile.BlockRead(Rec, SizeOf(Rec)); UserFile.ReadRecord (Rec);
If Rec.Flags AND UserDeleted <> 0 Then Continue; If Rec.Flags AND UserDeleted <> 0 Then Continue;
If (UN = strUpper(Rec.RealName)) or (UN = strUpper(Rec.Handle)) Then Begin If (UN = strUpper(Rec.RealName)) or (UN = strUpper(Rec.Handle)) Then Begin
RecPos := UserFile.FilePos; RecPos := UserFile.FilePosRecord;
Result := True; Result := True;
Break; Break;
End; End;

View File

@ -119,26 +119,6 @@ Begin
End; End;
End; End;
Function MonthStr(MonthNo: Word): String;
Begin
Case MonthNo of
01: MonthStr := 'Jan';
02: MonthStr := 'Feb';
03: MonthStr := 'Mar';
04: MonthStr := 'Apr';
05: MonthStr := 'May';
06: MonthStr := 'Jun';
07: MonthStr := 'Jul';
08: MonthStr := 'Aug';
09: MonthStr := 'Sep';
10: MonthStr := 'Oct';
11: MonthStr := 'Nov';
12: MonthStr := 'Dec';
Else
MonthStr := '???';
End;
End;
Function FormattedDate (DT: DateTime; Mask: String) : String; Function FormattedDate (DT: DateTime; Mask: String) : String;
Var Var
DStr : String[2]; DStr : String[2];
@ -160,7 +140,7 @@ Begin
HourStr := Copy(strPadL(strI2S(Dt.Hour), 2, '0'), 1, 2); HourStr := Copy(strPadL(strI2S(Dt.Hour), 2, '0'), 1, 2);
MinStr := Copy(strPadL(strI2S(Dt.Min), 2, '0'), 1, 2); MinStr := Copy(strPadL(strI2S(Dt.Min), 2, '0'), 1, 2);
SecStr := Copy(strPadL(strI2S(Dt.Sec), 2, '0'), 1, 2); SecStr := Copy(strPadL(strI2S(Dt.Sec), 2, '0'), 1, 2);
MNStr := MonthStr(Dt.Month); MNStr := MonthString[Dt.Month];
If (Pos('YYYY', Mask) = 0) Then YStr := Copy(YStr, 3, 2); If (Pos('YYYY', Mask) = 0) Then YStr := Copy(YStr, 3, 2);

View File

@ -280,7 +280,7 @@ Begin
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} 'ls', 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
@ -318,6 +318,7 @@ Begin
AddPointer ({$IFDEF MPLPARSER} 'userloginname',{$ENDIF} iString, 31, {$IFNDEF MPLPARSER} @Session.UserLoginName {$ELSE} NIL {$ENDIF}); AddPointer ({$IFDEF MPLPARSER} 'userloginname',{$ENDIF} iString, 31, {$IFNDEF MPLPARSER} @Session.UserLoginName {$ELSE} NIL {$ENDIF});
AddPointer ({$IFDEF MPLPARSER} 'userloginpw', {$ENDIF} iString, 16, {$IFNDEF MPLPARSER} @Session.UserLoginPW {$ELSE} NIL {$ENDIF}); AddPointer ({$IFDEF MPLPARSER} 'userloginpw', {$ENDIF} iString, 16, {$IFNDEF MPLPARSER} @Session.UserLoginPW {$ELSE} NIL {$ENDIF});
AddPointer ({$IFDEF MPLPARSER} 'rangevalue', {$ENDIF} iLongInt, 4, {$IFNDEF MPLPARSER} @Session.io.RangeValue {$ELSE} NIL {$ENDIF}); AddPointer ({$IFDEF MPLPARSER} 'rangevalue', {$ENDIF} iLongInt, 4, {$IFNDEF MPLPARSER} @Session.io.RangeValue {$ELSE} NIL {$ENDIF});
AddPointer ({$IFDEF MPLPARSER} 'lastscannew', {$ENDIF} iBool, 1, {$IFNDEF MPLPARSER} @Session.LastScanHadNew {$ELSE} NIL {$ENDIF});
{$IFNDEF MPLPARSER} TInterpEngine(S).IdxVarDir := X + 1; {$ENDIF} {$IFNDEF MPLPARSER} TInterpEngine(S).IdxVarDir := X + 1; {$ENDIF}
@ -345,6 +346,7 @@ Begin
AddVar ({$IFDEF MPLPARSER} 'userfgroup', {$ENDIF} iLongInt); AddVar ({$IFDEF MPLPARSER} 'userfgroup', {$ENDIF} iLongInt);
AddVar ({$IFDEF MPLPARSER} 'usermbase', {$ENDIF} iLongInt); AddVar ({$IFDEF MPLPARSER} 'usermbase', {$ENDIF} iLongInt);
AddVar ({$IFDEF MPLPARSER} 'usermgroup', {$ENDIF} iLongInt); AddVar ({$IFDEF MPLPARSER} 'usermgroup', {$ENDIF} iLongInt);
AddVar ({$IFDEF MPLPARSER} 'userbirthday', {$ENDIF} iLongInt);
End; End;
2 : Begin 2 : Begin
AddPointer ({$IFDEF MPLPARSER} 'cfgsyspath', {$ENDIF} iString, mysMaxPathSize, {$IFNDEF MPLPARSER} @Config.SystemPath {$ELSE} NIL {$ENDIF}); AddPointer ({$IFDEF MPLPARSER} 'cfgsyspath', {$ENDIF} iString, mysMaxPathSize, {$IFNDEF MPLPARSER} @Config.SystemPath {$ELSE} NIL {$ENDIF});

View File

@ -87,7 +87,7 @@ Type
UpdateProc : TParserUpdateProc; UpdateProc : TParserUpdateProc;
UpdateInfo : TParserUpdateInfo; UpdateInfo : TParserUpdateInfo;
VarData : VarDataRec; VarData : VarDataRec;
GotoData : Array[1..mplMaxGotos] of PGotoRec; // GotoData : Array[1..mplMaxGotos] of PGotoRec;
RecData : Array[1..mplMaxRecords] of PRecordRec; RecData : Array[1..mplMaxRecords] of PRecordRec;
ConstData : Array[1..mplMaxConsts] of PConstRec; ConstData : Array[1..mplMaxConsts] of PConstRec;
CurVarNum : Word; CurVarNum : Word;
@ -96,6 +96,7 @@ Type
CurConstNum : Word; CurConstNum : Word;
CurVarID : Word; CurVarID : Word;
CurRecID : Word; CurRecID : Word;
CurDepth : LongInt;
UsesUSER : Boolean; UsesUSER : Boolean;
UsesCFG : Boolean; UsesCFG : Boolean;
UsesMBASE : Boolean; UsesMBASE : Boolean;
@ -120,7 +121,7 @@ Type
Procedure OutPosition (P: LongInt; W: Word); Procedure OutPosition (P: LongInt; W: Word);
// SEARCH FUNCTIONS // SEARCH FUNCTIONS
Function FindVariable (Str: String) : Integer; Function FindVariable (Str: String) : Integer;
Function FindGoto (Str: String) : Integer; // Function FindGoto (Str: String) : Integer;
Function FindRecord (Str: String) : Integer; Function FindRecord (Str: String) : Integer;
Function FindConst (Str: String) : Integer; Function FindConst (Str: String) : Integer;
Function FindIdent (Str: String) : Boolean; Function FindIdent (Str: String) : Boolean;
@ -145,7 +146,7 @@ Type
Procedure DefineRecordType; Procedure DefineRecordType;
Procedure DefineVariable; Procedure DefineVariable;
Procedure DefineConst; Procedure DefineConst;
Procedure DefineGoto; // Procedure DefineGoto;
Procedure DefineProc; Procedure DefineProc;
Procedure ExecuteProcedure (VN: Word; Res: Boolean); Procedure ExecuteProcedure (VN: Word; Res: Boolean);
@ -156,7 +157,7 @@ Type
Procedure StatementRepeatUntil; Procedure StatementRepeatUntil;
Procedure StatementWhileDo; Procedure StatementWhileDo;
Procedure StatementForLoop; Procedure StatementForLoop;
Procedure StatementGoto; // Procedure StatementGoto;
Procedure StatementUses; Procedure StatementUses;
// MISC FUNCTIONS // MISC FUNCTIONS
@ -195,6 +196,7 @@ Begin
CurGotoNum := 0; CurGotoNum := 0;
CurRecNum := 0; CurRecNum := 0;
CurConstNum := 0; CurConstNum := 0;
CurDepth := 0;
UpdateProc := Update; UpdateProc := Update;
AllowOutput := True; AllowOutput := True;
@ -209,7 +211,7 @@ Var
Count : LongInt; Count : LongInt;
Begin Begin
For Count := 1 to CurVarNum Do Dispose (VarData[Count]); For Count := 1 to CurVarNum Do Dispose (VarData[Count]);
For Count := 1 to CurGotoNum Do Dispose (GotoData[Count]); // For Count := 1 to CurGotoNum Do Dispose (GotoData[Count]);
For Count := 1 to CurRecNum Do Dispose (RecData[Count]); For Count := 1 to CurRecNum Do Dispose (RecData[Count]);
CurVarNum := 0; CurVarNum := 0;
@ -247,7 +249,7 @@ Begin
mpsExpOperator : Result := 'Operator expected'; mpsExpOperator : Result := 'Operator expected';
mpsOverArrayDim : Result := 'Too many dimensions in array: Max ' + strI2S(mplMaxArrayDem); mpsOverArrayDim : Result := 'Too many dimensions in array: Max ' + strI2S(mplMaxArrayDem);
mpsNoInitArray : Result := 'Cannot init array with value'; mpsNoInitArray : Result := 'Cannot init array with value';
mpsTooManyGotos : Result := 'Too many GOTO labels: Max ' + strI2S(mplMaxGotos); // mpsTooManyGotos : Result := 'Too many GOTO labels: Max ' + strI2S(mplMaxGotos);
mpsDupLabel : Result := 'Duplicate label: ' + Str; mpsDupLabel : Result := 'Duplicate label: ' + Str;
mpsLabelNotFound : Result := 'Label not found: ' + Str; mpsLabelNotFound : Result := 'Label not found: ' + Str;
mpsFileParamVar : Result := 'File parameters must be type FILE'; mpsFileParamVar : Result := 'File parameters must be type FILE';
@ -272,10 +274,10 @@ Begin
UpdateInfo.ErrorCol := 0; UpdateInfo.ErrorCol := 0;
If Assigned(InFile[CurFile].DataFile) And InFile[CurFile].DataFile.IsOpened Then Begin If Assigned(InFile[CurFile].DataFile) And InFile[CurFile].DataFile.IsOpened Then Begin
InFile[CurFile].DataFile.Seek(0); InFile[CurFile].DataFile.SeekRaw(0);
While Not InFile[CurFile].DataFile.EOF And (InFile[CurFile].DataFile.FilePos < InFile[CurFile].Position) Do Begin While Not InFile[CurFile].DataFile.EOF And (InFile[CurFile].DataFile.FilePosRaw < InFile[CurFile].Position) Do Begin
Case InFile[CurFile].DataFile.Read of Case InFile[CurFile].DataFile.ReadChar of
#10 : Begin #10 : Begin
Inc (UpdateInfo.ErrorLine); Inc (UpdateInfo.ErrorLine);
@ -347,6 +349,7 @@ Begin
Result := (FindVariable(Str) <> 0) or (FindConst(Str) <> 0) or (FindRecord(Str) <> 0); Result := (FindVariable(Str) <> 0) or (FindConst(Str) <> 0) or (FindRecord(Str) <> 0);
End; End;
(*
Function TParserEngine.FindGoto (Str: String) : Integer; Function TParserEngine.FindGoto (Str: String) : Integer;
Var Var
Count : LongInt; Count : LongInt;
@ -366,7 +369,7 @@ Begin
Inc (Count); Inc (Count);
Until (Count > CurGotoNum); Until (Count > CurGotoNum);
End; End;
*)
Function TParserEngine.FindRecord (Str: String) : Integer; Function TParserEngine.FindRecord (Str: String) : Integer;
Var Var
Count : LongInt; Count : LongInt;
@ -432,7 +435,7 @@ Begin
If UpdateInfo.ErrorType <> 0 Then Exit; If UpdateInfo.ErrorType <> 0 Then Exit;
If Not InFile[CurFile].DataFile.Eof Then Begin If Not InFile[CurFile].DataFile.Eof Then Begin
Ch := InFile[CurFile].DataFile.Read; Ch := InFile[CurFile].DataFile.ReadChar;
Inc (InFile[CurFile].Position); Inc (InFile[CurFile].Position);
End Else End Else
@ -454,7 +457,7 @@ Begin
Dec (Position); Dec (Position);
DataFile.Seek (DataFile.FilePos - 1); DataFile.SeekRaw (DataFile.FilePosRaw - 1);
End; End;
End; End;
@ -687,7 +690,7 @@ End;
Procedure TParserEngine.SavePosition; Procedure TParserEngine.SavePosition;
Begin Begin
With InFile[CurFile] Do Begin With InFile[CurFile] Do Begin
PosSaved := DataFile.FilePos + 1; PosSaved := DataFile.FilePosRaw + 1;
End; End;
End; End;
@ -696,7 +699,7 @@ Begin
With InFile[CurFile] Do Begin With InFile[CurFile] Do Begin
Position := PosSaved; Position := PosSaved;
DataFile.Seek (Position - 1); DataFile.SeekRaw (Position - 1);
End; End;
End; End;
@ -706,11 +709,13 @@ Var
Begin Begin
If (Not AllowOutput) or (UpdateInfo.ErrorType <> 0) Then Exit; If (Not AllowOutput) or (UpdateInfo.ErrorType <> 0) Then Exit;
SavedPos := CurFilePos; SavedPos := FilePos(OutFile);
// SavedPos := CurFilePos;
Seek (OutFile, P + mplVerLength); Seek (OutFile, P + mplVerLength);
OutWord (W); OutWord (W);
Seek (OutFile, SavedPos + mplVerLength); // Seek (OutFile, SavedPos + mplVerLength);
Seek (OutFile, SavedPos);
End; End;
Procedure TParserEngine.ParseArray (VN: Word; Forced: Boolean); Procedure TParserEngine.ParseArray (VN: Word; Forced: Boolean);
@ -742,7 +747,7 @@ Begin
If Result <> iRecord Then Exit; If Result <> iRecord Then Exit;
SavedPos := InFile[CurFile].DataFile.FilePos; SavedPos := InFile[CurFile].DataFile.FilePosRaw;
If SkipIdent Then GetIdent(False); If SkipIdent Then GetIdent(False);
@ -766,7 +771,7 @@ Begin
NextChar; NextChar;
If (Ch <> '.') Then Begin If (Ch <> '.') Then Begin
InFile[CurFile].DataFile.Seek(SavedPos); InFile[CurFile].DataFile.SeekRaw(SavedPos);
Exit; Exit;
End; End;
@ -784,7 +789,7 @@ Begin
If Not Found Then If Not Found Then
Error (mpsUnknownIdent, ''); Error (mpsUnknownIdent, '');
InFile[CurFile].DataFile.Seek(SavedPos); InFile[CurFile].DataFile.SeekRaw(SavedPos);
End; End;
Function TParserEngine.ParseElement (VN: Word; TypeCheck: Boolean; VT: TIdentTypes) : TIdentTypes; Function TParserEngine.ParseElement (VN: Word; TypeCheck: Boolean; VT: TIdentTypes) : TIdentTypes;
@ -2421,12 +2426,14 @@ Begin
OutString(Char(opElse)); OutString(Char(opElse));
If GetStr(tkw[wBlockOpen], False, False) Then If GetStr(tkw[wBlockOpen], False, False) Then
ParseBlock (CurVarNum, False, True, False) ParseBlock
(CurVarNum, False, True, False)
Else Else
ParseBlock (CurVarNum, True, False, False); ParseBlock (CurVarNum, True, False, False);
End; End;
End; End;
(*
Procedure TParserEngine.StatementGoto; Procedure TParserEngine.StatementGoto;
Var Var
GotoNum : LongInt; GotoNum : LongInt;
@ -2434,6 +2441,8 @@ Begin
OutString (Char(opGoto)); OutString (Char(opGoto));
GetIdent (False); GetIdent (False);
writeln('opGoto found at depth ', curdepth);
If UpdateInfo.ErrorType <> 0 Then Exit; If UpdateInfo.ErrorType <> 0 Then Exit;
GotoNum := FindGoto(IdentStr); GotoNum := FindGoto(IdentStr);
@ -2445,18 +2454,19 @@ Begin
Inc (CurGotoNum); Inc (CurGotoNum);
New (GotoData[CurGotoNum]); New (GotoData[CurGotoNum]);
GotoData[CurGotoNum]^.Ident := IdentStr; GotoData[CurGotoNum]^.Ident := IdentStr;
GotoData[CurGotoNum]^.xPos := CurFilePos; GotoData[CurGotoNum]^.Position := CurFilePos;
GotoData[CurGotoNum]^.Stat := 1; GotoData[CurGotoNum]^.State := 1;
OutWord(0); OutWord(0);
End; End;
End Else Begin End Else Begin
GotoData[GotoNum]^.Stat := 0; GotoData[GotoNum]^.State := 0;
OutWord (GotoData[GotoNum]^.xPos); OutWord (GotoData[GotoNum]^.Position);
End; End;
End; End;
*)
Procedure TParserEngine.StatementUses; Procedure TParserEngine.StatementUses;
Var Var
@ -2537,6 +2547,7 @@ Begin
Until UpdateInfo.ErrorType <> 0; Until UpdateInfo.ErrorType <> 0;
End; End;
(*
Procedure TParserEngine.DefineGoto; Procedure TParserEngine.DefineGoto;
Var Var
GotoNum : Word; GotoNum : Word;
@ -2555,21 +2566,21 @@ Begin
Inc (CurGotoNum); Inc (CurGotoNum);
New (GotoData[CurGotoNum]); New (GotoData[CurGotoNum]);
GotoData[CurGotoNum]^.Ident := IdentStr; GotoData[CurGotoNum]^.Ident := IdentStr;
GotoData[CurGotoNum]^.xPos := CurFilePos; GotoData[CurGotoNum]^.Position := CurFilePos;
GotoData[CurGotoNum]^.Stat := 2; GotoData[CurGotoNum]^.State := 2;
End; End;
End Else Begin End Else Begin
If GotoData[GotoNum]^.Stat = 1 Then Begin If GotoData[GotoNum]^.State = 1 Then Begin
GotoData[GotoNum]^.Stat := 0; GotoData[GotoNum]^.State := 0;
Temp := CurFilePos; Temp := CurFilePos;
OutPosition(GotoData[GotoNum]^.xPos, Temp); OutPosition(GotoData[GotoNum]^.Position, Temp);
GotoData[GotoNum]^.xPos := Temp; GotoData[GotoNum]^.Position := Temp;
End Else End Else
Error (mpsDupLabel, GotoData[GotoNum]^.Ident); Error (mpsDupLabel, GotoData[GotoNum]^.Ident);
End; End;
End; End;
*)
Function TParserEngine.SetProcResult (VN: Word) : Boolean; Function TParserEngine.SetProcResult (VN: Word) : Boolean;
Begin Begin
SetProcResult := False; SetProcResult := False;
@ -2608,7 +2619,7 @@ Begin
If IdentStr = tkw[wWhile] Then StatementWhileDo Else If IdentStr = tkw[wWhile] Then StatementWhileDo Else
If IdentStr = tkw[wRepeat] Then StatementRepeatUntil Else If IdentStr = tkw[wRepeat] Then StatementRepeatUntil Else
If IdentStr = tkw[wCaseStart] Then StatementCase Else If IdentStr = tkw[wCaseStart] Then StatementCase Else
If IdentStr = tkw[wGoto] Then StatementGoto Else // If IdentStr = tkw[wGoto] Then StatementGoto Else
Error(mpsUnknownIdent, IdentStr); Error(mpsUnknownIdent, IdentStr);
End Else Begin End Else Begin
If VarData[VarNum]^.Proc Then Begin If VarData[VarNum]^.Proc Then Begin
@ -2642,7 +2653,7 @@ Procedure TParserEngine.ParseBlock (VarStart: Word; OneLine, CheckBlock, IsRepea
Var Var
Count : LongInt; Count : LongInt;
SavedVar : LongInt; SavedVar : LongInt;
SavedGoto : LongInt; // SavedGoto : LongInt;
SavedPos : LongInt; SavedPos : LongInt;
SavedConst : LongInt; SavedConst : LongInt;
SavedRec : LongInt; SavedRec : LongInt;
@ -2657,10 +2668,12 @@ Begin
If UpdateInfo.ErrorType <> 0 Then Exit; If UpdateInfo.ErrorType <> 0 Then Exit;
Inc (CurDepth);
OutString (Char(opBlockOpen)); OutString (Char(opBlockOpen));
SavedPos := CurFilePos; SavedPos := CurFilePos;
SavedGoto := CurGotoNum; // SavedGoto := CurGotoNum;
SavedConst := CurConstNum; SavedConst := CurConstNum;
SavedVar := VarStart; SavedVar := VarStart;
SavedRec := CurRecNum; SavedRec := CurRecNum;
@ -2687,8 +2700,8 @@ Begin
End Else End Else
If GetStr(tkw[wBlockOpen], False, False) Then Begin If GetStr(tkw[wBlockOpen], False, False) Then Begin
If GotOpen And Not OneLine Then Begin If GotOpen And Not OneLine Then Begin
PrevChar; // PrevChar;
ParseBlock (CurVarNum, False, False, False); // ParseBlock (CurVarNum, False, False, False);
GotVar := False; GotVar := False;
GotConst := False; GotConst := False;
End Else Begin End Else Begin
@ -2718,7 +2731,7 @@ Begin
End Else End Else
If GetStr(tkw[wLabel], False, False) Then Begin If GetStr(tkw[wLabel], False, False) Then Begin
If Not GotOpen Then Error(mpsExpected, 'begin'); If Not GotOpen Then Error(mpsExpected, 'begin');
DefineGoto; // DefineGoto;
GotVar := False; GotVar := False;
GotConst := False; GotConst := False;
End Else End Else
@ -2778,20 +2791,22 @@ Begin
GotBlock := True; GotBlock := True;
Until (UpdateInfo.ErrorType <> 0) or OneLine; Until (UpdateInfo.ErrorType <> 0) or OneLine;
Dec (CurDepth);
For Count := CurVarNum DownTo SavedVar + 1 Do For Count := CurVarNum DownTo SavedVar + 1 Do
Dispose(VarData[Count]); Dispose(VarData[Count]);
CurVarNum := SavedVar; CurVarNum := SavedVar;
(*
For Count := CurGotoNum DownTo SavedGoto + 1 Do Begin For Count := CurGotoNum DownTo SavedGoto + 1 Do Begin
If GotoData[Count]^.Stat = 1 Then If GotoData[Count]^.State = 1 Then
Error(mpsLabelNotFound, GotoData[Count]^.Ident); Error(mpsLabelNotFound, GotoData[Count]^.Ident);
Dispose (GotoData[Count]); Dispose (GotoData[Count]);
End; End;
CurGotoNum := SavedGoto; CurGotoNum := SavedGoto;
*)
For Count := CurRecNum DownTo SavedRec + 1 Do For Count := CurRecNum DownTo SavedRec + 1 Do
Dispose (RecData[Count]); Dispose (RecData[Count]);
@ -2830,7 +2845,7 @@ Begin
InFile[CurFile].DataFile := TFileBuffer.Create(8 * 1024); InFile[CurFile].DataFile := TFileBuffer.Create(8 * 1024);
If Not InFile[CurFile].DataFile.OpenStream(FN, fmOpen, fmRWDN) Then Begin If Not InFile[CurFile].DataFile.OpenStream(FN, 1, fmOpen, fmRWDN) Then Begin
InFile[CurFile].DataFile.Free; InFile[CurFile].DataFile.Free;
InFile[CurFile].DataFile := NIL; InFile[CurFile].DataFile := NIL;
@ -2841,7 +2856,7 @@ Begin
Exit; Exit;
End; End;
InFile[CurFile].Size := InFile[CurFile].DataFile.FileSize; InFile[CurFile].Size := InFile[CurFile].DataFile.FileSizeRaw;
End; End;
Procedure TParserEngine.CloseSourceFile; Procedure TParserEngine.CloseSourceFile;

View File

@ -173,6 +173,7 @@ Begin
Move (U.LastFGroup, VarData[IdxVarUser + 13]^.Data^, SizeOf(U.LastFGroup)); Move (U.LastFGroup, VarData[IdxVarUser + 13]^.Data^, SizeOf(U.LastFGroup));
Move (U.LastMBase, VarData[IdxVarUser + 14]^.Data^, SizeOf(U.LastMBase)); Move (U.LastMBase, VarData[IdxVarUser + 14]^.Data^, SizeOf(U.LastMBase));
Move (U.LastMGroup, VarData[IdxVarUser + 15]^.Data^, SizeOf(U.LastMGroup)); Move (U.LastMGroup, VarData[IdxVarUser + 15]^.Data^, SizeOf(U.LastMGroup));
Move (U.Birthday, VarData[IdxVarUser + 16]^.Data^, SizeOf(U.Birthday));
End; End;
Procedure TInterpEngine.PutUserVars (Var U: RecUser); Procedure TInterpEngine.PutUserVars (Var U: RecUser);
@ -193,6 +194,7 @@ Begin
Move (VarData[IdxVarUser + 13]^.Data^, U.LastFGroup, SizeOf(U.LastFGroup)); Move (VarData[IdxVarUser + 13]^.Data^, U.LastFGroup, SizeOf(U.LastFGroup));
Move (VarData[IdxVarUser + 14]^.Data^, U.LastMBase, SizeOf(U.LastMBase)); Move (VarData[IdxVarUser + 14]^.Data^, U.LastMBase, SizeOf(U.LastMBase));
Move (VarData[IdxVarUser + 15]^.Data^, U.LastMGroup, SizeOf(U.LastMGroup)); Move (VarData[IdxVarUser + 15]^.Data^, U.LastMGroup, SizeOf(U.LastMGroup));
Move (VarData[IdxVarUser + 16]^.Data^, U.Birthday, SizeOf(U.Birthday));
End; End;
Function TInterpEngine.GetUserRecord (Num: LongInt) : Boolean; Function TInterpEngine.GetUserRecord (Num: LongInt) : Boolean;
@ -394,24 +396,24 @@ End;
Procedure TInterpEngine.MoveToPos (Num: LongInt); Procedure TInterpEngine.MoveToPos (Num: LongInt);
Begin Begin
DataFile.Seek (Num + mplVerLength); DataFile.SeekRaw (Num + mplVerLength);
End; End;
Function TInterpEngine.CurFilePos : LongInt; Function TInterpEngine.CurFilePos : LongInt;
Begin Begin
Result := DataFile.FilePos - mplVerLength; Result := DataFile.FilePosRaw - mplVerLength;
End; End;
Procedure TInterpEngine.NextChar; Procedure TInterpEngine.NextChar;
Begin Begin
Ch := DataFile.Read; Ch := DataFile.ReadChar;
End; End;
Procedure TInterpEngine.NextWord; Procedure TInterpEngine.NextWord;
Var Var
Res : LongInt; Res : LongInt;
Begin Begin
DataFile.BlockRead (W, 2, Res); DataFile.ReadBlock (W, 2, Res);
End; End;
Procedure TInterpEngine.PrevChar; Procedure TInterpEngine.PrevChar;
@ -591,7 +593,7 @@ Var
ParseNext; ParseNext;
Until Not (CheckChar in ['0'..'9', '.', 'E']); Until Not (CheckChar in ['0'..'9', '.', 'E']);
Val(NumStr, Result, Start); Val (NumStr, Result, Start);
End; End;
End; End;
@ -694,7 +696,7 @@ Begin
opOpenString : Begin opOpenString : Begin
NextChar; NextChar;
Result[0] := Ch; Result[0] := Ch;
DataFile.BlockRead (Result[1], Byte(Ch), Res); DataFile.ReadBlock (Result[1], Byte(Ch), Res);
End; End;
opProcExec : Case ExecuteProcedure(@Result) of opProcExec : Case ExecuteProcedure(@Result) of
iChar : Begin // convert to string if its a char iChar : Begin // convert to string if its a char
@ -1867,9 +1869,12 @@ Begin
Move (Session.io.ScreenInfo[Param[1].B].Y, Param[3].vData^, 1); Move (Session.io.ScreenInfo[Param[1].B].Y, Param[3].vData^, 1);
Move (Session.io.ScreenInfo[Param[1].B].A, Param[4].vData^, 1); Move (Session.io.ScreenInfo[Param[1].B].A, Param[4].vData^, 1);
End; End;
530 : If Param[1].B < FileSize(Session.PromptFile) Then Begin 530 : If (Param[1].L > -1) And (Param[1].L <= mysMaxThemeText) Then Begin
Seek (Session.PromptFile, Param[1].B); If Assigned(Session.PromptData[Param[1].L]) Then
Write (Session.PromptFile, Param[2].S); FreeMem (Session.PromptData[Param[1].L]);
GetMem (Session.PromptData[Param[1].L], Length(Param[2].S) + 1);
Move (Param[2].S, Session.PromptData[Count]^, Length(Param[2].S) + 1);
End; End;
531 : Begin 531 : Begin
TempChar := Session.io.MorePrompt; TempChar := Session.io.MorePrompt;
@ -2235,7 +2240,7 @@ Begin
{$IFDEF LOGGING} {$IFDEF LOGGING}
Inc(Depth); Inc(Depth);
Session.SystemLog('[' + strI2S(Depth) + '] ExecBlock BEGIN Var: ' + strI2S(StartVar) + ' Rec: ' + strI2S(StartRec)); Session.SystemLog('[D' + strI2S(Depth) + '] ExecBlock BEGIN Var: ' + strI2S(StartVar));
{$ENDIF} {$ENDIF}
NextChar; // block begin character... can we ignore it? at least for case_else NextChar; // block begin character... can we ignore it? at least for case_else
@ -2250,8 +2255,8 @@ Begin
Case TTokenOpsRec(Byte(Ch)) of Case TTokenOpsRec(Byte(Ch)) of
{0} opBlockOpen : Begin {0} opBlockOpen : Begin
PrevChar; // PrevChar;
Self.ExecuteBlock(CurVarNum); // Self.ExecuteBlock(CurVarNum);
End; End;
{1} opBlockClose : Break; {1} opBlockClose : Break;
{2} opVarDeclare : DefineVariable; {2} opVarDeclare : DefineVariable;
@ -2272,10 +2277,6 @@ Begin
End; End;
{36} opWhile : StatementWhileDo; {36} opWhile : StatementWhileDo;
{39} opRepeat : StatementRepeatUntil; {39} opRepeat : StatementRepeatUntil;
{47} opGoto : Begin
NextWord;
MoveToPos(W);
End;
{49} opHalt : Done := True; {49} opHalt : Done := True;
{50} opCase : Begin {50} opCase : Begin
Result := StatementCase; Result := StatementCase;
@ -2386,7 +2387,7 @@ Begin
MPEName := FN; MPEName := FN;
If Not DataFile.OpenStream(FN, fmOpen, fmRWDN) Then Begin If Not DataFile.OpenStream(FN, 1, fmOpen, fmRWDN) Then Begin
DataFile.Free; DataFile.Free;
Exit; Exit;
@ -2394,7 +2395,7 @@ Begin
Result := 1; Result := 1;
If DataFile.FileSize < mplVerLength Then Begin If DataFile.FileSizeRaw < mplVerLength Then Begin
DataFile.Free; DataFile.Free;
Error (mpxInvalidFile, FN); Error (mpxInvalidFile, FN);
@ -2402,7 +2403,7 @@ Begin
Exit; Exit;
End; End;
DataFile.BlockRead (VerStr[1], mplVerLength, Res); DataFile.ReadBlock (VerStr[1], mplVerLength, Res);
VerStr[0] := Chr(mplVerLength); VerStr[0] := Chr(mplVerLength);
If VerStr <> mplVersion Then Begin If VerStr <> mplVersion Then Begin

View File

@ -64,7 +64,7 @@ Type
opArrDef, // 45 opArrDef, // 45
opStrSize, // 46 opStrSize, // 46
opVarNormal, // 47 opVarNormal, // 47
opGoto, // 48 // opGoto, // 48
opHalt, // 49 opHalt, // 49
opCase, // 50 opCase, // 50
opNumRange, // 51 opNumRange, // 51
@ -86,7 +86,7 @@ Const
mplMaxFiles = 20; mplMaxFiles = 20;
mplMaxIdentLen = 30; mplMaxIdentLen = 30;
mplMaxVars = 2500; mplMaxVars = 2500;
mplMaxGotos = 100; // mplMaxGotos = 100;
mplMaxCaseNums = 20; mplMaxCaseNums = 20;
mplMaxVarDeclare = 20; mplMaxVarDeclare = 20;
mplMaxArrayDem = 3; //cannot be changed yet mplMaxArrayDem = 3; //cannot be changed yet
@ -135,7 +135,7 @@ Const
mpsExpOperator = 21; mpsExpOperator = 21;
mpsOverArrayDim = 22; mpsOverArrayDim = 22;
mpsNoInitArray = 23; mpsNoInitArray = 23;
mpsTooManyGotos = 24; // mpsTooManyGotos = 24;
mpsDupLabel = 25; mpsDupLabel = 25;
mpsLabelNotFound = 26; mpsLabelNotFound = 26;
mpsFileParamVar = 27; mpsFileParamVar = 27;
@ -162,7 +162,7 @@ Type
wElse, wWhile, wRepeat, wUntil, wElse, wWhile, wRepeat, wUntil,
wNot, wAnd, wOr, wOpenArray, wNot, wAnd, wOr, wOpenArray,
wCloseArray, wArrSep, wVarDef, wOpenStrSize, wCloseArray, wArrSep, wVarDef, wOpenStrSize,
wCloseStrSize, wGoto, wLabel, wHalt, wCloseStrSize, wLabel, wHalt,
wVarSep2, wFuncDef, wArray, wCaseStart, wVarSep2, wFuncDef, wArray, wCaseStart,
wCaseOf, wNumRange, wType, wConst, wCaseOf, wNumRange, wType, wConst,
wBreak, wContinue, wUses, wExit, wBreak, wContinue, wUses, wExit,
@ -195,7 +195,7 @@ Const
'else', 'while', 'repeat', 'until', 'else', 'while', 'repeat', 'until',
'not', 'and', 'or', '[', 'not', 'and', 'or', '[',
']', ',', '=', '[', ']', ',', '=', '[',
']', 'goto', ':', 'halt', ']', ':', 'halt',
':', 'function', 'array', 'case', ':', 'function', 'array', 'case',
'of', '..', 'type', 'const', 'of', '..', 'type', 'const',
'break', 'continue', 'uses', 'exit', 'break', 'continue', 'uses', 'exit',
@ -210,12 +210,12 @@ Const
'(', ')', '+', ';', '(', ')', '+', ';',
':', ',', 'for', 'to', ':', ',', 'for', 'to',
'downto', 'do', 'true', 'false', 'downto', 'do', 'true', 'false',
'==', '<>', '>', '<', '==', '!=', '>', '<',
'>=', '<=', 'if', 'then', '>=', '<=', 'if', 'then',
'else', 'while', 'repeat', 'until', 'else', 'while', 'repeat', 'until',
'!', '&&', '||', '(', '!', '&&', '||', '(',
')', ',', '=', '[', ')', ',', '=', '[',
']', 'goto', ':', 'halt', ']', ':', 'halt',
':', 'func', 'array', 'switch', ':', 'func', 'array', 'switch',
'of', '..', 'type', 'const', 'of', '..', 'type', 'const',
'break', 'continue', 'uses', 'exit', 'break', 'continue', 'uses', 'exit',
@ -286,13 +286,6 @@ Type
RecID : Word; RecID : Word;
End; End;
PGotoRec = ^TGotoRec;
TGotoRec = Record
Ident : String[mplMaxIdentLen];
xPos : LongInt;
Stat : Byte;
End;
VarDataRec = Array[1..mplMaxVars] of PVarRec; VarDataRec = Array[1..mplMaxVars] of PVarRec;
{$ENDIF} {$ENDIF}

View File

@ -227,9 +227,9 @@ Var
Begin Begin
Result := False; Result := False;
If Not MsgFile.OpenStream (FN, fmOpen, fmRWDN) Then Exit; If Not MsgFile.OpenStream (FN, 1, fmOpen, fmRWDN) Then Exit;
MsgFile.BlockRead (PKTHeader, SizeOf(PKTHeader), Res); MsgFile.ReadBlock (PKTHeader, SizeOf(PKTHeader), Res);
If (Res <> SizeOf(PKTHeader)) or (PKTHeader.PKTType <> $0002) Then Begin If (Res <> SizeOf(PKTHeader)) or (PKTHeader.PKTType <> $0002) Then Begin
MsgFile.CloseStream; MsgFile.CloseStream;
@ -258,7 +258,7 @@ Var
Result := ''; Result := '';
While Not MsgFile.Eof Do Begin While Not MsgFile.Eof Do Begin
Ch := MsgFile.Read; Ch := MsgFile.ReadChar;
If Ch = TermChar Then Break; If Ch = TermChar Then Break;
@ -273,7 +273,7 @@ Begin
If Not Opened Then Exit; If Not Opened Then Exit;
MsgFile.BlockRead (MsgHdr, SizeOf(MsgHdr), Res); MsgFile.ReadBlock (MsgHdr, SizeOf(MsgHdr), Res);
If Res <> SizeOf(MsgHdr) Then Exit; If Res <> SizeOf(MsgHdr) Then Exit;
@ -307,7 +307,7 @@ Begin
MsgText[MsgLines]^ := ''; MsgText[MsgLines]^ := '';
Repeat Repeat
Ch := MsgFile.Read; Ch := MsgFile.ReadChar;
Case Ch of Case Ch of
#000 : Break; #000 : Break;
@ -315,7 +315,7 @@ Begin
#013 : Begin #013 : Begin
If MsgLines = mysMaxMsgLines Then Begin If MsgLines = mysMaxMsgLines Then Begin
Repeat Repeat
Ch := MsgFile.Read; Ch := MsgFile.ReadChar;
Until (Ch = #0) or (MsgFile.EOF); Until (Ch = #0) or (MsgFile.EOF);
Break; Break;
@ -360,7 +360,7 @@ Begin
End Else Begin End Else Begin
If MsgLines = mysMaxMsgLines Then Begin If MsgLines = mysMaxMsgLines Then Begin
Repeat Repeat
Ch := MsgFile.Read; Ch := MsgFile.ReadChar;
Until (Ch = #0) or (MsgFile.EOF); Until (Ch = #0) or (MsgFile.EOF);
Break; Break;

View File

@ -108,7 +108,7 @@ Var
While PKT.GetMessage Do Begin While PKT.GetMessage Do Begin
If Status MOD 20 = 0 Then If Status MOD 20 = 0 Then
BarOne.Update (PKT.MsgFile.FilePos, PKT.MsgFile.FileSize); BarOne.Update (PKT.MsgFile.FilePosRaw, PKT.MsgFile.FileSizeRaw);
Inc (Status); Inc (Status);

View File

@ -37,10 +37,10 @@ Var
L : RecMsgLink; L : RecMsgLink;
Res : LongInt; Res : LongInt;
Begin Begin
LinkFile.Seek(0); LinkFile.SeekRaw(0);
While Not LinkFile.EOF Do Begin While Not LinkFile.EOF Do Begin
LinkFile.BlockRead(L, SizeOf(L), Res); LinkFile.ReadBlock (L, SizeOf(L), Res);
If L.OldNum = OldNum Then Begin If L.OldNum = OldNum Then Begin
Result := L.NewNum; Result := L.NewNum;
@ -110,7 +110,7 @@ Var
LinkFile := TFileBuffer.Create (8 * 1024); LinkFile := TFileBuffer.Create (8 * 1024);
LinkFile.OpenStream (TempPath + TempName + '.tmp', fmCreate, fmRWDN); LinkFile.OpenStream (TempPath + TempName + '.tmp', 1, fmCreate, fmRWDN);
MsgData^.SeekFirst(1); MsgData^.SeekFirst(1);
@ -163,7 +163,7 @@ Var
Link.OldNum := MsgData^.GetMsgNum; Link.OldNum := MsgData^.GetMsgNum;
Link.NewNum := NewData^.GetHighMsgNum; Link.NewNum := NewData^.GetHighMsgNum;
LinkFile.BlockWrite (Link, SizeOf(Link)); LinkFile.WriteBlock (Link, SizeOf(Link));
End; End;
MsgData^.SeekNext; MsgData^.SeekNext;

View File

@ -136,6 +136,8 @@ Begin
If Session.ExitLevel <> 0 Then ExitCode := Session.ExitLevel; If Session.ExitLevel <> 0 Then ExitCode := Session.ExitLevel;
If Session.EventRunAfter Then ExitCode := Session.NextEvent.ExecLevel; If Session.EventRunAfter Then ExitCode := Session.NextEvent.ExecLevel;
// would be nice flush if not local and still conected: Session.io.BufFlush;
FileMode := 66; FileMode := 66;
DirClean (Session.TempPath, ''); DirClean (Session.TempPath, '');
@ -281,7 +283,7 @@ Begin
If Not Session.LoadThemeData(Config.DefThemeFile) Then Begin If Not Session.LoadThemeData(Config.DefThemeFile) Then Begin
If Not Session.ConfigMode Then Begin If Not Session.ConfigMode Then Begin
Screen.WriteLine ('ERROR: Default theme prompts not found [' + Config.DefThemeFile + '.thm]'); Screen.WriteLine ('ERROR: Default theme prompts not found: ' + Config.DefThemeFile + '.txt');
DisposeClasses; DisposeClasses;
Halt(1); Halt(1);
End; End;

View File

@ -23,7 +23,7 @@
Const Const
mysSoftwareID = 'Mystic BBS'; mysSoftwareID = 'Mystic BBS';
mysCopyYear = '1997-2013'; // its been a long time! mysCopyYear = '1997-2013'; // its been a long time!
mysVersion = '1.10 A34'; // current version mysVersion = '1.10 A35'; // current version
mysDataChanged = '1.10 A11'; // version of last records change mysDataChanged = '1.10 A11'; // version of last records change
{$IFDEF WIN32} {$IFDEF WIN32}

View File

@ -27,6 +27,14 @@ BUGS AND POSSIBLE ISSUES
FUTURE / IDEAS / WORK IN PROGRESS / NOTES FUTURE / IDEAS / WORK IN PROGRESS / NOTES
========================================= =========================================
- ability to download ANSIs while actually viewing them in the gallery
- optional Menu scroller during input?
- Menu type: Lightbar/Form OR just change standard lightbar to work that
way which i think is the best approach actually.
- ESC moves back in ANSI gallery only exits if dir = root?
- Color, boxtype, and input configuration for configuration
- Toggle base scan settings Select [A]ll, [D]eselect All
- global file editor like msg base
- redo voting booth externalize user storage and allow unlimited questions - redo voting booth externalize user storage and allow unlimited questions
plus maybe categories. or at least up it to like 50 questions or plus maybe categories. or at least up it to like 50 questions or
something and also add in the "created" date to the voting question itself something and also add in the "created" date to the voting question itself

View File

@ -3371,4 +3371,50 @@
10 seconds) which should prevent FTP ghost users when there is a firewall 10 seconds) which should prevent FTP ghost users when there is a firewall
or network adapter configuration issue. or network adapter configuration issue.
- Removed MPL support for GOTO labels.
- MPL/IPL syntax for not equal has been changed from "<>" to "!="
- Removed MakeTheme. Prompts are not longer required to be compiled. You
can delete *.thm from your DATA directory it is no longer used. You MUST
move your default.txt, etc, from your root Mystic BBS directory into your
DATA directory.
+ The N and P keys now go to next and previous pages in the full screen
ANSI viewer.
+ The MATRIX login will now use the matrix login prompts for ALL logins
from matrix login. This means that the standard login will now be
bypassed for menu command XL. Make sure your matrix login looks the
way you want after upgrading, if you use matrix.
! Fixed some quirkiness introduced in A33 around netmail.
! Lots of minor bug fixes that were mostly not reported.
+ The prompt to set the message base pointers by date now defaults to the
current date.
+ The FS editor quote window template has changed (ANSIQUOT). It now allows
the quote window size to be defined and all attributes. 3 screen info
codes are used:
!1 = Defines the text attribute and Y location where normal text ends
!2 = Defines the top Y location of quote window text and attribute
!3 = Defines the bot Y location of quote window and lightbar attribute
+ Added 3 new optional Screen Info codes to the FS editor (ANSIEDIT)
template which allow different types of text to be colored "on the fly".
If you do not want to use these features, just do not set them in your
template.
!4 = Defines the color of capital letters
!5 = Defines the color of punctuation
!6 = Defines the color of numbers
! Fixed issues with the ALT-GR key detection for international keyboards in
the Windows version.
<ALPHA 34 RELEASED> <ALPHA 34 RELEASED>