Updated PseuWoWConsole
------------- Version 2.0.0 ------------- Added Nifty Icon Feature - Basically If you run more than one session you now tell which one is which! Display of Char Name Started Work on reading the colours from input
This commit is contained in:
thetourist
parent
7336fbe70f
commit
5fbc5254c6
@ -1,7 +1,7 @@
|
||||
=======================================================
|
||||
PseuWoWConsole - Version 1.1.0
|
||||
PseuWoWConsole - Version 2.0.0
|
||||
=======================================================
|
||||
"What ain't no country I ever heard of! They speak English in What? "
|
||||
"At First you listen to users, then you stop listening"
|
||||
|
||||
=======================================================
|
||||
Greetings from TheTourist
|
||||
@ -25,3 +25,11 @@ I can't profess to be a trained developer, I am entirely self taught. So any adv
|
||||
|
||||
This is all released under the GNU General Public License, which you review at: http://www.gnu.org/copyleft/gpl.html
|
||||
As I feel it's better to share, we all get along better that way.
|
||||
|
||||
=======================================================
|
||||
Changes
|
||||
=======================================================
|
||||
Version 2.0.0
|
||||
* Added Nifty Icon Feature - Basically If you run more than one session you now tell which one is which!
|
||||
* Display of Char Name
|
||||
* Started Work on reading the colors from input
|
||||
BIN
src/tools/PseuWoWConsole/bin/PseuWoWConsole.exe
Normal file
BIN
src/tools/PseuWoWConsole/bin/PseuWoWConsole.exe
Normal file
Binary file not shown.
@ -63,8 +63,8 @@ RootDir=
|
||||
[Version Info]
|
||||
IncludeVerInfo=1
|
||||
AutoIncBuild=0
|
||||
MajorVer=1
|
||||
MinorVer=1
|
||||
MajorVer=2
|
||||
MinorVer=0
|
||||
Release=0
|
||||
Build=0
|
||||
Debug=0
|
||||
@ -77,7 +77,7 @@ CodePage=1252
|
||||
[Version Info Keys]
|
||||
CompanyName=
|
||||
FileDescription=
|
||||
FileVersion=1.1.0.0
|
||||
FileVersion=2.0.0.0
|
||||
InternalName=
|
||||
LegalCopyright=
|
||||
LegalTrademarks=
|
||||
@ -86,7 +86,6 @@ ProductName=
|
||||
ProductVersion=1.0.0.0
|
||||
Comments=
|
||||
[Excluded Packages]
|
||||
c:\program files\borland\delphi6\Projects\Bpl\SweetControls6.bpl=CA SweetControls
|
||||
c:\program files\borland\delphi6\Projects\Bpl\SynUni_D5.bpl=(untitled)
|
||||
c:\program files\borland\delphi6\Projects\Bpl\images.bpl=Images
|
||||
c:\program files\borland\delphi6\Projects\Bpl\ryansvcl.bpl=Ryans VCL
|
||||
|
||||
@ -4,7 +4,8 @@ uses
|
||||
Forms,
|
||||
fMain in 'fMain.pas' {frmMain},
|
||||
RedirectConsole in 'RedirectConsole.pas',
|
||||
modRichEdit in 'modRichEdit.pas';
|
||||
modRichEdit in 'modRichEdit.pas',
|
||||
modSCPUtils in 'modSCPUtils.pas';
|
||||
|
||||
{$R *.RES}
|
||||
|
||||
|
||||
10757
src/tools/PseuWoWConsole/src/PseuWoWConsole.map
Normal file
10757
src/tools/PseuWoWConsole/src/PseuWoWConsole.map
Normal file
File diff suppressed because it is too large
Load Diff
Binary file not shown.
Binary file not shown.
File diff suppressed because it is too large
Load Diff
@ -5,11 +5,11 @@ interface
|
||||
uses
|
||||
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
|
||||
StdCtrls, RedirectConsole, ExtCtrls, IniFiles, ScktComp, JvComponentBase,
|
||||
JvTrayIcon, ComCtrls, modRichEdit, StrUtils;
|
||||
JvTrayIcon, ComCtrls, modRichEdit, StrUtils, ImgList, modSCPUtils;
|
||||
|
||||
type
|
||||
TfrmMain = class(TForm)
|
||||
Panel1: TPanel;
|
||||
pnlTop: TPanel;
|
||||
txtExe: TEdit;
|
||||
btnRun: TButton;
|
||||
btnExit: TButton;
|
||||
@ -18,8 +18,13 @@ type
|
||||
clientSock: TClientSocket;
|
||||
TrayIcon: TJvTrayIcon;
|
||||
Console: TRichEdit;
|
||||
imgList: TImageList;
|
||||
pnlBottom: TPanel;
|
||||
grpCmd: TGroupBox;
|
||||
comCommand: TComboBox;
|
||||
pnlSessionTop: TPanel;
|
||||
cbexIcon: TComboBoxEx;
|
||||
txtChar: TStaticText;
|
||||
procedure btnRunClick(Sender: TObject);
|
||||
procedure btnExitClick(Sender: TObject);
|
||||
procedure FormCreate(Sender: TObject);
|
||||
@ -36,6 +41,7 @@ type
|
||||
Shift: TShiftState);
|
||||
procedure clientSockConnecting(Sender: TObject;
|
||||
Socket: TCustomWinSocket);
|
||||
procedure cbexIconChange(Sender: TObject);
|
||||
private
|
||||
{ Private declarations }
|
||||
App : String;
|
||||
@ -44,6 +50,11 @@ type
|
||||
|
||||
function ConsoleCommand(AString : String):Boolean;
|
||||
|
||||
procedure LoadSettings;
|
||||
procedure SetupIcons;
|
||||
procedure SetIcon(AIndex : Integer; AUpdateINI : Boolean = True);
|
||||
procedure LoadPseuSettings(AConFile : string);
|
||||
|
||||
procedure ShutDown;
|
||||
procedure Execute(AFile: String);
|
||||
procedure Launch;
|
||||
@ -71,6 +82,8 @@ end;
|
||||
procedure TfrmMain.FormCreate(Sender: TObject);
|
||||
begin
|
||||
RC_LineOut:=MyLineOut; // set Output
|
||||
SetupIcons;
|
||||
LoadSettings;
|
||||
Ready := False;
|
||||
end;
|
||||
|
||||
@ -100,11 +113,30 @@ end;
|
||||
|
||||
procedure TfrmMain.Execute(AFile : String);
|
||||
begin
|
||||
//TT: Get Info from PseuWow.conf
|
||||
LoadPseuSettings(ExtractFilePath(AFile)+'\conf\PseuWoW.conf');
|
||||
|
||||
//TT: See if we already have a server running
|
||||
with clientSock do
|
||||
begin
|
||||
Port := 8089;
|
||||
Open;
|
||||
|
||||
if (Active) then
|
||||
begin
|
||||
Close;
|
||||
servRemote.Active := False;
|
||||
end
|
||||
else
|
||||
servRemote.Active := True;
|
||||
end;
|
||||
|
||||
|
||||
Running := True;
|
||||
Panel1.Hide;
|
||||
RC_Run(AFile);
|
||||
pnlTop.Hide;
|
||||
comCommand.SetFocus;
|
||||
RC_Run(AFile);
|
||||
|
||||
end;
|
||||
|
||||
procedure TfrmMain.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
|
||||
@ -121,7 +153,7 @@ begin
|
||||
timerStart.Enabled := False;
|
||||
if Ready then
|
||||
begin
|
||||
TrayIcon.HideApplication;
|
||||
//TrayIcon.HideApplication;
|
||||
Launch;
|
||||
Exit;
|
||||
end
|
||||
@ -150,25 +182,47 @@ end;
|
||||
procedure TfrmMain.clientSockConnect(Sender: TObject;
|
||||
Socket: TCustomWinSocket);
|
||||
begin
|
||||
|
||||
//World Server Check
|
||||
if clientSock.Port = 8085 then
|
||||
begin
|
||||
Ready := True;
|
||||
clientSock.Active := False;
|
||||
Log('**** WS Is Ready For Connections ****');
|
||||
Launch;
|
||||
end;
|
||||
|
||||
//Checking If We Have A listening Console
|
||||
if clientSock.Port = 8089 then
|
||||
begin
|
||||
Log('**** Already Listening ****');
|
||||
end;
|
||||
|
||||
end;
|
||||
|
||||
procedure TfrmMain.clientSockError(Sender: TObject;
|
||||
Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
|
||||
var ErrorCode: Integer);
|
||||
begin
|
||||
//World Server Check
|
||||
if clientSock.Port = 8085 then
|
||||
begin
|
||||
Ready := False;
|
||||
clientSock.Active := False;
|
||||
Log('Still Waiting For Server',clMaroon);
|
||||
ErrorCode := 0;
|
||||
end
|
||||
else
|
||||
begin
|
||||
Log('Error in Checking For Listening', clMaroon);
|
||||
ErrorCode := 0;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TfrmMain.Launch;
|
||||
var
|
||||
IniFile : TInifile;
|
||||
iIcon : Integer;
|
||||
begin
|
||||
if Ready = False then
|
||||
Exit;
|
||||
@ -176,20 +230,12 @@ begin
|
||||
Running := False;
|
||||
timerStart.Enabled := False;
|
||||
|
||||
//TT: Read from Inifile for the path the file we want.
|
||||
IniFile := TIniFile.Create(ExtractFilePath(Application.ExeName)+'Settings.INI');
|
||||
App := IniFile.ReadString('Execute','Application','');
|
||||
if App = '' then
|
||||
begin
|
||||
if FileExists(ExtractFilePath(Application.ExeName)+'pseuwow.exe') then
|
||||
App := ExtractFilePath(Application.ExeName)+'pseuwow.exe';
|
||||
end;
|
||||
IniFile.WriteString('Execute','Application',App);
|
||||
IniFile.UpdateFile;
|
||||
IniFile.Free;
|
||||
|
||||
if App <> '' then
|
||||
Execute(App);
|
||||
Execute(App)
|
||||
else
|
||||
begin
|
||||
timerStart.Enabled := True;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
@ -235,7 +281,15 @@ end;
|
||||
procedure TfrmMain.clientSockConnecting(Sender: TObject;
|
||||
Socket: TCustomWinSocket);
|
||||
begin
|
||||
if clientSock.Port = 8085 then
|
||||
begin
|
||||
Log('Establishing Connection to WS',clGreen);
|
||||
end;
|
||||
|
||||
if clientSock.Port = 8089 then
|
||||
begin
|
||||
Log('Checking For Listening Console',clGreen);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TfrmMain.WriteFromPseWow(AString: String);
|
||||
@ -271,4 +325,113 @@ begin
|
||||
|
||||
end;
|
||||
|
||||
procedure TfrmMain.SetupIcons;
|
||||
var
|
||||
i : Integer;
|
||||
begin
|
||||
cbexIcon.Clear;
|
||||
|
||||
for i := 0 to imgList.Count - 1 do
|
||||
begin
|
||||
cbexIcon.ItemsEx.AddItem('',i,i,i,0,nil);
|
||||
end;
|
||||
|
||||
end;
|
||||
|
||||
procedure TfrmMain.SetIcon(AIndex : Integer; AUpdateINI : Boolean = True);
|
||||
var
|
||||
IniFile : TInifile;
|
||||
begin
|
||||
try
|
||||
IniFile := TIniFile.Create(ExtractFilePath(Application.ExeName)+'Settings.INI');
|
||||
if AUpdateINI then
|
||||
IniFile.WriteInteger('Look','Icon',AIndex);
|
||||
|
||||
with imgList do
|
||||
begin
|
||||
GetIcon(AIndex, Application.Icon);
|
||||
TrayIcon.IconIndex := AIndex;
|
||||
end;
|
||||
cbexIcon.ItemIndex := AIndex;
|
||||
finally
|
||||
if AUpdateINI then
|
||||
begin
|
||||
IniFile.UpdateFile;
|
||||
comCommand.SetFocus;
|
||||
end;
|
||||
IniFile.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TfrmMain.LoadSettings;
|
||||
var
|
||||
IniFile : TInifile;
|
||||
iIcon : Integer;
|
||||
begin
|
||||
try
|
||||
//TT: Read from Inifile for the path the file we want.
|
||||
IniFile := TIniFile.Create(ExtractFilePath(Application.ExeName)+'Settings.INI');
|
||||
App := IniFile.ReadString('Execute','Application','');
|
||||
if App = '' then
|
||||
begin
|
||||
if FileExists(ExtractFilePath(Application.ExeName)+'pseuwow.exe') then
|
||||
begin
|
||||
App := ExtractFilePath(Application.ExeName)+'pseuwow.exe';
|
||||
pnlTop.Hide;
|
||||
end
|
||||
else
|
||||
pnlTop.Show;
|
||||
end;
|
||||
IniFile.WriteString('Execute','Application',App);
|
||||
|
||||
//TT: Read Tray Icon, Nice for those of us who more than one session at a time!
|
||||
iIcon := IniFile.ReadInteger('Look','Icon',-1);
|
||||
|
||||
if (iIcon = -1) then
|
||||
IniFile.WriteInteger('Look','Icon',0);
|
||||
|
||||
SetIcon(iIcon, False);
|
||||
|
||||
finally
|
||||
IniFile.UpdateFile;
|
||||
IniFile.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TfrmMain.cbexIconChange(Sender: TObject);
|
||||
begin
|
||||
if Ready then
|
||||
SetIcon(cbexIcon.ItemIndex);
|
||||
end;
|
||||
|
||||
procedure TfrmMain.LoadPseuSettings(AConFile : string);
|
||||
var
|
||||
fFile : textfile;
|
||||
sBuffer : string;
|
||||
sRes : string;
|
||||
begin
|
||||
if FileExists(AConFile) then
|
||||
begin
|
||||
AssignFile(fFile, AConFile);
|
||||
Reset(fFile);
|
||||
|
||||
while not(Eof(fFile)) do
|
||||
begin
|
||||
sRes := '';
|
||||
|
||||
Readln(fFile, sBuffer);
|
||||
|
||||
if EvaluateProperty(sBuffer, 'charname=', sRes) then
|
||||
begin
|
||||
txtChar.Caption := sRes;
|
||||
Application.Title := sRes + ' - PseuWoW Console';
|
||||
TrayIcon.Hint := Application.Title;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
CloseFile(fFile);
|
||||
|
||||
comCommand.SetFocus;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
@ -1,48 +0,0 @@
|
||||
2007-06-06 11:25:28
|
||||
|
||||
2007-06-06 11:25:28 --- Initializing Instance ---
|
||||
2007-06-06 11:25:28 Loading DefScripts from folder './scripts/'
|
||||
2007-06-06 11:25:28 Error executing '_startup.def'
|
||||
2007-06-06 11:25:28 Errors while initializing!
|
||||
2007-06-06 11:26:03
|
||||
|
||||
2007-06-06 11:26:03 --- Initializing Instance ---
|
||||
2007-06-06 11:26:03 Loading DefScripts from folder './scripts/'
|
||||
2007-06-06 11:26:03 Error executing '_startup.def'
|
||||
2007-06-06 11:26:03 Errors while initializing!
|
||||
2007-06-06 11:26:31
|
||||
|
||||
2007-06-06 11:26:31 --- Initializing Instance ---
|
||||
2007-06-06 11:26:31 Loading DefScripts from folder './scripts/'
|
||||
2007-06-06 11:26:31 Error executing '_startup.def'
|
||||
2007-06-06 11:26:31 Errors while initializing!
|
||||
2007-06-06 11:27:01
|
||||
|
||||
2007-06-06 11:27:01 --- Initializing Instance ---
|
||||
2007-06-06 11:27:01 Loading DefScripts from folder './scripts/'
|
||||
2007-06-06 11:27:01 Error executing '_startup.def'
|
||||
2007-06-06 11:27:01 Errors while initializing!
|
||||
2007-06-06 11:28:07
|
||||
|
||||
2007-06-06 11:28:07 --- Initializing Instance ---
|
||||
2007-06-06 11:28:07 Loading DefScripts from folder './scripts/'
|
||||
2007-06-06 11:28:07 Error executing '_startup.def'
|
||||
2007-06-06 11:28:07 Errors while initializing!
|
||||
2007-06-06 11:28:39
|
||||
|
||||
2007-06-06 11:28:39 --- Initializing Instance ---
|
||||
2007-06-06 11:28:39 Loading DefScripts from folder './scripts/'
|
||||
2007-06-06 11:28:39 Error executing '_startup.def'
|
||||
2007-06-06 11:28:39 Errors while initializing!
|
||||
2007-06-06 11:30:01
|
||||
|
||||
2007-06-06 11:30:01 --- Initializing Instance ---
|
||||
2007-06-06 11:30:01 Loading DefScripts from folder './scripts/'
|
||||
2007-06-06 11:30:01 Error executing '_startup.def'
|
||||
2007-06-06 11:30:01 Errors while initializing!
|
||||
2007-06-06 11:30:34
|
||||
|
||||
2007-06-06 11:30:34 --- Initializing Instance ---
|
||||
2007-06-06 11:30:34 Loading DefScripts from folder './scripts/'
|
||||
2007-06-06 11:30:34 Error executing '_startup.def'
|
||||
2007-06-06 11:30:34 Errors while initializing!
|
||||
BIN
src/tools/PseuWoWConsole/src/modRichEdit.dcu
Normal file
BIN
src/tools/PseuWoWConsole/src/modRichEdit.dcu
Normal file
Binary file not shown.
71
src/tools/PseuWoWConsole/src/modRichEdit.pas
Normal file
71
src/tools/PseuWoWConsole/src/modRichEdit.pas
Normal file
@ -0,0 +1,71 @@
|
||||
unit modRichEdit;
|
||||
|
||||
interface
|
||||
uses SysUtils, Classes, StdCtrls, ComCtrls, Graphics, StrUtils, Windows;
|
||||
|
||||
procedure AddColouredLine(ARichEdit : TRichEdit; AText : String; AColor : TColor);
|
||||
procedure AddColourToLine(ARichEdit : TRichEdit; AText : String);
|
||||
|
||||
function HexToColor(sColor : String): TColor;
|
||||
|
||||
implementation
|
||||
|
||||
procedure AddColouredLine(ARichEdit : TRichEdit; AText : String; AColor : TColor);
|
||||
begin
|
||||
with ARichEdit do
|
||||
begin
|
||||
SelStart := Length(Text);
|
||||
SelAttributes.Color := AColor;
|
||||
SelAttributes.Size := 8;
|
||||
Lines.Add(AText);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure AddColourToLine(ARichEdit : TRichEdit; AText : String);
|
||||
var
|
||||
i : Integer;
|
||||
myColor : TColor;
|
||||
sTemp : String;
|
||||
begin
|
||||
i := AnsiPos('|c',LowerCase(AText));
|
||||
|
||||
while i <> 0 do
|
||||
begin
|
||||
if UpperCase(Copy(AText, i, 4)) = '|CFF' then
|
||||
begin
|
||||
with ARichEdit do
|
||||
begin
|
||||
//Get the color - |cffFF6600
|
||||
sTemp := Copy(AText,i, 10 );
|
||||
sTemp := AnsiReplaceText(sTemp,'|CFF','');
|
||||
|
||||
myColor := HexToColor(sTemp);
|
||||
AText := AnsiReplaceText(AText,'|CFF'+sTemp,'');
|
||||
AddColouredLine(ARichEdit, AText, myColor);
|
||||
{
|
||||
SelStart := Length(AText) - i;
|
||||
SelAttributes.Color := myColor;
|
||||
SelAttributes.Size := 8;
|
||||
}
|
||||
end;
|
||||
|
||||
i := AnsiPos('|c',LowerCase(AText));
|
||||
end
|
||||
else
|
||||
i := 0;
|
||||
end;
|
||||
|
||||
ARichEdit.Lines.Add(AText);
|
||||
end;
|
||||
|
||||
function HexToColor(sColor : String): TColor;
|
||||
begin
|
||||
sColor := UpperCase(sColor);
|
||||
Result := RGB(
|
||||
StrToInt('$'+Copy(sColor,1,2)),
|
||||
StrToInt('$'+Copy(sColor,3,2)),
|
||||
StrToInt('$'+Copy(sColor,4,2))
|
||||
);
|
||||
end;
|
||||
|
||||
end.
|
||||
BIN
src/tools/PseuWoWConsole/src/modSCPUtils.dcu
Normal file
BIN
src/tools/PseuWoWConsole/src/modSCPUtils.dcu
Normal file
Binary file not shown.
600
src/tools/PseuWoWConsole/src/modSCPUtils.pas
Normal file
600
src/tools/PseuWoWConsole/src/modSCPUtils.pas
Normal file
@ -0,0 +1,600 @@
|
||||
unit modSCPUtils;
|
||||
|
||||
interface
|
||||
uses Sysutils, Classes, StrUtils, Dialogs;
|
||||
|
||||
function GetHeader(AString: String): String;
|
||||
function EvaluateStringAsHeader(AString, AHeader : String): Boolean;
|
||||
function EvaluateProperty(ABuffer, AProp : String; var sValue : String): Boolean;
|
||||
function EvaluatePropertyAsInt(ABuffer, AProp : String; var iValue : Integer): Boolean;
|
||||
function UpdateProperty(AProperty, Value: String; AList : TStringList ; AddProperty : Boolean = true; AllowMultiples : Boolean = false; PropUpperCase : Boolean = True): Boolean;
|
||||
function DeleteProperty(AProperty: String; AList : TStringList; Multiples : Boolean = false): Boolean;
|
||||
function StripCommentsFromString(AString : String): String;
|
||||
function GetNumbersFromString(AString, ASeparator, AHeader :String; AElements : Integer; var ALeftOver : String; AllowBlank : Boolean = False; DoTrim : Boolean = True): TStringList;
|
||||
function GetCustomArray(AString : String; AStringListofArray: TStrings; AElementIndex, AElementCount : Integer): String;
|
||||
function GetRandom(AString: String; GetValuesInBetween : Boolean = True): String;
|
||||
function GetString(AMin, AMax: String; Seperator : String = ' '): String; overload;
|
||||
function GetString(AStringList : TStringList; Seperator: String = ' '): String; overload;
|
||||
function MakeList(AStringList : TStringList; AProp : String): TStringList;
|
||||
{
|
||||
Moved into TSCPItem
|
||||
function GetList(AStringList : TStringList; AProp : String): TStringList;
|
||||
}
|
||||
function AddProp(AProp, AValue : String; AList : TStringList): Boolean; overload;
|
||||
function AddProp(AStrings: TStringList; AList : TStringList): Boolean; overload;
|
||||
function AddToList(AList : TStringList; AValue : String): Boolean;
|
||||
function GetFloat(AString : String): Extended;
|
||||
function CountCharOccurences(const S: string; const ch: string): Integer;
|
||||
function CountSubStringOccurences(const subtext: string; Text: string): Integer;
|
||||
function CountPropOccurences(AProp : String; AList : TStringList): Integer;
|
||||
|
||||
implementation
|
||||
|
||||
function GetHeader(AString: String): String;
|
||||
var
|
||||
i : Integer;
|
||||
begin
|
||||
Result := '';
|
||||
|
||||
//[item or [creature etc.
|
||||
if AnsiPos('[', AString) <> 0 then
|
||||
begin
|
||||
i := AnsiPos(' ', AString);
|
||||
if i <> 0 then
|
||||
begin
|
||||
Result := Copy(AString,0,i-1);
|
||||
Exit;
|
||||
end;
|
||||
end;
|
||||
|
||||
i := AnsiPos('=', AString);
|
||||
if i <> 0 then
|
||||
begin
|
||||
Result := Copy(AString,0,i-1);
|
||||
Exit;
|
||||
end;
|
||||
|
||||
end;
|
||||
|
||||
function EvaluateStringAsHeader(AString, AHeader: String): Boolean;
|
||||
begin
|
||||
Result := False;
|
||||
|
||||
//Remove the = for simpler comparison
|
||||
if AnsiContainsText(AHeader,'=') then
|
||||
AHeader := AnsiReplaceStr(AHeader,'=','');
|
||||
|
||||
AHeader := Trim(AHeader);
|
||||
AString := Trim(AString);
|
||||
|
||||
AHeader := UpperCase(AHeader);
|
||||
AString := UpperCase(AString);
|
||||
|
||||
if LeftStr(AString,(Length(AHeader))) = AHeader then
|
||||
begin
|
||||
Result := True;
|
||||
end;
|
||||
|
||||
//For my Number Hack!
|
||||
if (LeftStr(AHeader,1) = '~') and (LeftStr(AString,1) = '~') then
|
||||
Result := True;
|
||||
|
||||
end;
|
||||
|
||||
function EvaluateProperty(ABuffer, AProp: String;
|
||||
var sValue: String): Boolean;
|
||||
var
|
||||
i : Integer;
|
||||
begin
|
||||
sValue := '';
|
||||
|
||||
i := Length(AProp);
|
||||
Result := False;
|
||||
|
||||
if (UpperCase(Copy(ABuffer, 0, i))) = (UpperCase(AProp)) then
|
||||
begin
|
||||
Result := True;
|
||||
sValue := Trim(RightStr(ABuffer, (Length(ABuffer) - i)));
|
||||
end;
|
||||
end;
|
||||
|
||||
function EvaluatePropertyAsInt(ABuffer, AProp : String; var iValue : Integer): Boolean;
|
||||
var
|
||||
sTemp : String;
|
||||
begin
|
||||
Result := False;
|
||||
|
||||
if (EvaluateProperty(ABuffer, AProp, sTemp)) and (TryStrToInt(sTemp, iValue)) then
|
||||
begin
|
||||
Result := True;
|
||||
end;
|
||||
end;
|
||||
|
||||
function UpdateProperty(AProperty, Value: String; AList : TStringList ; AddProperty : Boolean = true; AllowMultiples : Boolean = false; PropUpperCase : Boolean = True): Boolean;
|
||||
var
|
||||
i, j, L1, L2, iFound : integer;
|
||||
sTemp, sValue : String;
|
||||
bFound : Boolean;
|
||||
slFound : TStringList;
|
||||
begin
|
||||
try
|
||||
slFound := TStringList.Create;
|
||||
slFound.Clear;
|
||||
|
||||
//For Neatness
|
||||
if (PropUpperCase = True) then
|
||||
AProperty := Trim(UpperCase(AProperty))
|
||||
else
|
||||
AProperty := Trim(AProperty);
|
||||
|
||||
Value := Trim(Value);
|
||||
|
||||
if AProperty = '' then
|
||||
Exit;
|
||||
|
||||
for i := 0 to AList.Count - 1 do
|
||||
begin
|
||||
if EvaluateProperty(AList.Strings[i],AProperty,sTemp) then
|
||||
begin
|
||||
slFound.Add(IntToStr(i));
|
||||
j := i;
|
||||
bFound := True;
|
||||
if not(AllowMultiples) then
|
||||
Break;
|
||||
end;
|
||||
end;
|
||||
|
||||
//delte the property
|
||||
if Value = '' then
|
||||
begin
|
||||
AList.Delete(j);
|
||||
Exit;
|
||||
end;
|
||||
|
||||
if not(bFound) and not(AddProperty) then
|
||||
Exit;
|
||||
|
||||
sValue := AProperty+'='+Value;
|
||||
|
||||
if not(bFound) then //not found then add it
|
||||
begin
|
||||
AList.Add(sValue);
|
||||
end
|
||||
else
|
||||
begin //found then update it
|
||||
if not(AllowMultiples) then // Only want a single instance of this boy
|
||||
AList.Strings[j] := sValue
|
||||
else
|
||||
begin // as in EQUIP=0 or EQUIP=1 or Equip=2
|
||||
|
||||
for i := 0 to slFound.Count - 1 do
|
||||
begin
|
||||
iFound := StrToInt(slFound[i]);
|
||||
L1 := (AnsiPos(' ',AList[iFound])) - 1;
|
||||
L2 := (AnsiPos(' ',sValue)) - 1;
|
||||
|
||||
if L1 <= 0 then
|
||||
begin
|
||||
AList.Add(sValue);
|
||||
Exit;
|
||||
end;
|
||||
|
||||
if (UpperCase(Copy(AList[iFound],0, L1))) = (UpperCase(Copy(sValue,0, L2))) then
|
||||
begin
|
||||
AList[iFound] := sValue;
|
||||
Exit;
|
||||
end;
|
||||
|
||||
end;
|
||||
//ok we looked but it isn't there so add it
|
||||
AList.Add(sValue);
|
||||
end;
|
||||
end;
|
||||
finally
|
||||
slFound.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
function DeleteProperty(AProperty: String; AList : TStringList;
|
||||
Multiples: Boolean): Boolean;
|
||||
var
|
||||
i : integer;
|
||||
sTemp : string;
|
||||
begin
|
||||
for i := AList.Count - 1 downto 0 do
|
||||
begin
|
||||
if EvaluateProperty(AList[i],AProperty, sTemp) then
|
||||
begin
|
||||
AList.Delete(i);
|
||||
if not(Multiples) then
|
||||
Break;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
function GetNumbersFromString(AString, ASeparator, AHeader :String; AElements : Integer; var ALeftOver : String; AllowBlank : Boolean = False; DoTrim : Boolean = True): TStringList;
|
||||
var
|
||||
iLength, iSubLength, iPos, iIndex, iLastCheck : Integer;
|
||||
sTemp : String;
|
||||
rArray : Array of Real;
|
||||
oList : TStringList;
|
||||
begin
|
||||
if Result = nil then
|
||||
Result := TStringList.Create
|
||||
else
|
||||
Result.Clear;
|
||||
|
||||
//Hopefully this wont fux things up
|
||||
AString := UTF8Decode(AString);
|
||||
|
||||
|
||||
//A lazy way to tell it to look for everything
|
||||
if AElements = 0 then
|
||||
AElements := 100;
|
||||
|
||||
//Check for Delim
|
||||
if ASeparator = '[SPACE]' then
|
||||
ASeparator := ' ';
|
||||
|
||||
if ASeparator = '' then
|
||||
ASeparator := ' ';
|
||||
|
||||
if AllowBlank then
|
||||
AElements := CountCharOccurences(AString, ASeparator);
|
||||
|
||||
if AHeader <> '' then
|
||||
AString := AnsiReplaceText((AString), (AHeader), '');
|
||||
if AHeader <> '' then
|
||||
AString := AnsiReplaceText(AString, '=' ,'');
|
||||
if AHeader <> '' then
|
||||
AString := AnsiReplaceText(AString, '~','');
|
||||
if DoTrim then
|
||||
AString := Trim(AString);
|
||||
|
||||
SetLength(rArray, AElements);
|
||||
|
||||
for iIndex := 0 to AElements - 1 do
|
||||
begin
|
||||
iPos := AnsiPos(ASeparator, AString);
|
||||
|
||||
if AElements > 1 then //if we have mulitple elements
|
||||
begin
|
||||
if iIndex < (AElements - 1) then
|
||||
begin
|
||||
if iPos > 0 then
|
||||
sTemp := LeftStr(AString, iPos - 1)
|
||||
else
|
||||
sTemp := AString;
|
||||
end
|
||||
else
|
||||
sTemp := AString;
|
||||
end
|
||||
else
|
||||
begin //if we only have one element
|
||||
if iPos > 0 then
|
||||
sTemp := LeftStr(AString, iPos - 1)
|
||||
else
|
||||
sTemp := AString;
|
||||
end;
|
||||
|
||||
//If we have processed all our elements make sure there aren't additional ones
|
||||
if iIndex = (AElements - 1) then
|
||||
begin
|
||||
if ASeparator = '[SPACE]' then
|
||||
iLastCheck := AnsiPos(' ', sTemp)
|
||||
else
|
||||
iLastCheck := AnsiPos(ASeparator, sTemp);
|
||||
|
||||
if iLastCheck > 0 then
|
||||
begin
|
||||
//Removing Excess Elements from sTemp
|
||||
sTemp := LeftStr(AString, iLastCheck - 1)
|
||||
end;
|
||||
end;
|
||||
|
||||
if (sTemp = '') then
|
||||
begin
|
||||
if not(AllowBlank) then
|
||||
Continue
|
||||
else
|
||||
Result.Add(sTemp);
|
||||
end
|
||||
else
|
||||
Result.Add(sTemp);
|
||||
|
||||
iLength := Length(AString);
|
||||
iSubLength := Length(sTemp);
|
||||
|
||||
if ASeparator = '[SPACE]' then
|
||||
AString := RightStr(AString, (iLength - (iSubLength + 1 )))
|
||||
else
|
||||
AString := RightStr(AString, (iLength - (iSubLength+(Length(ASeparator)))));
|
||||
|
||||
if DoTrim then
|
||||
AString := Trim(AString);
|
||||
|
||||
end;
|
||||
|
||||
ALeftOver := AString;
|
||||
|
||||
end;
|
||||
|
||||
function GetCustomArray(AString : String; AStringListofArray: TStrings; AElementIndex, AElementCount : Integer): String;
|
||||
var
|
||||
iIndex, iPos : Integer;
|
||||
oStringList : TStringList;
|
||||
sFNM : string;
|
||||
begin
|
||||
oStringList := TStringList.Create;
|
||||
|
||||
for iIndex := 0 to (AStringListofArray.Count - 1) do
|
||||
begin
|
||||
if LeftStr(AStringListofArray.Strings[iIndex], (Length(AString)+1)) = AString + ' ' then
|
||||
begin
|
||||
AString := AnsiReplaceStr(AStringListofArray.Strings[iIndex][iIndex], AString + ' ', '');
|
||||
oStringList := GetNumbersFromString(AString, ' ', '', AElementCount, sFNM);
|
||||
Result := oStringList.Strings[AElementIndex - 1];
|
||||
Exit;
|
||||
end
|
||||
end;
|
||||
|
||||
|
||||
oStringList.Free;
|
||||
end;
|
||||
|
||||
|
||||
function GetRandom(AString: String; GetValuesInBetween : Boolean = True): String;
|
||||
var
|
||||
iPos, iTotal, iMin, iMax, iLast, iRange, iRand : Integer;
|
||||
sBuffer : String;
|
||||
sList : TStringList;
|
||||
begin
|
||||
try
|
||||
sList := TStringList.Create;
|
||||
|
||||
AString := AnsiReplaceText(AString,'..',' ');
|
||||
AString := AnsiReplaceStr(AString,',',' ');
|
||||
|
||||
AString := Trim(AString);
|
||||
|
||||
iPos := AnsiPos(' ',AString);
|
||||
|
||||
while iPos <> 0 do
|
||||
begin
|
||||
|
||||
sBuffer := (Copy(AString,0,(iPos-1)));
|
||||
|
||||
sList.Add(sBuffer);
|
||||
AString := (Copy(AString,iPos,(Length(AString))));
|
||||
AString := Trim(AString);
|
||||
iPos := AnsiPos(' ',AString);
|
||||
end;
|
||||
|
||||
//Get the Last One
|
||||
sList.Add(AString);
|
||||
|
||||
if sList.Count > 1 then
|
||||
begin
|
||||
if GetValuesInBetween then //calc values between first and last
|
||||
begin
|
||||
iMin := StrToInt(sList.Strings[0]);
|
||||
iLast := sList.Count - 1;
|
||||
iMax := StrToInt(sList.Strings[iLast]);
|
||||
iRange := iMax - iMin;
|
||||
|
||||
if iRange <= 0 then
|
||||
begin
|
||||
Result := IntToStr(iMin);
|
||||
Exit;
|
||||
end;
|
||||
|
||||
iRand := Round(Random(iRange));
|
||||
|
||||
Result := IntToStr(iMin + iRand);
|
||||
|
||||
end
|
||||
else
|
||||
begin // select a random value in the list
|
||||
iRand := Round(Random(sList.Count-1));
|
||||
sBuffer := sList.Strings[iRand];
|
||||
Result := sBuffer;
|
||||
end;
|
||||
end
|
||||
else
|
||||
begin
|
||||
sBuffer := sList.Strings[0];
|
||||
result := sBuffer;
|
||||
end;
|
||||
|
||||
finally
|
||||
sList.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
function StripCommentsFromString(AString : String): String;
|
||||
var
|
||||
iComment : Integer;
|
||||
begin
|
||||
|
||||
if AString <> '' then
|
||||
begin
|
||||
iComment := AnsiPos('/',AString);
|
||||
|
||||
//Remove comments
|
||||
if iComment > 0 then
|
||||
AString := Copy(AString,0,(iComment-1));
|
||||
|
||||
end;
|
||||
|
||||
Result := Trim(AString);
|
||||
|
||||
end;
|
||||
|
||||
function GetString(AStringList: TStringList;
|
||||
Seperator: String = ' '): String;
|
||||
var
|
||||
i : integer;
|
||||
begin
|
||||
Result := '';
|
||||
for i := 0 to AStringList.Count - 1 do
|
||||
begin
|
||||
Result := Result + AStringList[i];
|
||||
if i < (AStringList.Count - 1) then
|
||||
Result := Result + Seperator;
|
||||
end;
|
||||
end;
|
||||
|
||||
function GetString(AMin, AMax, Seperator: String): String;
|
||||
begin
|
||||
Result := '';
|
||||
|
||||
if (AMin <> '') and (AMin <> '0') and (AMax <> '') and (AMax <> '0') and (AMin <> AMax) then
|
||||
begin
|
||||
Result := AMin + Seperator + AMax;
|
||||
end
|
||||
else
|
||||
//Induvidual
|
||||
begin
|
||||
if (AMin <> '') and (AMin <> '0') then
|
||||
Result := AMin;
|
||||
if (AMax <> '') and (AMax <> '0') then
|
||||
Result := AMax;
|
||||
end;
|
||||
end;
|
||||
|
||||
function MakeList(AStringList: TStringList;
|
||||
AProp: String): TStringList;
|
||||
var
|
||||
i : Integer;
|
||||
begin
|
||||
Result := TStringList.Create;
|
||||
|
||||
for i := 0 to AStringList.Count - 1 do
|
||||
begin
|
||||
Result.Add(AProp+'='+AStringList[i]);
|
||||
end;
|
||||
end;
|
||||
|
||||
//Moved into TSCPItem
|
||||
{
|
||||
function GetList(AStringList : TStringList; AProp : String): TStringList;
|
||||
var
|
||||
i : Integer;
|
||||
sBuffer : String;
|
||||
begin
|
||||
Result := TStringList.Create;
|
||||
|
||||
for i := 0 to AStringList.Count - 1 do
|
||||
begin
|
||||
if EvaluateProperty(AStringList[i], AProp, sBuffer) then
|
||||
Result.Add(sBuffer)
|
||||
end;
|
||||
|
||||
if Result.Count = 0 then
|
||||
begin
|
||||
FreeAndNil(Result);
|
||||
end;
|
||||
|
||||
Result.Sort;
|
||||
end;
|
||||
}
|
||||
function AddProp(AProp, AValue: String; AList : TStringList): Boolean;
|
||||
var
|
||||
i : integer;
|
||||
begin
|
||||
Result := False;
|
||||
|
||||
if Trim(AValue) = '' then
|
||||
Exit;
|
||||
|
||||
if AnsiPos('=',AProp) = -1 then
|
||||
AProp := AProp +'=';
|
||||
|
||||
UpdateProperty(AProp,AValue,AList,true,false,false);
|
||||
|
||||
Result := True;
|
||||
end;
|
||||
|
||||
function AddProp(AStrings: TStringList; AList : TStringList): Boolean;
|
||||
begin
|
||||
if AStrings.GetText <> '' then
|
||||
AList.AddStrings(AStrings);
|
||||
end;
|
||||
|
||||
function AddToList(AList: TStringList;
|
||||
AValue: String): Boolean;
|
||||
begin
|
||||
Result := False;
|
||||
|
||||
if (AValue = '') or (AValue = '0') then
|
||||
Exit;
|
||||
|
||||
try
|
||||
if not(Assigned(AList)) then
|
||||
AList := TStringList.Create;
|
||||
if AList.IndexOf(AValue) = -1 then
|
||||
AList.Add(AValue);
|
||||
except
|
||||
Result := False;
|
||||
//Raise the error
|
||||
Exit;
|
||||
end;
|
||||
Result := True;
|
||||
end;
|
||||
|
||||
function GetFloat(AString : String): Extended;
|
||||
var
|
||||
Code: Integer;
|
||||
begin
|
||||
Val(AString, Result, Code);
|
||||
|
||||
if Code <> 0 then
|
||||
begin
|
||||
MessageDlg('Error converting Float in '+AString+' position: ' + IntToStr(Code), mtWarning, [mbOk], 0);
|
||||
Result := 0;
|
||||
end;
|
||||
end;
|
||||
|
||||
function CountCharOccurences(const S: string; const ch: string): Integer;
|
||||
var
|
||||
buf: string;
|
||||
begin
|
||||
buf := S;
|
||||
Result := 0;
|
||||
{while Pos finds a blank}
|
||||
while (Pos(ch, buf) > 0) do
|
||||
begin
|
||||
{copy the substrings before the blank in to Result}
|
||||
Result := Result + 1;
|
||||
buf := Copy(buf, Pos(ch, buf) + 1, Length(buf) - Pos(ch, buf));
|
||||
end;
|
||||
end;
|
||||
|
||||
//http://www.delphitricks.com/source-code/strings/count_the_number_of_occurrences_of_a_substring_within_a_string.html
|
||||
function CountSubStringOccurences(const subtext: string; Text: string): Integer;
|
||||
begin
|
||||
if (Length(subtext) = 0) or (Length(Text) = 0) or (Pos(subtext, Text) = 0) then
|
||||
Result := 0
|
||||
else
|
||||
Result := (Length(Text) - Length(StringReplace(Text, subtext, '', [rfReplaceAll]))) div
|
||||
Length(subtext);
|
||||
end;
|
||||
|
||||
function CountPropOccurences(AProp : String; AList : TStringList): Integer;
|
||||
var
|
||||
i : Integer;
|
||||
begin
|
||||
Result := 0;
|
||||
|
||||
AProp := AnsiReplaceText(AProp, '=', '');
|
||||
|
||||
AList.CaseSensitive := False;
|
||||
|
||||
for i := 0 to AList.Count - 1 do
|
||||
begin
|
||||
if AList.Names[i] = AProp then
|
||||
Result := Result + 1;
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
Loading…
x
Reference in New Issue
Block a user