1926 lines
55 KiB
ObjectPascal
1926 lines
55 KiB
ObjectPascal
Unit BBS_IO;
|
|
|
|
{$I M_OPS.PAS}
|
|
|
|
Interface
|
|
|
|
Uses
|
|
{$IFDEF WINDOWS}
|
|
Windows,
|
|
WinSock2,
|
|
{$ENDIF}
|
|
m_Types,
|
|
m_DateTime,
|
|
m_FileIO,
|
|
m_Strings,
|
|
m_Term_Ansi,
|
|
bbs_Common;
|
|
|
|
Const
|
|
TBBSIOBufferSize = 4 * 1024 - 1;
|
|
MaxPromptInfo = 15;
|
|
|
|
Type
|
|
TGetKeyCallBack = Function (Forced: Boolean) : Boolean Is Nested;
|
|
|
|
TBBSIO = Class
|
|
Core : Pointer;
|
|
Term : TTermAnsi;
|
|
ScreenInfo : Array[0..9] of Record X, Y, A : Byte; End;
|
|
PromptInfo : Array[1..MaxPromptInfo] of String[89];
|
|
FmtString : Boolean;
|
|
FmtLen : Byte;
|
|
FmtType : Byte;
|
|
InMacro : Boolean;
|
|
InMacroPos : Byte;
|
|
InMacroStr : String;
|
|
BaudEmulator : Byte;
|
|
AllowPause : Boolean;
|
|
AllowMCI : Boolean;
|
|
LocalInput : Boolean;
|
|
AllowArrow : Boolean;
|
|
IsArrow : Boolean;
|
|
UseInField : Boolean;
|
|
UseInLimit : Boolean;
|
|
UseInSize : Boolean;
|
|
InLimit : Byte;
|
|
InSize : Byte;
|
|
AllowAbort : Boolean;
|
|
Aborted : Boolean;
|
|
NoFile : Boolean;
|
|
Graphics : Byte;
|
|
PausePtr : Byte;
|
|
InputData : Array[1..mysMaxInputHistory] of String[255];
|
|
LastMCIValue : String;
|
|
InputPos : Byte;
|
|
GetKeyCallBack : TGetKeyCallBack;
|
|
LastSecond : LongInt;
|
|
|
|
{$IFDEF WINDOWS}
|
|
OutBuffer : Array[0..TBBSIOBufferSize] of Char;
|
|
OutBufPos : SmallInt;
|
|
SocketEvent : THandle;
|
|
{$ENDIF}
|
|
|
|
Constructor Create (Var Owner: Pointer);
|
|
Destructor Destroy; Override;
|
|
|
|
Procedure BufAddChar (Ch: Char);
|
|
Procedure BufAddStr (Str: String);
|
|
Procedure BufFlush;
|
|
Function ParseMCI (Display : Boolean; Code: String) : Boolean;
|
|
Function StrMci (Str: String) : String;
|
|
Function Attr2Ansi (Attr: Byte) : String;
|
|
Function Pipe2Ansi (Color : Byte) : String;
|
|
Procedure AnsiGotoXY (X : Byte; Y:Byte);
|
|
Procedure AnsiMoveX (X : Byte);
|
|
Procedure AnsiMoveY (Y : Byte);
|
|
Procedure AnsiColor (A : Byte);
|
|
Procedure AnsiClear;
|
|
Procedure AnsiClrEOL;
|
|
Procedure OutPipe (Str: String);
|
|
Procedure OutPipeLn (Str: String);
|
|
Procedure OutRaw (Str : String);
|
|
Procedure OutRawLn (Str: String);
|
|
Procedure OutBS (Num : Byte; Del: Boolean);
|
|
Procedure OutFull (Str : String);
|
|
Procedure OutFullLn (Str : String);
|
|
Function OutFile (FName : String; DoPause: Boolean; Speed: Byte) : Boolean;
|
|
Function OutYN (Y : Boolean) : String;
|
|
Function OutON (O : Boolean) : String;
|
|
Procedure PauseScreen;
|
|
Function MorePrompt : Char;
|
|
Function DrawPercent (Bar : RecPercent; Part, Whole : SmallInt; Var Percent : SmallInt) : String;
|
|
Function GetInput (Field, Max, Mode: Byte; Default : String) : String;
|
|
Function InXY (X, Y, Field, Max, Mode: Byte; Default: String) : String;
|
|
Function InKey (Wait: LongInt) : Char;
|
|
Function GetYNL (Str: String; Yes: Boolean) : Boolean;
|
|
Function DoInputEvents (Var Ch: Char) : Boolean;
|
|
Function GetKey : Char;
|
|
Function GetYN (Str: String; Yes: Boolean) : Boolean;
|
|
Function GetPW (Str : String; BadStr : String; PW : String) : Boolean;
|
|
Function OneKey (Str: String; Echo: Boolean) : Char;
|
|
Procedure RemoteRestore (Var Image: TConsoleImageRec);
|
|
Procedure PurgeInputBuffer;
|
|
|
|
{$IFDEF WINDOWS}
|
|
Procedure LocalScreenDisable;
|
|
Procedure LocalScreenEnable;
|
|
{$ENDIF}
|
|
End;
|
|
|
|
Implementation
|
|
|
|
Uses
|
|
DOS,
|
|
bbs_Core,
|
|
bbs_General,
|
|
bbs_NodeInfo;
|
|
|
|
Constructor TBBSIO.Create (Var Owner: Pointer);
|
|
Begin
|
|
Core := Owner;
|
|
FmtString := False;
|
|
FmtLen := 0;
|
|
FmtType := 0;
|
|
InMacro := False;
|
|
InMacroPos := 0;
|
|
InMacroStr := '';
|
|
AllowPause := False;
|
|
AllowMCI := True;
|
|
LocalInput := False;
|
|
AllowArrow := False;
|
|
IsArrow := False;
|
|
UseInField := True;
|
|
UseInLimit := False;
|
|
UseInSize := False;
|
|
InLimit := 0;
|
|
InSize := 0;
|
|
AllowAbort := False;
|
|
Aborted := False;
|
|
NoFile := False;
|
|
Graphics := 1;
|
|
PausePtr := 1;
|
|
LastMCIValue := '';
|
|
InputPos := 0;
|
|
|
|
{$IFDEF WINDOWS}
|
|
FillChar(OutBuffer, SizeOf(OutBuffer), 0);
|
|
|
|
OutBufPos := 0;
|
|
|
|
If Not TBBSCore(Core).LocalMode Then
|
|
SocketEvent := WSACreateEvent;
|
|
{$ENDIF}
|
|
|
|
Term := TTermAnsi.Create(Screen);
|
|
End;
|
|
|
|
Destructor TBBSIO.Destroy;
|
|
Begin
|
|
{$IFDEF WINDOWS}
|
|
If Not TBBSCore(Core).LocalMode Then WSACloseEvent(SocketEvent);
|
|
{$ENDIF}
|
|
|
|
Term.Free;
|
|
|
|
Inherited Destroy;
|
|
End;
|
|
|
|
Procedure TBBSIO.BufAddChar (Ch: Char);
|
|
Begin
|
|
{$IFDEF WINDOWS}
|
|
OutBuffer[OutBufPos] := Ch;
|
|
|
|
Inc (OutBufPos);
|
|
|
|
If OutBufPos = TBBSIOBufferSize Then BufFlush;
|
|
{$ENDIF}
|
|
|
|
Term.Process(Ch);
|
|
End;
|
|
|
|
Procedure TBBSIO.BufAddStr (Str: String);
|
|
Var
|
|
Count : Word;
|
|
Begin
|
|
For Count := 1 to Length(Str) Do
|
|
BufAddChar(Str[Count]);
|
|
End;
|
|
|
|
Procedure TBBSIO.BufFlush;
|
|
Var
|
|
Res : LongInt;
|
|
Begin
|
|
{$IFDEF WINDOWS}
|
|
If OutBufPos > 0 Then Begin
|
|
If Not TBBSCore(Core).LocalMode Then
|
|
Res := TBBSCore(Core).Client.WriteBuf(OutBuffer, OutBufPos);
|
|
|
|
OutBufPos := 0;
|
|
End;
|
|
{$ENDIF}
|
|
|
|
{$IFDEF UNIX}
|
|
Screen.BufFlush;
|
|
{$ENDIF}
|
|
End;
|
|
|
|
Procedure TBBSIO.AnsiMoveY (Y : Byte);
|
|
Var
|
|
T : Byte;
|
|
Begin
|
|
If Graphics = 0 Then Exit;
|
|
|
|
T := Screen.CursorY;
|
|
|
|
If Y > T Then BufAddStr (#27 + '[' + strI2S(Y-T) + 'B') Else
|
|
If Y < T Then BufAddStr (#27 + '[' + strI2S(T-Y) + 'A');
|
|
End;
|
|
|
|
Procedure TBBSIO.AnsiMoveX (X : Byte);
|
|
Var
|
|
T : Byte;
|
|
Begin
|
|
If Graphics = 0 Then Exit;
|
|
|
|
T := Screen.CursorX;
|
|
|
|
If X > T Then BufAddStr (#27 + '[' + strI2S(X-T) + 'C') Else
|
|
If X < T Then BufAddStr (#27 + '[' + strI2S(T-X) + 'D');
|
|
End;
|
|
|
|
Procedure TBBSIO.PauseScreen;
|
|
Var
|
|
Attr : Byte;
|
|
Ch : Char;
|
|
Begin
|
|
Attr := Screen.TextAttr;
|
|
|
|
OutFull (TBBSCore(Core).GetPrompt(22));
|
|
|
|
PurgeInputBuffer;
|
|
|
|
Repeat
|
|
Ch := GetKey;
|
|
Until Ch <> '';
|
|
|
|
AnsiColor(Attr);
|
|
|
|
BufAddStr(#13#10);
|
|
End;
|
|
|
|
Function TBBSIO.MorePrompt : Char;
|
|
Var
|
|
SavedAttr : Byte;
|
|
SavedMCI : Boolean;
|
|
Ch : Char;
|
|
Begin
|
|
SavedMCI := AllowMCI;
|
|
AllowMCI := True;
|
|
SavedAttr := Screen.TextAttr;
|
|
|
|
OutFull (TBBSCore(Core).GetPrompt(132));
|
|
|
|
Ch := OneKey('YNC' + #13, False);
|
|
|
|
OutBS (Screen.CursorX, True);
|
|
AnsiColor (SavedAttr);
|
|
|
|
PausePtr := 1;
|
|
AllowMCI := SavedMCI;
|
|
Result := Ch;
|
|
End;
|
|
|
|
Procedure TBBSIO.OutBS (Num: Byte; Del: Boolean);
|
|
Var
|
|
A : Byte;
|
|
Str : String[7];
|
|
Begin
|
|
If Del Then Str := #8#32#8 Else Str := #8;
|
|
|
|
For A := 1 to Num Do
|
|
OutRaw (Str);
|
|
End;
|
|
|
|
Procedure TBBSIO.OutPipe (Str: String);
|
|
Var
|
|
Count : Byte;
|
|
Code : String[2];
|
|
Begin
|
|
If FmtString Then Begin
|
|
|
|
FmtString := False;
|
|
|
|
Case FmtType of
|
|
1 : Str := strPadR(Str, FmtLen + Length(Str) - Length(strStripPipe(Str)), ' ');
|
|
2 : Str := strPadL(Str, FmtLen + Length(Str) - Length(strStripPipe(Str)), ' ');
|
|
3 : Str := strPadC(Str, FmtLen + Length(Str) - Length(strStripPipe(Str)), ' ');
|
|
End;
|
|
End;
|
|
|
|
Count := 1;
|
|
|
|
While Count <= Length(Str) Do Begin
|
|
If (Str[Count] = '|') and (Count < Length(Str) - 1) Then Begin
|
|
Code := Copy(Str, Count + 1, 2);
|
|
If Code = '00' Then BufAddStr(Pipe2Ansi(0)) Else
|
|
If Code = '01' Then BufAddStr(Pipe2Ansi(1)) Else
|
|
If Code = '02' Then BufAddStr(Pipe2Ansi(2)) Else
|
|
If Code = '03' Then BufAddStr(Pipe2Ansi(3)) Else
|
|
If Code = '04' Then BufAddStr(Pipe2Ansi(4)) Else
|
|
If Code = '05' Then BufAddStr(Pipe2Ansi(5)) Else
|
|
If Code = '06' Then BufAddStr(Pipe2Ansi(6)) Else
|
|
If Code = '07' Then BufAddStr(Pipe2Ansi(7)) Else
|
|
If Code = '08' Then BufAddStr(Pipe2Ansi(8)) Else
|
|
If Code = '09' Then BufAddStr(Pipe2Ansi(9)) Else
|
|
If Code = '10' Then BufAddStr(Pipe2Ansi(10)) Else
|
|
If Code = '11' Then BufAddStr(Pipe2Ansi(11)) Else
|
|
If Code = '12' Then BufAddStr(Pipe2Ansi(12)) Else
|
|
If Code = '13' Then BufAddStr(Pipe2Ansi(13)) Else
|
|
If Code = '14' Then BufAddStr(Pipe2Ansi(14)) Else
|
|
If Code = '15' Then BufAddStr(Pipe2Ansi(15)) Else
|
|
If Code = '16' Then BufAddStr(Pipe2Ansi(16)) Else
|
|
If Code = '17' Then BufAddStr(Pipe2Ansi(17)) Else
|
|
If Code = '18' Then BufAddStr(Pipe2Ansi(18)) Else
|
|
If Code = '19' Then BufAddStr(Pipe2Ansi(19)) Else
|
|
If Code = '20' Then BufAddStr(Pipe2Ansi(20)) Else
|
|
If Code = '21' Then BufAddStr(Pipe2Ansi(21)) Else
|
|
If Code = '22' Then BufAddStr(Pipe2Ansi(22)) Else
|
|
If Code = '23' Then BufAddStr(Pipe2Ansi(23)) Else
|
|
BufAddStr(Str[Count] + Code);
|
|
Inc (Count, 2);
|
|
End Else
|
|
BufAddChar(Str[Count]);
|
|
|
|
Inc (Count);
|
|
End;
|
|
End;
|
|
|
|
Procedure TBBSIO.OutPipeLn (Str : String);
|
|
Begin
|
|
OutPipe (Str + #13#10);
|
|
Inc (PausePtr);
|
|
End;
|
|
|
|
Procedure TBBSIO.OutRaw (Str: String);
|
|
Begin
|
|
If FmtString Then Begin
|
|
|
|
FmtString := False;
|
|
|
|
Case FmtType of
|
|
1 : Str := strPadR(Str, FmtLen, ' ');
|
|
2 : Str := strPadL(Str, FmtLen, ' ');
|
|
3 : Str := strPadC(Str, FmtLen, ' ');
|
|
End;
|
|
End;
|
|
|
|
BufAddStr(Str);
|
|
End;
|
|
|
|
Procedure TBBSIO.OutRawLn (Str: String);
|
|
Begin
|
|
BufAddStr (Str + #13#10);
|
|
Inc (PausePtr);
|
|
End;
|
|
|
|
Function TBBSIO.ParseMCI (Display: Boolean; Code: String) : Boolean;
|
|
Var
|
|
A : LongInt;
|
|
Begin
|
|
LastMCIValue := #255;
|
|
Result := True;
|
|
|
|
If Not AllowMCI Then Begin
|
|
Result := False;
|
|
Exit;
|
|
End;
|
|
|
|
Case Code[1] of
|
|
'!' : If Code[2] in ['0'..'9'] Then Begin
|
|
A := strS2I(Code[2]);
|
|
|
|
ScreenInfo[A].X := Screen.CursorX;
|
|
ScreenInfo[A].Y := Screen.CursorY;
|
|
ScreenInfo[A].A := Screen.TextAttr;
|
|
End Else Begin
|
|
Result := False;
|
|
|
|
Exit;
|
|
End;
|
|
'$' : Case Code[2] of
|
|
'C' : Begin
|
|
FmtString := True;
|
|
FmtType := 3;
|
|
End;
|
|
'D' : Begin
|
|
FmtString := True;
|
|
FmtType := 4;
|
|
End;
|
|
'L' : Begin
|
|
FmtString := True;
|
|
FmtType := 2;
|
|
End;
|
|
'R' : Begin
|
|
FmtString := True;
|
|
FmtType := 1;
|
|
End;
|
|
'X' : Begin
|
|
FmtString := True;
|
|
FmtType := 17;
|
|
End;
|
|
End;
|
|
'&' : Case Code[2] of
|
|
'1' : LastMCIValue := PromptInfo[1];
|
|
'2' : LastMCIValue := PromptInfo[2];
|
|
'3' : LastMCIValue := PromptInfo[3];
|
|
'4' : LastMCIValue := PromptInfo[4];
|
|
'5' : LastMCIValue := PromptInfo[5];
|
|
'6' : LastMCIValue := PromptInfo[6];
|
|
'7' : LastMCIValue := PromptInfo[7];
|
|
'8' : LastMCIValue := PromptInfo[8];
|
|
'9' : LastMCIValue := PromptInfo[9];
|
|
'0' : LastMCIValue := PromptInfo[10];
|
|
'A' : LastMCIValue := PromptInfo[11];
|
|
'B' : LastMCIValue := PromptInfo[12];
|
|
'C' : LastMCIValue := PromptInfo[13];
|
|
'D' : LastMCIValue := PromptInfo[14];
|
|
'E' : LastMCIValue := PromptInfo[15];
|
|
End;
|
|
'0' : Case Code[2] of
|
|
'0' : LastMCIValue := Pipe2Ansi(0);
|
|
'1' : LastMCIValue := Pipe2Ansi(1);
|
|
'2' : LastMCIValue := Pipe2Ansi(2);
|
|
'3' : LastMCIValue := Pipe2Ansi(3);
|
|
'4' : LastMCIValue := Pipe2Ansi(4);
|
|
'5' : LastMCIValue := Pipe2Ansi(5);
|
|
'6' : LastMCIValue := Pipe2Ansi(6);
|
|
'7' : LastMCIValue := Pipe2Ansi(7);
|
|
'8' : LastMCIValue := Pipe2Ansi(8);
|
|
'9' : LastMCIValue := Pipe2Ansi(9);
|
|
End;
|
|
'1' : Case Code[2] of
|
|
'0' : LastMCIValue := Pipe2Ansi(10);
|
|
'1' : LastMCIValue := Pipe2Ansi(11);
|
|
'2' : LastMCIValue := Pipe2Ansi(12);
|
|
'3' : LastMCIValue := Pipe2Ansi(13);
|
|
'4' : LastMCIValue := Pipe2Ansi(14);
|
|
'5' : LastMCIValue := Pipe2Ansi(15);
|
|
'6' : LastMCIValue := Pipe2Ansi(16);
|
|
'7' : LastMCIValue := Pipe2Ansi(17);
|
|
'8' : LastMCIValue := Pipe2Ansi(18);
|
|
'9' : LastMCIValue := Pipe2Ansi(19);
|
|
End;
|
|
'2' : Case Code[2] of
|
|
'0' : LastMCIValue := Pipe2Ansi(20);
|
|
'1' : LastMCIValue := Pipe2Ansi(21);
|
|
'2' : LastMCIValue := Pipe2Ansi(22);
|
|
'3' : LastMCIValue := Pipe2Ansi(23);
|
|
End;
|
|
'A' : Case Code[2] of
|
|
'G' : LastMCIValue := strI2S(DaysAgo(TBBSCore(Core).User.ThisUser.Birthday) DIV 365);
|
|
'S' : LastMCIValue := OutON(TBBSCore(Core).User.ThisUser.SigUse);
|
|
'V' : LastMCIValue := OutYN(Chat.Available);
|
|
End;
|
|
'B' : Case Code[2] of
|
|
'D' : If TBBSCore(Core).LocalMode Then
|
|
LastMCIValue := 'LOCAL' {++lang add these to lang file }
|
|
Else
|
|
LastMCIValue := 'TELNET'; {++lang }
|
|
'E' : LastMCIValue := ^G;
|
|
'I' : LastMCIValue := DateJulian2Str(TBBSCore(Core).User.ThisUser.Birthday, TBBSCore(Core).User.ThisUser.DateType);
|
|
'N' : LastMCIValue := Config.BBSName;
|
|
'S' : OutBS(1, True);
|
|
End;
|
|
'C' : Case Code[2] of
|
|
'L' : AnsiClear;
|
|
'M' : LastMCIValue := OutON(TBBSCore(Core).User.ThisUser.UseFullChat);
|
|
'R' : OutRawLn ('');
|
|
'S' : LastMCIValue := strI2S(TBBSCore(Core).User.ThisUser.Calls);
|
|
'T' : LastMCIValue := strI2S(TBBSCore(Core).User.ThisUser.CallsToday);
|
|
End;
|
|
'D' : Case Code[2] of
|
|
'A' : LastMCIValue := DateDos2Str(CurDateDos, TBBSCore(Core).User.ThisUser.DateType);
|
|
'E' : Begin
|
|
BufFlush;
|
|
WaitMS(500);
|
|
End;
|
|
'F' : Begin
|
|
FmtString := True;
|
|
FmtType := 5;
|
|
End;
|
|
'I' : Begin
|
|
FmtString := True;
|
|
FmtType := 16;
|
|
End;
|
|
'K' : LastMCIValue := strI2S(TBBSCore(Core).User.ThisUser.DLk);
|
|
'L' : LastMCIValue := strI2S(TBBSCore(Core).User.ThisUser.DLs);
|
|
'T' : LastMCIValue := strI2S(TBBSCore(Core).User.ThisUser.DLsToday);
|
|
End;
|
|
'F' : Case Code[2] of
|
|
'B' : LastMCIValue := TBBSCore(Core).FileBase.FBase.Name;
|
|
'G' : LastMCIValue := TBBSCore(Core).FileBase.FGroup.Name;
|
|
'K' : LastMCIValue := strI2S(TBBSCore(Core).User.ThisUser.ULk);
|
|
'O' : LastMCIValue := DateDos2Str(TBBSCore(Core).User.ThisUser.FirstOn, TBBSCore(Core).User.ThisUser.DateType);
|
|
'U' : LastMCIValue := strI2S(TBBSCore(Core).User.ThisUser.ULs);
|
|
End;
|
|
'H' : Case Code[2] of
|
|
'K' : LastMCIValue := OutON(TBBSCore(Core).User.ThisUser.HotKeys);
|
|
End;
|
|
'I' : Case Code[2] of
|
|
'F' : UseInField := False;
|
|
'N' : Begin
|
|
FmtString := True;
|
|
FmtType := 12;
|
|
End;
|
|
'L' : LastMCIValue := OutON(Chat.Invisible);
|
|
'S' : Begin
|
|
FmtString := True;
|
|
FmtType := 14;
|
|
End;
|
|
End;
|
|
'K' : Case Code[2] of
|
|
'T' : LastMCIValue := strI2S(TBBSCore(Core).User.ThisUser.DLkToday);
|
|
End;
|
|
'L' : Case Code[2] of
|
|
'O' : LastMCIValue := DateDos2Str(TBBSCore(Core).User.ThisUser.LastOn, TBBSCore(Core).User.ThisUser.DateType);
|
|
End;
|
|
'M' : Case Code[2] of
|
|
'B' : LastMCIValue := TBBSCore(Core).Msgs.MBase.Name;
|
|
'D' : If Session.Menu.Data <> NIL Then
|
|
LastMCIValue := Session.Menu.Data.Info.Description
|
|
Else
|
|
LastMCIValue := '';
|
|
'E' : LastMCIValue := strI2S(TBBSCore(Core).User.ThisUser.Emails);
|
|
'G' : LastMCIValue := TBBSCore(Core).Msgs.Group.Name;
|
|
'L' : LastMCIValue := OutON(TBBSCore(Core).User.ThisUser.UseLBIndex);
|
|
'N' : LastMCIValue := Config.NetDesc[TBBSCore(Core).Msgs.MBase.NetAddr];
|
|
'P' : LastMCIValue := strI2S(TBBSCore(Core).User.ThisUser.Posts);
|
|
'T' : LastMCIValue := strI2S(TBBSCore(Core).Msgs.GetTotalMessages(TBBSCore(Core).Msgs.MBase));
|
|
End;
|
|
'N' : Case Code[2] of
|
|
'D' : LastMCIValue := strI2S(TBBSCore(Core).NodeNum);
|
|
'E' : LastMCIValue := strI2S(TBBSCore(Core).MinutesUntilEvent(TBBSCore(Core).NextEvent.ExecTime));
|
|
End;
|
|
'O' : Case Code[2] of
|
|
'S' : LastMCIValue := OSID;
|
|
End;
|
|
'P' : Case Code[2] of
|
|
'A' : PauseScreen;
|
|
'B' : PurgeInputBuffer;
|
|
'C' : Begin
|
|
A := 0;
|
|
If TBBSCore(Core).User.ThisUser.Calls > 0 Then
|
|
A := Round(TBBSCore(Core).User.ThisUser.Posts / TBBSCore(Core).User.ThisUser.Calls * 100);
|
|
LastMCIValue := strI2S(A);
|
|
End;
|
|
'I' : BufAddChar('|');
|
|
'N' : Repeat Until GetKey <> '';
|
|
'O' : AllowPause := False;
|
|
'W' : LastMCIValue := strI2S(Config.PWChange);
|
|
End;
|
|
'Q' : Case Code[2] of
|
|
'A' : LastMCIValue := TBBSCore(Core).User.ThisUser.Archive;
|
|
'L' : LastMCIValue := OutYN (TBBSCore(Core).User.ThisUser.QwkFiles);
|
|
'O' : ShowRandomQuote;
|
|
End;
|
|
'R' : Case Code[2] of
|
|
'D' : LastMCIValue := strI2S(TBBSCore(Core).User.Security.DLRatio);
|
|
'K' : LastMCIValue := strI2S(TBBSCore(Core).User.Security.DLkRatio);
|
|
'P' : Begin
|
|
FmtString := True;
|
|
FmtType := 13;
|
|
End;
|
|
End;
|
|
'S' : Case Code[2] of
|
|
'B' : LastMCIValue := strI2S(TBBSCore(Core).User.Security.MaxTB);
|
|
'C' : LastMCIValue := strI2S(TBBSCore(Core).User.Security.MaxCalls);
|
|
'D' : LastMCIValue := TBBSCore(Core).User.Security.Desc;
|
|
'K' : LastMCIValue := strI2S(TBBSCore(Core).User.Security.MaxDLK);
|
|
'L' : LastMCIValue := strI2S(TBBSCore(Core).User.ThisUser.Security);
|
|
'N' : LastMCIValue := Config.SysopName;
|
|
'P' : Begin
|
|
A := Round(TBBSCore(Core).User.Security.PCRatio / 100 * 100);
|
|
LastMCIValue := strI2S(A);
|
|
End;
|
|
'T' : LastMCIValue := strI2S(TBBSCore(Core).User.Security.Time);
|
|
'X' : LastMCIValue := strI2S(TBBSCore(Core).User.Security.MaxDLs);
|
|
End;
|
|
'T' : Case Code[2] of
|
|
'0'..
|
|
'9' : LastMCIValue := Attr2Ansi(Session.Theme.Colors[strS2I(Code[2])]);
|
|
'B' : LastMCIValue := strI2S(TBBSCore(Core).User.ThisUser.TimeBank);
|
|
'C' : LastMCIValue := strI2S(Config.SystemCalls);
|
|
'E' : If Graphics = 1 Then LastMCIValue := 'Ansi' Else LastMCIValue := 'Ascii'; //++lang
|
|
'I' : LastMCIValue := TimeDos2Str(CurDateDos, True);
|
|
'L' : LastMCIValue := strI2S(TBBSCore(Core).TimeLeft);
|
|
'O' : LastMCIValue := strI2S(TBBSCore(Core).ElapsedTime);
|
|
End;
|
|
'U' : Case Code[2] of
|
|
'#' : LastMCIValue := strI2S(TBBSCore(Core).User.ThisUser.PermIdx);
|
|
'1' : LastMCIValue := TBBSCore(Core).User.ThisUser.OptionData[1];
|
|
'2' : LastMCIValue := TBBSCore(Core).User.ThisUser.OptionData[2];
|
|
'3' : LastMCIValue := TBBSCore(Core).User.ThisUser.OptionData[3];
|
|
'A' : LastMCIValue := TBBSCore(Core).User.ThisUser.Address;
|
|
'B' : Case TBBSCore(Core).User.ThisUser.FileList of
|
|
0 : LastMCIValue := 'Normal';
|
|
1 : LastMCIValue := 'Lightbar'; {++lang}
|
|
End;
|
|
'C' : LastMCIValue := TBBSCore(Core).User.ThisUser.City;
|
|
'D' : LastMCIValue := TBBSCore(Core).User.ThisUser.DataPhone;
|
|
'E' : Case TBBSCore(Core).User.ThisUser.EditType of
|
|
0 : LastMCIValue := 'Line'; {++lang}
|
|
1 : LastMCIValue := 'Full';
|
|
2 : LastMCIValue := 'Ask';
|
|
End;
|
|
'F' : LastMCIValue := DateTypeStr[TBBSCore(Core).User.ThisUser.DateType];
|
|
'G' : If TBBSCore(Core).User.ThisUser.Gender = 'M' Then
|
|
LastMCIValue := 'Male'
|
|
Else
|
|
LastMCIValue := 'Female'; {++lang}
|
|
'H' : LastMCIValue := TBBSCore(Core).User.ThisUser.Handle;
|
|
'I' : LastMCIValue := TBBSCore(Core).User.ThisUser.UserInfo;
|
|
'J' : Case TBBSCore(Core).User.ThisUser.MReadType of
|
|
0 : LastMCIValue := 'Normal';
|
|
1 : LastMCIValue := 'Lightbar'; {++lang}
|
|
End;
|
|
'K' : LastMCIValue := TBBSCore(Core).User.ThisUser.Email;
|
|
'L' : LastMCIValue := TBBSCore(Core).Theme.Desc;
|
|
'M' : LastMCIValue := OutON(TBBSCore(Core).User.ThisUser.UseLBMIdx);
|
|
'N' : LastMCIValue := TBBSCore(Core).User.ThisUser.RealName;
|
|
'P' : LastMCIValue := TBBSCore(Core).User.ThisUser.HomePhone;
|
|
'Q' : Case TBBSCore(Core).User.ThisUser.UseLBQuote of
|
|
False : LastMCIValue := 'Standard';
|
|
True : LastMCIValue := 'Lightbar'; {++langfile++}
|
|
End;
|
|
'S' : LastMCIValue := strI2S(TBBSCore(Core).User.ThisUser.ScreenSize);
|
|
'X' : LastMCIValue := TBBSCore(Core).UserHostInfo;
|
|
'Y' : LastMCIValue := TBBSCore(Core).UserIPInfo;
|
|
'Z' : LastMCIValue := TBBSCore(Core).User.ThisUser.ZipCode;
|
|
End;
|
|
'V' : Case Code[2] of
|
|
'R' : LastMCIValue := mysVersion;
|
|
End;
|
|
'X' : Case Code[2] of
|
|
'D' : If DateValid(Session.User.ThisUser.Expires) Then
|
|
LastMCIValue := strI2S(Abs(CurDateJulian - DateStr2Julian(Session.User.ThisUser.Expires)))
|
|
Else
|
|
LastMCIValue := '0';
|
|
'S' : LastMCIValue := strI2S(Session.User.ThisUser.ExpiresTo);
|
|
'X' : LastMCIValue := '';
|
|
End;
|
|
'[' : Case Code[2] of
|
|
'A' : Begin
|
|
FmtString := True;
|
|
FmtType := 8;
|
|
End;
|
|
'B' : Begin
|
|
FmtString := True;
|
|
FmtType := 9;
|
|
End;
|
|
'C' : Begin
|
|
FmtString := True;
|
|
FmtType := 10;
|
|
End;
|
|
'D' : Begin
|
|
FmtString := True;
|
|
FmtType := 11;
|
|
End;
|
|
'K' : AnsiClrEOL;
|
|
'L' : Begin
|
|
FmtString := True;
|
|
FmtType := 15;
|
|
End;
|
|
'X' : Begin
|
|
FmtString := True;
|
|
FmtType := 6;
|
|
End;
|
|
'Y' : Begin
|
|
FmtString := True;
|
|
FmtType := 7;
|
|
End;
|
|
End;
|
|
Else
|
|
Result := False;
|
|
End;
|
|
|
|
If Display And (LastMCIValue <> #255) Then
|
|
OutPipe(LastMCIValue);
|
|
End;
|
|
|
|
Procedure TBBSIO.OutFull (Str : String);
|
|
Var
|
|
A : Byte;
|
|
B : Byte;
|
|
Begin
|
|
A := 1;
|
|
|
|
While A <= Length(Str) Do Begin
|
|
If (Str[A] = '|') and (A < Length(Str) - 1) Then Begin
|
|
|
|
If Not ParseMCI (True, Copy(Str, A + 1, 2)) Then Begin
|
|
BufAddChar(Str[A]);
|
|
Inc(A);
|
|
Continue;
|
|
End;
|
|
|
|
Inc (A, 2);
|
|
|
|
If FmtString Then Begin
|
|
If FmtType = 5 Then Begin
|
|
FmtString := False;
|
|
|
|
B := A + 1;
|
|
|
|
While (Str[B] <> ' ') and (Str[B] <> '|') and (B <= Length(Str)) Do
|
|
Inc (B);
|
|
|
|
OutFile (JustFile(strStripLOW(Copy(Str, A + 1, B - A - 1))), True, 0);
|
|
|
|
A := B;
|
|
|
|
Continue;
|
|
End;
|
|
|
|
FmtLen := strS2I(Copy(Str, A + 1, 2));
|
|
Inc (A, 2);
|
|
|
|
Case FmtType of
|
|
4 : Begin
|
|
Inc (A);
|
|
FmtString := False;
|
|
BufAddStr (strRep(Str[A], FmtLen));
|
|
End;
|
|
6 : Begin
|
|
AnsiMoveX (FmtLen);
|
|
FmtString := False;
|
|
End;
|
|
7 : Begin
|
|
AnsiMoveY (FmtLen);
|
|
FmtString := False;
|
|
End;
|
|
8 : Begin
|
|
AnsiMoveY (Screen.CursorY - FmtLen);
|
|
FmtString := False;
|
|
End;
|
|
9 : Begin
|
|
AnsiMoveY (Screen.CursorY + FmtLen);
|
|
FmtString := False;
|
|
End;
|
|
10: Begin
|
|
AnsiMoveX (Screen.CursorX + FmtLen);
|
|
FmtString := False;
|
|
End;
|
|
11: Begin
|
|
AnsiMoveX (Screen.CursorX - FmtLen);
|
|
FmtString := False;
|
|
End;
|
|
12: Begin
|
|
UseInLimit := True;
|
|
InLimit := FmtLen;
|
|
FmtString := False;
|
|
End;
|
|
13: Begin
|
|
PausePtr := FmtLen;
|
|
FmtString := False;
|
|
End;
|
|
14: Begin
|
|
UseInSize := True;
|
|
InSize := FmtLen;
|
|
FmtString := False;
|
|
End;
|
|
15: Begin
|
|
While Screen.CursorX > FmtLen Do
|
|
OutBS(1, True);
|
|
|
|
FmtString := False;
|
|
End;
|
|
17: Begin
|
|
Inc (A);
|
|
FmtString := False;
|
|
|
|
If Screen.CursorX < FmtLen Then
|
|
BufAddStr (strRep(Str[A], FmtLen - Screen.CursorX + 1));
|
|
End;
|
|
End;
|
|
End;
|
|
End Else
|
|
BufAddChar (Str[A]);
|
|
|
|
Inc(A);
|
|
End;
|
|
End;
|
|
|
|
Procedure TBBSIO.OutFullLn (Str : String);
|
|
Begin
|
|
OutFull (Str + #13#10);
|
|
Inc (PausePtr);
|
|
End;
|
|
|
|
Procedure TBBSIO.AnsiClrEOL;
|
|
Begin
|
|
BufAddStr (#27 + '[K');
|
|
End;
|
|
|
|
Function TBBSIO.Pipe2Ansi (Color: Byte) : String;
|
|
Var
|
|
CurFG : Byte;
|
|
CurBG : Byte;
|
|
Prefix : String[2];
|
|
Begin
|
|
Result := '';
|
|
|
|
If Graphics = 0 Then Exit;
|
|
|
|
CurBG := (Screen.TextAttr SHR 4) AND 7;
|
|
CurFG := Screen.TextAttr AND $F;
|
|
Prefix := '';
|
|
|
|
If Color < 16 Then Begin
|
|
If Color = CurFG Then Exit;
|
|
|
|
// Screen.TextAttr := Color + CurBG * 16;
|
|
|
|
If (Color < 8) and (CurFG > 7) Then Prefix := '0;';
|
|
If (Color > 7) and (CurFG < 8) Then Prefix := '1;';
|
|
If Color > 7 Then Dec(Color, 8);
|
|
|
|
Case Color of
|
|
00: Result := #27 + '[' + Prefix + '30';
|
|
01: Result := #27 + '[' + Prefix + '34';
|
|
02: Result := #27 + '[' + Prefix + '32';
|
|
03: Result := #27 + '[' + Prefix + '36';
|
|
04: Result := #27 + '[' + Prefix + '31';
|
|
05: Result := #27 + '[' + Prefix + '35';
|
|
06: Result := #27 + '[' + Prefix + '33';
|
|
07: Result := #27 + '[' + Prefix + '37';
|
|
End;
|
|
|
|
If Prefix <> '0;' Then
|
|
Result := Result + 'm'
|
|
Else
|
|
Case CurBG of
|
|
00: Result := Result + ';40m';
|
|
01: Result := Result + ';44m';
|
|
02: Result := Result + ';42m';
|
|
03: Result := Result + ';46m';
|
|
04: Result := Result + ';41m';
|
|
05: Result := Result + ';45m';
|
|
06: Result := Result + ';43m';
|
|
07: Result := Result + ';47m';
|
|
End;
|
|
End Else Begin
|
|
If (Color - 16) = CurBG Then Exit;
|
|
|
|
// Screen.TextAttr := CurFG + (Color - 16) * 16;
|
|
|
|
Case Color of
|
|
16: Result := #27 + '[40m';
|
|
17: Result := #27 + '[44m';
|
|
18: Result := #27 + '[42m';
|
|
19: Result := #27 + '[46m';
|
|
20: Result := #27 + '[41m';
|
|
21: Result := #27 + '[45m';
|
|
22: Result := #27 + '[43m';
|
|
23: Result := #27 + '[47m';
|
|
End;
|
|
End;
|
|
End;
|
|
|
|
Function TBBSIO.Attr2Ansi (Attr: Byte) : String;
|
|
Begin
|
|
Result := '';
|
|
|
|
If Graphics = 0 Then Exit;
|
|
|
|
Result := Pipe2Ansi(Attr AND $F) + Pipe2Ansi(((Attr SHR 4) AND 7) + 16);
|
|
End;
|
|
|
|
Procedure TBBSIO.AnsiColor (A : Byte);
|
|
Begin
|
|
If Graphics = 0 Then Exit;
|
|
|
|
BufAddStr(Attr2Ansi(A));
|
|
End;
|
|
|
|
Procedure TBBSIO.AnsiGotoXY (X: Byte; Y: Byte);
|
|
Begin
|
|
If Graphics = 0 Then Exit;
|
|
|
|
If X = 0 Then X := Screen.CursorX;
|
|
If Y = 0 Then Y := Screen.CursorY;
|
|
|
|
BufAddStr (#27'[' + strI2S(Y) + ';' + strI2S(X) + 'H');
|
|
End;
|
|
|
|
Procedure TBBSIO.AnsiClear;
|
|
Begin
|
|
If Graphics > 0 Then
|
|
BufAddStr (#27 + '[2J')
|
|
Else
|
|
BufAddChar (#12);
|
|
|
|
PausePtr := 1;
|
|
End;
|
|
|
|
Function TBBSIO.OutYN (Y: Boolean) : String;
|
|
Begin
|
|
If Y Then OutYN := 'Yes' Else OutYN := 'No'; {++lang?}
|
|
End;
|
|
|
|
Function TBBSIO.OutON (O : Boolean) : String;
|
|
Begin
|
|
If O Then OutON := 'On' Else OutON := 'Off'; {++lang}
|
|
End;
|
|
|
|
Function TBBSIO.OutFile (FName : String; DoPause: Boolean; Speed: Byte) : Boolean;
|
|
Var
|
|
Buffer : Array[1..4096] of Char;
|
|
BufPos : LongInt;
|
|
BufSize : LongInt;
|
|
dFile : File;
|
|
Ext : String[4];
|
|
Code : String[2];
|
|
Old : Boolean;
|
|
Str : String;
|
|
Ch : Char;
|
|
Done : Boolean;
|
|
|
|
Function CheckFileInPath (Path: String) : Boolean;
|
|
Var
|
|
Temp : String;
|
|
Begin
|
|
Result := False;
|
|
Temp := Path + FName;
|
|
|
|
If (Graphics = 1) and (FileExist(Temp + '.ans')) Then Begin
|
|
Ext := '.ans';
|
|
FName := Temp;
|
|
Result := True;
|
|
End Else
|
|
If FileExist(Temp + '.asc') Then Begin
|
|
Ext := '.asc';
|
|
FName := Temp;
|
|
Result := True;
|
|
End;
|
|
End;
|
|
|
|
Function GetChar : Char;
|
|
Begin
|
|
If BufPos = BufSize Then Begin
|
|
BlockRead (dFile, Buffer, SizeOf(Buffer), BufSize);
|
|
|
|
BufPos := 0;
|
|
|
|
If BufSize = 0 Then Begin
|
|
Done := True;
|
|
Buffer[1] := #26;
|
|
End;
|
|
End;
|
|
|
|
Inc (BufPos);
|
|
|
|
Result := Buffer[BufPos];
|
|
End;
|
|
|
|
Begin
|
|
Result := False;
|
|
NoFile := True;
|
|
|
|
If (Pos(PathSep, FName) > 0) or (Pos('.', FName) > 0) Then Begin
|
|
If Not FileExist(FName) Then
|
|
If Not CheckFileInPath('') Then Exit;
|
|
End Else Begin
|
|
If Not CheckFileInPath(Session.Theme.TextPath) Then
|
|
If Session.Theme.Flags AND thmFallBack <> 0 Then Begin
|
|
If Not CheckFileInPath(Config.TextPath) Then Exit;
|
|
End Else
|
|
Exit;
|
|
|
|
If FileExist(FName + Copy(Ext, 1, 3) + '1') Then Begin
|
|
Repeat
|
|
BufPos := Random(9);
|
|
|
|
If BufPos = 0 Then
|
|
Code := Ext[Length(Ext)]
|
|
Else
|
|
Code := strI2S(BufPos);
|
|
|
|
Until FileExist(FName + Copy(Ext, 1, 3) + Code);
|
|
|
|
Ext := Copy(Ext, 1, 3) + Code;
|
|
End;
|
|
End;
|
|
|
|
Assign (dFile, FName + Ext);
|
|
|
|
{$I-} Reset(dFile, 1); {$I+}
|
|
|
|
If IoResult <> 0 Then Exit;
|
|
|
|
NoFile := False;
|
|
Result := True;
|
|
Old := AllowPause;
|
|
AllowPause := DoPause;
|
|
PausePtr := 1;
|
|
Done := False;
|
|
BufPos := 0;
|
|
BufSize := 0;
|
|
Ch := #0;
|
|
BaudEmulator := Speed;
|
|
|
|
While Not Done Do Begin
|
|
Ch := GetChar;
|
|
|
|
If BaudEmulator > 0 Then Begin
|
|
BufFlush;
|
|
|
|
If BufPos MOD BaudEmulator = 0 Then WaitMS(6);
|
|
End;
|
|
|
|
Case Ch of
|
|
#10 : Begin
|
|
BufAddChar (#10);
|
|
Inc (PausePtr);
|
|
|
|
If (PausePtr = TBBSCore(Core).User.ThisUser.ScreenSize) and (AllowPause) Then
|
|
Case MorePrompt of
|
|
'N' : Break;
|
|
'C' : AllowPause := False;
|
|
End;
|
|
End;
|
|
#26 : Break;
|
|
'|' : Begin
|
|
Code := GetChar;
|
|
Code := Code + GetChar;
|
|
|
|
If Not ParseMCI(True, Code) Then Begin
|
|
BufAddStr('|' + Code);
|
|
Continue;
|
|
End;
|
|
|
|
If FmtString Then Begin
|
|
If FmtType = 5 Then Begin
|
|
FmtString := False;
|
|
Str := '';
|
|
|
|
While Not Done Do Begin
|
|
Ch := GetChar;
|
|
If Ch in [#10, '|'] Then Break;
|
|
Str := Str + GetChar;
|
|
End;
|
|
|
|
OutFile (JustFile(strStripLOW(Str)), True, 0);
|
|
|
|
Continue;
|
|
End;
|
|
|
|
Code := GetChar;
|
|
Code := Code + GetChar;
|
|
FmtLen := strS2I(Code);
|
|
|
|
Case FmtType of
|
|
4 : Begin
|
|
BufAddStr (strRep(GetChar, FmtLen));
|
|
FmtString := False;
|
|
End;
|
|
6 : Begin
|
|
AnsiMoveX (FmtLen);
|
|
FmtString := False;
|
|
End;
|
|
7 : Begin
|
|
AnsiMoveY (FmtLen);
|
|
FmtString := False;
|
|
End;
|
|
8 : Begin
|
|
AnsiMoveY (Screen.CursorY - FmtLen);
|
|
FmtString := False;
|
|
End;
|
|
9 : Begin
|
|
AnsiMoveY (Screen.CursorY + FmtLen);
|
|
FmtString := False;
|
|
End;
|
|
10: Begin
|
|
AnsiMoveX (Screen.CursorX + FmtLen);
|
|
FmtString := False;
|
|
End;
|
|
11: Begin
|
|
AnsiMoveX (Screen.CursorX - FmtLen);
|
|
FmtString := False;
|
|
End;
|
|
12: Begin
|
|
UseInLimit := True;
|
|
InLimit := FmtLen;
|
|
FmtString := False;
|
|
End;
|
|
13: Begin
|
|
PausePtr := FmtLen;
|
|
FmtString := True;
|
|
End;
|
|
14: Begin
|
|
UseInSize := True;
|
|
InSize := FmtLen;
|
|
FmtString := False;
|
|
End;
|
|
15: Begin
|
|
While Screen.CursorX > FmtLen Do
|
|
OutBS(1, True);
|
|
|
|
FmtString := False;
|
|
End;
|
|
16: Begin
|
|
BaudEmulator := FmtLen;
|
|
FmtString := False;
|
|
End;
|
|
17: Begin
|
|
FmtString := False;
|
|
|
|
If Screen.CursorX < FmtLen Then
|
|
BufAddStr (strRep(GetChar, FmtLen - Screen.CursorX + 1));
|
|
End;
|
|
End;
|
|
End;
|
|
End;
|
|
Else
|
|
BufAddChar(Ch);
|
|
End;
|
|
End;
|
|
|
|
AllowPause := Old;
|
|
Close (dFile);
|
|
|
|
BufFlush;
|
|
End;
|
|
|
|
{$IFDEF UNIX}
|
|
Function TBBSIO.InKey (Wait: LongInt) : Char;
|
|
Begin
|
|
Result := #255;
|
|
IsArrow := False;
|
|
|
|
If Input.KeyWait(Wait) Then Begin
|
|
Result := Input.ReadKey;
|
|
LocalInput := True;
|
|
|
|
If Result = #0 Then Begin
|
|
Result := Input.ReadKey;
|
|
|
|
If (AllowArrow) and (Result in [#71..#73, #75, #77, #79..#83]) Then Begin
|
|
IsArrow := True;
|
|
Exit;
|
|
End;
|
|
|
|
Result := #255;
|
|
End;
|
|
End;
|
|
End;
|
|
{$ENDIF}
|
|
|
|
{$IFDEF WINDOWS}
|
|
Function TBBSIO.InKey (Wait: LongInt) : Char;
|
|
Var
|
|
Handles : Array[0..1] of THandle;
|
|
InType : Byte;
|
|
Begin
|
|
Result := #255;
|
|
|
|
Handles[0] := Input.ConIn;
|
|
|
|
If Not TBBSCore(Core).LocalMode Then Begin
|
|
If TBBSCore(Core).Client.DataWaiting Then
|
|
InType := 2
|
|
Else Begin
|
|
Handles[1] := SocketEvent;
|
|
|
|
WSAResetEvent (Handles[1]);
|
|
WSAEventSelect (TBBSCore(Core).Client.FSocketHandle, Handles[1], FD_READ OR FD_CLOSE);
|
|
|
|
Case WaitForMultipleObjects(2, @Handles, False, Wait) of
|
|
WAIT_OBJECT_0 : InType := 1;
|
|
WAIT_OBJECT_0 + 1 : InType := 2;
|
|
Else
|
|
Exit;
|
|
End;
|
|
End;
|
|
End Else
|
|
Case WaitForSingleObject (Handles[0], Wait) of
|
|
WAIT_OBJECT_0 : InType := 1;
|
|
Else
|
|
Exit;
|
|
End;
|
|
|
|
Case InType of
|
|
1 : Begin // LOCAL input event
|
|
If Not Input.ProcessQueue Then Exit;
|
|
|
|
Result := Input.ReadKey;
|
|
LocalInput := True;
|
|
IsArrow := False;
|
|
|
|
If Result = #0 Then Begin
|
|
Result := Input.ReadKey;
|
|
|
|
If (AllowArrow) and (Result in [#71..#73, #75, #77, #79..#83]) and (Screen.Active) Then Begin
|
|
IsArrow := True;
|
|
Exit;
|
|
End;
|
|
|
|
ProcessSysopCommand(Result);
|
|
|
|
Result := #255;
|
|
End;
|
|
|
|
If Not Screen.Active Then Result := #255;
|
|
End;
|
|
2 : Begin // SOCKET read event
|
|
If TBBSCore(Core).Client.ReadBuf(Result, 1) < 0 Then Begin
|
|
TBBSCore(Core).SystemLog ('User dropped carrier');
|
|
Halt(0);
|
|
End;
|
|
|
|
LocalInput := False;
|
|
|
|
If AllowArrow Then Begin
|
|
IsArrow := True;
|
|
|
|
Case Result of
|
|
#03 : Result := #81; { pgdn }
|
|
#04 : Result := #77; { right }
|
|
#05 : Result := #72; { up }
|
|
#18 : Result := #73; { pgup }
|
|
#19 : Result := #75; { left }
|
|
#24 : Result := #80; { down }
|
|
#27 : Begin
|
|
If Not TBBSCore(Core).Client.DataWaiting Then WaitMS(25);
|
|
If Not TBBSCore(Core).Client.DataWaiting Then WaitMS(25);
|
|
If TBBSCore(Core).Client.DataWaiting Then Begin
|
|
If TBBSCore(Core).Client.ReadChar = '[' Then
|
|
Case TBBSCore(Core).Client.ReadChar of
|
|
'A' : Result := #72; { ansi up }
|
|
'B' : Result := #80; { ansi down }
|
|
'C' : Result := #77; { ansi right }
|
|
'D' : Result := #75; { ansi left }
|
|
'H' : Result := #71; { ansi home }
|
|
'K' : Result := #79; { ansi end }
|
|
'V' : Result := #73; { ansi pageup }
|
|
'U' : Result := #81; { ansi pgdown }
|
|
End;
|
|
End Else
|
|
IsArrow := False;
|
|
End;
|
|
#127: Result := #83; { delete }
|
|
Else
|
|
IsArrow := False;
|
|
End;
|
|
End;
|
|
End;
|
|
End;
|
|
End;
|
|
{$ENDIF}
|
|
|
|
Function TBBSIO.DoInputEvents (Var Ch: Char) : Boolean;
|
|
Var
|
|
TimeCount : LongInt;
|
|
Begin
|
|
Result := False;
|
|
|
|
If InMacro Then
|
|
If InMacroPos <= Length(InMacroStr) Then Begin
|
|
Ch := InMacroStr[InMacroPos];
|
|
Result := True;
|
|
|
|
Inc (InMacroPos);
|
|
Exit;
|
|
End Else
|
|
InMacro := False;
|
|
|
|
If TBBSCore(Core).CheckTimeOut Then
|
|
If TimerSeconds - TBBSCore(Core).TimeOut >= Config.Inactivity Then Begin
|
|
TBBSCore(Core).SystemLog('Inactivity timeout');
|
|
OutFullLn (TBBSCore(Core).GetPrompt(136));
|
|
Halt(0);
|
|
End;
|
|
|
|
If Session.AllowMessages And Not Session.InMessage Then Begin
|
|
Dec (Session.MessageCheck);
|
|
|
|
If Session.MessageCheck = 0 Then Begin
|
|
CheckNodeMessages;
|
|
|
|
Session.MessageCheck := mysMessageThreshold;
|
|
End;
|
|
End;
|
|
|
|
TimeCount := TBBSCore(Core).TimeLeft;
|
|
|
|
If TimeCount <> Session.LastTimeLeft Then Begin
|
|
Session.LastTimeLeft := TimeCount;
|
|
|
|
{$IFNDEF UNIX}
|
|
UpdateStatusLine(StatusPtr, '');
|
|
{$ENDIF}
|
|
|
|
If TBBSCore(Core).TimerOn Then Begin
|
|
If TimeCount = 5 Then Begin
|
|
If Not TBBSCore(Core).TimeChecked Then Begin
|
|
TBBSCore(Core).TimeChecked := True;
|
|
OutFullLn (TBBSCore(Core).GetPrompt(134));
|
|
End;
|
|
End Else
|
|
If TimeCount < 1 Then Begin
|
|
If Not TBBSCore(Core).TimeChecked Then Begin
|
|
TBBSCore(Core).TimeChecked := True;
|
|
OutFullLn (TBBSCore(Core).GetPrompt(135));
|
|
TBBSCore(Core).SystemLog ('User ran out of time');
|
|
Halt(0);
|
|
End;
|
|
End Else
|
|
TBBSCore(Core).TimeChecked := False;
|
|
End;
|
|
|
|
If TBBSCore(Core).NextEvent.Active Then
|
|
If (TBBSCore(Core).MinutesUntilEvent(TBBSCore(Core).NextEvent.ExecTime) = TBBSCore(Core).NextEvent.Warning) And
|
|
(Not TBBSCore(Core).EventWarn) And (TBBSCore(Core).NextEvent.Forced) Then Begin
|
|
TBBSCore(Core).EventWarn := True;
|
|
OutFullLn (TBBSCore(Core).GetPrompt(133));
|
|
End;
|
|
End;
|
|
End;
|
|
|
|
Function TBBSIO.GetKey : Char;
|
|
Begin
|
|
Result := #255;
|
|
|
|
TBBSCore(Core).TimeOut := TimerSeconds;
|
|
|
|
BufFlush;
|
|
|
|
Repeat
|
|
If LastSecond <> TimerSeconds Then Begin
|
|
LastSecond := TimerSeconds;
|
|
|
|
If Assigned(GetKeyCallBack) Then
|
|
If GetKeyCallBack(False) Then Begin
|
|
Result := #02;
|
|
Exit;
|
|
End;
|
|
|
|
If DoInputEvents(Result) Then Exit;
|
|
End;
|
|
|
|
Result := InKey(1000);
|
|
Until Result <> #255;
|
|
End;
|
|
|
|
Function TBBSIO.GetYNL (Str: String; Yes: Boolean) : Boolean;
|
|
Var
|
|
Ch : Char;
|
|
X : Byte;
|
|
Temp : Boolean;
|
|
Begin
|
|
PurgeInputBuffer;
|
|
|
|
OutFull (Str);
|
|
|
|
Temp := AllowArrow;
|
|
AllowArrow := True;
|
|
X := Screen.CursorX;
|
|
|
|
Repeat
|
|
AnsiMoveX (X);
|
|
|
|
If Yes Then
|
|
OutFull (TBBSCore(Core).GetPrompt(316))
|
|
Else
|
|
OutFull (TBBSCore(Core).GetPrompt(317));
|
|
|
|
Ch := UpCase(GetKey);
|
|
|
|
If IsArrow Then Begin
|
|
If Ch = #77 Then Yes := False;
|
|
If Ch = #75 Then Yes := True;
|
|
End Else
|
|
If Ch = #13 Then Break Else
|
|
If Ch = #32 Then Yes := Not Yes Else
|
|
If Ch = 'Y' Then Begin
|
|
Yes := True;
|
|
|
|
AnsiMoveX (X);
|
|
OutFull (TBBSCore(Core).GetPrompt(316));
|
|
|
|
Break;
|
|
End Else
|
|
If Ch = 'N' Then Begin
|
|
Yes := False;
|
|
|
|
AnsiMoveX (X);
|
|
OutFull (TBBSCore(Core).GetPrompt(317));
|
|
|
|
Break;
|
|
End;
|
|
Until False;
|
|
|
|
OutRawLn('');
|
|
|
|
AllowArrow := Temp;
|
|
Result := Yes;
|
|
End;
|
|
|
|
Function TBBSIO.GetYN (Str: String; Yes: Boolean) : Boolean;
|
|
Begin
|
|
If (TBBSCore(Core).Theme.Flags AND ThmLightbarYN <> 0) and (Graphics = 1) Then Begin
|
|
GetYN := GetYNL(Str, Yes);
|
|
Exit;
|
|
End;
|
|
|
|
OutFull (Str);
|
|
|
|
Case OneKey(#13'YN', False) of
|
|
'Y' : Yes := True;
|
|
'N' : Yes := False;
|
|
End;
|
|
|
|
OutFullLn (OutYN(Yes));
|
|
|
|
Result := Yes;
|
|
End;
|
|
|
|
Function TBBSIO.GetPW (Str: String; BadStr: String; PW: String) : Boolean;
|
|
Var
|
|
Loop : Byte;
|
|
Temp : String[15];
|
|
Begin
|
|
Result := True;
|
|
|
|
If PW = '' Then Exit;
|
|
|
|
Loop := 0;
|
|
|
|
Repeat
|
|
OutFull (Str);
|
|
|
|
Temp := GetInput(15, 15, 16, '');
|
|
|
|
If Temp = PW Then
|
|
Exit
|
|
Else Begin
|
|
OutFullLn(BadStr);
|
|
Inc (Loop);
|
|
|
|
If (TBBSCore(Core).User.ThisUser.Handle <> '') and (Loop = 1) Then
|
|
TBBSCore(Core).SystemLog ('User: ' + TBBSCore(Core).User.ThisUser.Handle);
|
|
|
|
TBBSCore(Core).SystemLog ('Bad PW: ' + Temp);
|
|
End;
|
|
Until Loop = Config.PWAttempts;
|
|
|
|
Result := False;
|
|
End;
|
|
|
|
Function TBBSIO.OneKey (Str: String; Echo: Boolean): Char;
|
|
Var
|
|
Ch : Char;
|
|
Begin
|
|
PurgeInputBuffer;
|
|
|
|
Repeat
|
|
Ch := UpCase(GetKey);
|
|
Until Pos (Ch, Str) > 0;
|
|
|
|
If Echo Then OutRawLn (Ch);
|
|
|
|
Result := Ch;
|
|
End;
|
|
|
|
Function TBBSIO.GetInput (Field, Max, Mode: Byte; Default: String) : String;
|
|
(*
|
|
{ input modes: }
|
|
{ 1 = standard input
|
|
{ 2 = upper case }
|
|
{ 3 = proper }
|
|
{ 4 = usa phone number }
|
|
{ 5 = date }
|
|
{ 6 = password }
|
|
{ 7 = lower cased }
|
|
{ 8 = user defined input }
|
|
{ 9 = standard input with no CRLF }
|
|
*)
|
|
Var
|
|
FieldCh : Char;
|
|
Ch : Char;
|
|
Str : String;
|
|
StrPos : Integer;
|
|
xPos : Byte;
|
|
Junk : Integer;
|
|
CurPos : Integer;
|
|
ArrowSave : Boolean;
|
|
BackPos : Byte;
|
|
BackSaved : String;
|
|
|
|
Procedure pWrite (Str : String);
|
|
Begin
|
|
If (Mode = 6) and (Str <> '') Then
|
|
BufAddStr (strRep(TBBSCore(Core).Theme.EchoChar, Length(Str)))
|
|
Else
|
|
BufAddStr (Str);
|
|
End;
|
|
|
|
Procedure ReDraw;
|
|
Begin
|
|
AnsiMoveX (xPos);
|
|
|
|
pWrite (Copy(Str, Junk, Field));
|
|
If UseInField Then AnsiColor(TBBSCore(Core).Theme.FieldColor2);
|
|
pWrite (strRep(FieldCh, Field - Length(Copy(Str, Junk, Field))));
|
|
If UseInField Then AnsiColor(TBBSCore(Core).Theme.FieldColor1);
|
|
|
|
AnsiMoveX (xPos + CurPos - 1);
|
|
End;
|
|
|
|
Procedure ReDrawPart;
|
|
Begin
|
|
pWrite (Copy(Str, StrPos, Field - CurPos + 1));
|
|
If UseInField Then AnsiColor(TBBSCore(Core).Theme.FieldColor2);
|
|
pWrite (strRep(FieldCh, (Field - CurPos + 1) - Length(Copy(Str, StrPos, Field - CurPos + 1))));
|
|
If UseInField Then AnsiColor(TBBSCore(Core).Theme.FieldColor1);
|
|
|
|
AnsiMoveX (xPos + CurPos - 1);
|
|
End;
|
|
|
|
Procedure ScrollRight;
|
|
Begin
|
|
Inc (Junk, Field DIV 2); {scroll size}
|
|
If Junk > Length(Str) Then Junk := Length(Str);
|
|
If Junk > Max Then Junk := Max;
|
|
CurPos := StrPos - Junk + 1;
|
|
ReDraw;
|
|
End;
|
|
|
|
Procedure ScrollLeft;
|
|
Begin
|
|
Dec (Junk, Field DIV 2); {scroll size}
|
|
If Junk < 1 Then Junk := 1;
|
|
CurPos := StrPos - Junk + 1;
|
|
ReDraw;
|
|
End;
|
|
|
|
Procedure AddChar (Ch : Char);
|
|
Begin
|
|
If CurPos > Field then ScrollRight;
|
|
|
|
Insert (Ch, Str, StrPos);
|
|
If StrPos < Length(Str) Then ReDrawPart;
|
|
|
|
Inc (StrPos);
|
|
Inc (CurPos);
|
|
|
|
pWrite (Ch);
|
|
End;
|
|
|
|
Begin
|
|
If UseInLimit Then Begin
|
|
Field := InLimit;
|
|
UseInLimit := False;
|
|
End;
|
|
|
|
If UseInSize Then Begin
|
|
UseInSize := False;
|
|
If InSize <= Max Then Max := InSize;
|
|
End;
|
|
|
|
xPos := Screen.CursorX;
|
|
FieldCh := ' ';
|
|
|
|
// this is poorly implemented but to expand on it will require MPL
|
|
// programs to change. :( we are stuck at the cap for input types
|
|
// because of this.
|
|
|
|
If Mode > 10 Then Begin
|
|
Dec (Mode, 10);
|
|
|
|
If UseInField and (Graphics = 1) Then Begin
|
|
FieldCh := TBBSCore(Core).Theme.FieldChar;
|
|
|
|
AnsiColor (TBBSCore(Core).Theme.FieldColor2);
|
|
BufAddStr (strRep(FieldCh, Field));
|
|
AnsiColor (TBBSCore(Core).Theme.FieldColor1);
|
|
AnsiMoveX (xPos);
|
|
End Else
|
|
UseInField := False;
|
|
End Else
|
|
UseInField := False;
|
|
|
|
If Mode = 8 Then
|
|
Case Config.UserNameFormat of
|
|
0 : Mode := 1;
|
|
1 : Mode := 2;
|
|
2 : Mode := 7;
|
|
3 : Mode := 3;
|
|
End;
|
|
|
|
ArrowSave := AllowArrow;
|
|
AllowArrow := (Mode in [1..3, 7..9]) and (Graphics > 0);
|
|
|
|
BackPos := 0;
|
|
Str := Default;
|
|
StrPos := Length(Str) + 1;
|
|
Junk := StrPos - Field;
|
|
|
|
If Junk < 1 Then Junk := 1;
|
|
|
|
CurPos := StrPos - Junk + 1;
|
|
|
|
PWrite (Copy(Str, Junk, Field));
|
|
|
|
PurgeInputBuffer;
|
|
|
|
Repeat
|
|
Ch := GetKey;
|
|
|
|
If IsArrow Then Begin
|
|
Case Ch of
|
|
#71 : If StrPos > 1 Then Begin
|
|
StrPos := 1;
|
|
Junk := 1;
|
|
CurPos := 1;
|
|
ReDraw;
|
|
End;
|
|
#72 : If (BackPos < mysMaxInputHistory) And (BackPos < InputPos) Then Begin
|
|
Inc (BackPos);
|
|
|
|
If BackPos = 1 Then BackSaved := Str;
|
|
|
|
Str := InputData[BackPos];
|
|
StrPos := Length(Str) + 1;
|
|
Junk := StrPos - Field;
|
|
If Junk < 1 Then Junk := 1;
|
|
CurPos := StrPos - Junk + 1;
|
|
ReDraw;
|
|
End;
|
|
#75 : If StrPos > 1 Then Begin
|
|
If CurPos = 1 Then ScrollLeft;
|
|
Dec (StrPos);
|
|
Dec (CurPos);
|
|
If CurPos < 1 then CurPos := 1;
|
|
AnsiMoveX (Screen.CursorX - 1);
|
|
End;
|
|
#77 : If StrPos < Length(Str) + 1 Then Begin
|
|
If (CurPos = Field) and (StrPos < Length(Str)) Then ScrollRight;
|
|
Inc (CurPos);
|
|
Inc (StrPos);
|
|
AnsiMoveX (Screen.CursorX + 1);
|
|
End;
|
|
#79 : Begin
|
|
StrPos := Length(Str) + 1;
|
|
Junk := StrPos - Field;
|
|
If Junk < 1 Then Junk := 1;
|
|
CurPos := StrPos - Junk + 1;
|
|
ReDraw;
|
|
End;
|
|
#80 : If (BackPos > 0) Then Begin
|
|
Dec (BackPos);
|
|
|
|
If BackPos = 0 Then
|
|
Str := BackSaved
|
|
Else
|
|
Str := InputData[BackPos];
|
|
|
|
StrPos := Length(Str) + 1;
|
|
Junk := StrPos - Field;
|
|
If Junk < 1 Then Junk := 1;
|
|
CurPos := StrPos - Junk + 1;
|
|
ReDraw;
|
|
End;
|
|
#83 : If (StrPos <= Length(Str)) and (Length(Str) > 0) Then Begin
|
|
Delete(Str, StrPos, 1);
|
|
ReDrawPart;
|
|
End;
|
|
End;
|
|
End Else
|
|
Case Ch of
|
|
#02 : ReDraw;
|
|
#08 : If StrPos > 1 Then Begin
|
|
Dec (StrPos);
|
|
Delete (Str, StrPos, 1);
|
|
|
|
If CurPos = 1 Then
|
|
ScrollLeft
|
|
Else
|
|
If StrPos = Length(Str) + 1 Then Begin
|
|
If UseInField Then AnsiColor(TBBSCore(Core).Theme.FieldColor2);
|
|
BufAddStr (#8 + FieldCh + #8);
|
|
If UseInField Then AnsiColor(TBBSCore(Core).Theme.FieldColor1);
|
|
Dec (CurPos);
|
|
End Else Begin
|
|
BufAddChar (#8);
|
|
Dec (CurPos);
|
|
ReDrawPart;
|
|
End;
|
|
End;
|
|
#13 : Break;
|
|
^Y : Begin
|
|
Str := '';
|
|
StrPos := 1;
|
|
Junk := 1;
|
|
CurPos := 1;
|
|
ReDraw;
|
|
End;
|
|
#32..
|
|
#254: If Length(Str) < Max Then
|
|
Case Mode of
|
|
1 : AddChar (Ch);
|
|
2 : AddChar (UpCase(Ch));
|
|
3 : Begin
|
|
If (CurPos = 1) or (Str[StrPos-1] in [' ', '.']) Then
|
|
Ch := UpCase(Ch)
|
|
Else
|
|
Ch := LoCase(Ch);
|
|
|
|
AddChar(Ch);
|
|
End;
|
|
4 : If (Ord(Ch) > 47) and (Ord(Ch) < 58) Then
|
|
Case StrPos of
|
|
4,8 : Begin
|
|
AddChar ('-');
|
|
AddChar (Ch);
|
|
End;
|
|
3,7 : Begin
|
|
AddChar (Ch);
|
|
AddChar ('-');
|
|
End;
|
|
Else
|
|
AddChar(Ch);
|
|
End;
|
|
5 : If (Ord(Ch) > 47) and (Ord(Ch) < 58) Then
|
|
Case StrPos of
|
|
2,5 : Begin
|
|
AddChar (Ch);
|
|
AddChar ('/');
|
|
End;
|
|
3,6 : Begin
|
|
AddChar ('/');
|
|
AddChar (Ch);
|
|
End;
|
|
Else
|
|
AddChar (Ch);
|
|
End;
|
|
6 : AddChar(UpCase(Ch));
|
|
7 : AddChar(LoCase(Ch));
|
|
9 : AddChar(Ch);
|
|
End;
|
|
End;
|
|
Until False;
|
|
|
|
If Mode <> 6 Then Begin
|
|
For Junk := 4 DownTo 2 Do
|
|
InputData[Junk] := InputData[Junk - 1];
|
|
|
|
InputData[1] := Str;
|
|
|
|
If InputPos < mysMaxInputHistory Then Inc(InputPos);
|
|
End;
|
|
|
|
If Mode = 9 Then
|
|
OutFull ('|16')
|
|
Else
|
|
OutFullLn ('|16');
|
|
|
|
Case Mode of
|
|
5 : Case TBBSCore(Core).User.ThisUser.DateType of { Convert to MM/DD/YY }
|
|
{DD/MM/YY}
|
|
2 : Str := Copy(Str, 4, 2) + '/' + Copy(Str, 1, 2) + '/' + Copy(Str, 7, 2);
|
|
{YY/DD/MM}
|
|
3 : Str := Copy(Str, 7, 2) + '/' + Copy(Str, 4, 2) + '/' + Copy(Str, 1, 2);
|
|
End;
|
|
End;
|
|
|
|
UseInField := True;
|
|
AllowArrow := ArrowSave;
|
|
Result := Str;
|
|
End;
|
|
|
|
Function TBBSIO.InXY (X, Y, Field, Max, Mode: Byte; Default: String) : String;
|
|
Begin
|
|
If Graphics = 0 Then
|
|
OutFull ('|CR: ')
|
|
Else
|
|
AnsiGotoXY (X, Y);
|
|
|
|
InXY := GetInput (Field, Max, Mode, Default);
|
|
End;
|
|
|
|
Function TBBSIO.DrawPercent (Bar: RecPercent; Part, Whole: SmallInt; Var Percent : SmallInt) : String;
|
|
Var
|
|
FillSize : Byte;
|
|
Attr : Byte;
|
|
Begin
|
|
Attr := Screen.TextAttr;
|
|
|
|
Screen.TextAttr := 0; // kludge to force it to return full ansi codes
|
|
|
|
If (Part = 0) or (Whole = 0) or (Part > Whole) Then Begin
|
|
FillSize := 0;
|
|
Percent := 0;
|
|
// FillSize := Bar.BarLen;
|
|
// Percent := 100;
|
|
// this needs work...
|
|
End Else Begin
|
|
FillSize := Round(Part / Whole * Bar.BarLength);
|
|
Percent := Round(Part / Whole * 100);
|
|
End;
|
|
|
|
Result := Attr2Ansi(Bar.HiAttr) + strRep(Bar.HiChar, FillSize) +
|
|
Attr2Ansi(Bar.LoAttr) + strRep(Bar.LoChar, Bar.BarLength - FillSize) +
|
|
Attr2Ansi(Attr);
|
|
End;
|
|
|
|
{$IFDEF UNIX}
|
|
Procedure TBBSIO.RemoteRestore (Var Image: TConsoleImageRec);
|
|
Var
|
|
CountX : Byte;
|
|
CountY : Byte;
|
|
Begin
|
|
For CountY := Image.Y1 to Image.Y2 Do Begin
|
|
Session.io.AnsiGotoXY (Image.X1, CountY);
|
|
|
|
For CountX := Image.X1 to Image.X2 Do Begin
|
|
Session.io.AnsiColor(Image.Data[CountY][CountX].Attributes);
|
|
Session.io.BufAddChar(Image.Data[CountY][CountX].UnicodeChar);
|
|
End;
|
|
End;
|
|
|
|
Session.io.AnsiColor (Image.CursorA);
|
|
Session.io.AnsiGotoXY (Image.CursorX, Image.CursorY);
|
|
|
|
Session.io.BufFlush;
|
|
End;
|
|
{$ELSE}
|
|
Procedure TBBSIO.RemoteRestore (Var Image: TConsoleImageRec);
|
|
Var
|
|
CountX : Byte;
|
|
CountY : Byte;
|
|
BufPos : Integer;
|
|
Buffer : Array[1..SizeOf(TConsoleScreenRec) DIV 2] of Word Absolute Image.Data;
|
|
TempChar : Char;
|
|
Begin
|
|
BufPos := 1;
|
|
|
|
For CountY := Image.Y1 to Image.Y2 Do Begin
|
|
Session.io.AnsiGotoXY (Image.X1, CountY);
|
|
|
|
For CountX := Image.X1 to Image.X2 Do Begin
|
|
|
|
Session.io.AnsiColor(Buffer[BufPos+1]);
|
|
|
|
TempChar := Char(Buffer[BufPos]);
|
|
|
|
If TempChar = #0 Then TempChar := ' ';
|
|
|
|
Session.io.BufAddChar(TempChar);
|
|
Inc (BufPos, 2);
|
|
End;
|
|
End;
|
|
|
|
Session.io.AnsiColor (Image.CursorA);
|
|
Session.io.AnsiGotoXY (Image.CursorX, Image.CursorY);
|
|
|
|
Session.io.BufFlush;
|
|
End;
|
|
{$ENDIF}
|
|
|
|
Function TBBSIO.StrMci (Str: String) : String;
|
|
Var
|
|
Count : Byte;
|
|
Code : String[2];
|
|
Begin
|
|
Result := '';
|
|
Count := 1;
|
|
|
|
While Count <= Length(Str) Do Begin
|
|
If (Str[Count] = '|') and (Count < Length(Str) - 1) Then Begin
|
|
Code := Copy(Str, Count + 1, 2);
|
|
Inc (Count, 2);
|
|
Case Code[1] of
|
|
'0' : Result := Result + '|' + Code;
|
|
'1' : Result := Result + '|' + Code;
|
|
'2' : Result := Result + '|' + Code;
|
|
Else
|
|
If ParseMCI(False, Code) Then
|
|
Result := Result + LastMCIValue
|
|
Else
|
|
Result := Result + '|' + Code;
|
|
End;
|
|
End Else
|
|
Result := Result + Str[Count];
|
|
|
|
Inc(Count);
|
|
End;
|
|
End;
|
|
|
|
Procedure TBBSIO.PurgeInputBuffer;
|
|
Begin
|
|
While Input.KeyPressed Do Input.ReadKey;
|
|
{$IFDEF WINDOWS}
|
|
If Not TBBSCore(Core).LocalMode Then TBBSCore(Core).Client.PurgeInputData;
|
|
{$ENDIF}
|
|
End;
|
|
|
|
{$IFDEF WINDOWS}
|
|
Procedure TBBSIO.LocalScreenDisable;
|
|
Begin
|
|
Screen.ClearScreenNoUpdate;
|
|
Screen.WriteXYNoUpdate(1, 1, 7, 'Screen disabled. Press ALT-V to view user');
|
|
Screen.Active := False;
|
|
End;
|
|
|
|
Procedure TBBSIO.LocalScreenEnable;
|
|
Begin
|
|
Screen.Active := True;
|
|
Screen.ShowBuffer;
|
|
UpdateStatusLine(StatusPtr, '');
|
|
End;
|
|
{$ENDIF}
|
|
|
|
End.
|