mirror of
https://github.com/moparisthebest/Simba
synced 2025-01-30 23:00:18 -05:00
Added event-hooks for extensions! Extensions now have 5 events that they listen to, see virtualextension.pas for which. Fixed bug in codehints and a small one in padl/padr/padz.
This commit is contained in:
parent
f5f100e75e
commit
0d5f9b7b89
@ -4,7 +4,39 @@ procedure init;
|
|||||||
begin;
|
begin;
|
||||||
Writeln('init your extension here');
|
Writeln('init your extension here');
|
||||||
end;
|
end;
|
||||||
|
procedure onOpenConnection(var url : string; var Cont : boolean);
|
||||||
|
begin
|
||||||
|
Writeln('Opening url: ' + url);
|
||||||
|
Writeln('We shall allow this.. For now!! Gna Gna!');
|
||||||
|
Cont := True;
|
||||||
|
end;
|
||||||
|
procedure onWriteFile(var FileName : string; var Cont : boolean);
|
||||||
|
begin
|
||||||
|
Writeln('So.. You want to write to file: ' + FileName);
|
||||||
|
Writeln('Well for this time only!');
|
||||||
|
Cont := True;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure onOpenFile(var FileName : string; var Cont : boolean);
|
||||||
|
begin
|
||||||
|
Writeln('So you want to open this file: ' + filename);
|
||||||
|
Writeln('Well I don''t care much, lets see what the other hooks think!');
|
||||||
|
//Not set Cont as we don't care, while other hooks might
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure onColourPick(const Colour,x,y : integer);
|
||||||
|
begin
|
||||||
|
Writeln('So you''ve picked a color, huh!?');
|
||||||
|
Writeln(inttostr(colour) + ' attuh (' + inttostr(x) +',' + inttostr(y) + ')');
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure onScriptStart(var Script : string; var Cont : boolean);
|
||||||
|
begin
|
||||||
|
Writeln('So you want to compile the following script!!');
|
||||||
|
Writeln(script);
|
||||||
|
Writeln('lets allow that for now ;)');
|
||||||
|
Cont := True;
|
||||||
|
end;
|
||||||
procedure free;
|
procedure free;
|
||||||
begin
|
begin
|
||||||
Writeln('Free your extension here');
|
Writeln('Free your extension here');
|
||||||
|
@ -5,7 +5,7 @@ unit extensionmanager;
|
|||||||
interface
|
interface
|
||||||
|
|
||||||
uses
|
uses
|
||||||
Classes, SysUtils,virtualextension,psextension,mufasabase;
|
Classes, SysUtils,virtualextension,psextension,mufasabase,mufasatypes;
|
||||||
|
|
||||||
type
|
type
|
||||||
TExtension = TVirtualSimbaExtension;
|
TExtension = TVirtualSimbaExtension;
|
||||||
@ -30,7 +30,7 @@ type
|
|||||||
function GetExtensionIndex(Filename : string) : integer;
|
function GetExtensionIndex(Filename : string) : integer;
|
||||||
function LoadPSExtension(Filename : string; enabled : boolean=false) : boolean;
|
function LoadPSExtension(Filename : string; enabled : boolean=false) : boolean;
|
||||||
function LoadPSExtensionsDir(Directory,ext : string) : boolean;
|
function LoadPSExtensionsDir(Directory,ext : string) : boolean;
|
||||||
function HandleHook(HookName: String; Args: Array of Variant): Variant;
|
function HandleHook(const HookName: String; var Args: TVariantArray): Variant;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
var
|
var
|
||||||
@ -38,7 +38,7 @@ var
|
|||||||
|
|
||||||
implementation
|
implementation
|
||||||
uses
|
uses
|
||||||
TestUnit, settingssandbox,simbasettings,MufasaTypes;
|
TestUnit, settingssandbox,simbasettings;
|
||||||
|
|
||||||
procedure TExtensionManager.SetOnchange(const AValue: TNotifyEvent);
|
procedure TExtensionManager.SetOnchange(const AValue: TNotifyEvent);
|
||||||
var
|
var
|
||||||
@ -139,7 +139,7 @@ begin
|
|||||||
end;
|
end;
|
||||||
|
|
||||||
// How do we return more than one result?
|
// How do we return more than one result?
|
||||||
function TExtensionManager.HandleHook(HookName: String; Args: Array of Variant): Variant;
|
function TExtensionManager.HandleHook(const HookName: String;var Args: TVariantArray): Variant;
|
||||||
var
|
var
|
||||||
i: Integer;
|
i: Integer;
|
||||||
begin
|
begin
|
||||||
|
@ -236,6 +236,7 @@ begin
|
|||||||
ScriptNode.DeleteChildren;
|
ScriptNode.DeleteChildren;
|
||||||
Analyzing := TCodeInsight.Create();
|
Analyzing := TCodeInsight.Create();
|
||||||
Analyzing.OnFindInclude:= @Form1.OnCCFindInclude;
|
Analyzing.OnFindInclude:= @Form1.OnCCFindInclude;
|
||||||
|
Analyzing.OnMessage:= @Form1.OnCCMessage;
|
||||||
Analyzing.FileName:= Form1.CurrScript.ScriptFile;
|
Analyzing.FileName:= Form1.CurrScript.ScriptFile;
|
||||||
MS := TMemoryStream.Create;
|
MS := TMemoryStream.Create;
|
||||||
MS.Write(Script[1],length(script));
|
MS.Write(Script[1],length(script));
|
||||||
|
@ -5,7 +5,7 @@ unit psextension;
|
|||||||
interface
|
interface
|
||||||
|
|
||||||
uses
|
uses
|
||||||
Classes, SysUtils,mufasabase, virtualextension,
|
Classes, SysUtils,mufasabase, virtualextension, MufasaTypes,
|
||||||
uPSComponent,uPSCompiler, uPSRuntime, uPSPreProcessor,forms;
|
uPSComponent,uPSCompiler, uPSRuntime, uPSPreProcessor,forms;
|
||||||
|
|
||||||
|
|
||||||
@ -31,8 +31,8 @@ type
|
|||||||
procedure RIRegister_Settings(Cl: TPSRuntimeClassImporter);
|
procedure RIRegister_Settings(Cl: TPSRuntimeClassImporter);
|
||||||
|
|
||||||
public
|
public
|
||||||
function HookExists(HookName: String): Boolean;override;
|
function HookExists(const HookName: String): Boolean;override;
|
||||||
function ExecuteHook(HookName: String; fArgs: Array of Variant; out OutVariant : Variant): Integer;override;
|
function ExecuteHook(const HookName: String;var Args:TVariantArray; out OutVariant : Variant): Integer;override;
|
||||||
property Working : boolean read FWorking;
|
property Working : boolean read FWorking;
|
||||||
protected
|
protected
|
||||||
procedure RegisterPSCComponents(Sender: TObject; x: TPSPascalCompiler);
|
procedure RegisterPSCComponents(Sender: TObject; x: TPSPascalCompiler);
|
||||||
@ -52,7 +52,7 @@ uses
|
|||||||
testunit,updateform,settingssandbox,bitmaps,mmisc//Writeln
|
testunit,updateform,settingssandbox,bitmaps,mmisc//Writeln
|
||||||
;
|
;
|
||||||
|
|
||||||
function TSimbaPSExtension.HookExists(HookName: String): Boolean;
|
function TSimbaPSExtension.HookExists(const HookName: String): Boolean;
|
||||||
begin
|
begin
|
||||||
Result := False;
|
Result := False;
|
||||||
if FWorking then
|
if FWorking then
|
||||||
@ -60,13 +60,13 @@ begin
|
|||||||
result := True;
|
result := True;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function TSimbaPSExtension.ExecuteHook(HookName: String; fArgs: Array of Variant; out OutVariant : Variant): Integer;
|
function TSimbaPSExtension.ExecuteHook(const HookName: String;var Args: TVariantArray; out OutVariant : Variant): Integer;
|
||||||
begin
|
begin
|
||||||
result := SExt_error;
|
result := SExt_error;
|
||||||
if not FWorking then
|
if not FWorking then
|
||||||
exit;
|
exit;
|
||||||
try
|
try
|
||||||
outvariant := PSInstance.ExecuteFunction(fArgs, HookName);
|
outvariant := PSInstance.ExecuteFunction(Args, HookName);
|
||||||
result := SExt_ok;
|
result := SExt_ok;
|
||||||
except
|
except
|
||||||
on e : exception do
|
on e : exception do
|
||||||
@ -106,10 +106,11 @@ end;
|
|||||||
function TSimbaPSExtension.FreeScript: boolean;
|
function TSimbaPSExtension.FreeScript: boolean;
|
||||||
var
|
var
|
||||||
bla : variant;
|
bla : variant;
|
||||||
|
Args : TVariantArray;
|
||||||
begin
|
begin
|
||||||
if not HookExists('Free') then
|
if not HookExists('Free') then
|
||||||
exit(false);
|
exit(false);
|
||||||
result := ExecuteHook('Free',[],bla) = SExt_ok;
|
result := ExecuteHook('Free',Args,bla) = SExt_ok;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
{$I ../../Units/MMLAddon/PSInc/Wrappers/extensions.inc}
|
{$I ../../Units/MMLAddon/PSInc/Wrappers/extensions.inc}
|
||||||
@ -143,6 +144,7 @@ end;
|
|||||||
procedure TSimbaPSExtension.SetEnabled(bool: boolean);
|
procedure TSimbaPSExtension.SetEnabled(bool: boolean);
|
||||||
var
|
var
|
||||||
temp : variant;
|
temp : variant;
|
||||||
|
Args : TVariantArray;
|
||||||
begin
|
begin
|
||||||
if bool <> FEnabled then
|
if bool <> FEnabled then
|
||||||
begin
|
begin
|
||||||
@ -155,11 +157,11 @@ begin
|
|||||||
if not FWorking then
|
if not FWorking then
|
||||||
Exit;
|
Exit;
|
||||||
if hookexists('attach') then
|
if hookexists('attach') then
|
||||||
ExecuteHook('attach',[],temp);
|
ExecuteHook('attach',Args,temp);
|
||||||
end;
|
end;
|
||||||
end else
|
end else
|
||||||
if HookExists('detach') then
|
if HookExists('detach') then
|
||||||
ExecuteHook('detach',[],temp);
|
ExecuteHook('detach',Args,temp);
|
||||||
end;
|
end;
|
||||||
inherited SetEnabled(bool);
|
inherited SetEnabled(bool);
|
||||||
end;
|
end;
|
||||||
|
@ -301,6 +301,8 @@ type
|
|||||||
Shift: TShiftState; X, Y: Integer);
|
Shift: TShiftState; X, Y: Integer);
|
||||||
procedure PageControl1MouseUp(Sender: TObject; Button: TMouseButton;
|
procedure PageControl1MouseUp(Sender: TObject; Button: TMouseButton;
|
||||||
Shift: TShiftState; X, Y: Integer);
|
Shift: TShiftState; X, Y: Integer);
|
||||||
|
procedure PickerPick(Sender: TObject; const Colour, colourx,
|
||||||
|
coloury: integer);
|
||||||
procedure PopupItemFindClick(Sender: TObject);
|
procedure PopupItemFindClick(Sender: TObject);
|
||||||
procedure ProcessDebugStream(Sender: TObject);
|
procedure ProcessDebugStream(Sender: TObject);
|
||||||
procedure RecentFileItemsClick(Sender: TObject);
|
procedure RecentFileItemsClick(Sender: TObject);
|
||||||
@ -313,6 +315,13 @@ type
|
|||||||
procedure SplitterFunctionListCanResize(Sender: TObject; var NewSize: Integer;
|
procedure SplitterFunctionListCanResize(Sender: TObject; var NewSize: Integer;
|
||||||
var Accept: Boolean);
|
var Accept: Boolean);
|
||||||
procedure TB_ReloadPluginsClick(Sender: TObject);
|
procedure TB_ReloadPluginsClick(Sender: TObject);
|
||||||
|
procedure ThreadOpenConnectionEvent(Sender: TObject; var url: string;
|
||||||
|
var Continue: boolean);
|
||||||
|
procedure ThreadOpenFileEvent(Sender: TObject; var Filename: string;
|
||||||
|
var Continue: boolean);
|
||||||
|
procedure ThreadWriteFileEvent(Sender: TObject; var Filename: string;
|
||||||
|
var Continue: boolean);
|
||||||
|
procedure ScriptStartEvent(Sender: TObject; var Script : string; var Continue : boolean);
|
||||||
procedure TrayPopupPopup(Sender: TObject);
|
procedure TrayPopupPopup(Sender: TObject);
|
||||||
procedure TT_UpdateClick(Sender: TObject);
|
procedure TT_UpdateClick(Sender: TObject);
|
||||||
procedure UpdateMenuButtonClick(Sender: TObject);
|
procedure UpdateMenuButtonClick(Sender: TObject);
|
||||||
@ -329,6 +338,14 @@ type
|
|||||||
SearchStart : TPoint;
|
SearchStart : TPoint;
|
||||||
LastTab : integer;
|
LastTab : integer;
|
||||||
UpdatingFonts : boolean;
|
UpdatingFonts : boolean;
|
||||||
|
OpenConnectionData : TOpenConnectionData;
|
||||||
|
OpenFileData : TOpenFileData;
|
||||||
|
WriteFileData : TWriteFileData;
|
||||||
|
ScriptStartData : TScriptStartData;
|
||||||
|
procedure HandleConnectionData;
|
||||||
|
procedure HandleOpenFileData;
|
||||||
|
procedure HandleWriteFileData;
|
||||||
|
procedure HandleScriptStartData;
|
||||||
function GetExtPath: string;
|
function GetExtPath: string;
|
||||||
function GetFontPath: String;
|
function GetFontPath: String;
|
||||||
function GetHighlighter: TSynCustomHighlighter;
|
function GetHighlighter: TSynCustomHighlighter;
|
||||||
@ -361,6 +378,7 @@ type
|
|||||||
OCR_Fonts: TMOCR;
|
OCR_Fonts: TMOCR;
|
||||||
Picker: TMColorPicker;
|
Picker: TMColorPicker;
|
||||||
Selector: TMWindowSelector;
|
Selector: TMWindowSelector;
|
||||||
|
OnScriptStart : TScriptStartEvent;
|
||||||
{$ifdef mswindows}
|
{$ifdef mswindows}
|
||||||
ConsoleVisible : boolean;
|
ConsoleVisible : boolean;
|
||||||
procedure ShowConsole( ShowIt : boolean);
|
procedure ShowConsole( ShowIt : boolean);
|
||||||
@ -513,6 +531,74 @@ begin
|
|||||||
result := false;
|
result := false;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
procedure TForm1.HandleConnectionData;
|
||||||
|
var
|
||||||
|
Args : TVariantArray;
|
||||||
|
begin
|
||||||
|
SetLength(Args,2);
|
||||||
|
Args[0] := OpenConnectionData.URL^;
|
||||||
|
Args[1] := OpenConnectionData.Continue^;
|
||||||
|
try
|
||||||
|
ExtManager.HandleHook(EventHooks[SExt_onOpenConnection].HookName,Args);
|
||||||
|
OpenConnectionData.URL^ := Args[0];
|
||||||
|
OpenConnectionData.Continue^ := Args[1];
|
||||||
|
except
|
||||||
|
on e : Exception do
|
||||||
|
mDebugLn('ERROR in HandleConnectiondata: ' + e.message);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TForm1.HandleOpenFileData;
|
||||||
|
var
|
||||||
|
Args : TVariantArray;
|
||||||
|
begin
|
||||||
|
SetLength(Args,2);
|
||||||
|
Args[0] := OpenFileData.FileName^;
|
||||||
|
Args[1] := OpenFileData.Continue^;
|
||||||
|
try
|
||||||
|
ExtManager.HandleHook(EventHooks[SExt_onOpenFile].HookName,Args);
|
||||||
|
OpenFileData.FileName^ := Args[0];
|
||||||
|
OpenFileData.Continue^ := Args[1];
|
||||||
|
except
|
||||||
|
on e : Exception do
|
||||||
|
mDebugLn('ERROR in HandleOpenFileData: ' + e.message);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TForm1.HandleWriteFileData;
|
||||||
|
var
|
||||||
|
Args : TVariantArray;
|
||||||
|
begin
|
||||||
|
SetLength(Args,2);
|
||||||
|
Args[0] := WriteFileData.FileName^;
|
||||||
|
Args[1] := WriteFileData.Continue^;
|
||||||
|
try
|
||||||
|
ExtManager.HandleHook(EventHooks[SExt_onWriteFile].HookName,Args);
|
||||||
|
WriteFileData.FileName^ := Args[0];
|
||||||
|
WriteFileData.Continue^ := Args[1];
|
||||||
|
except
|
||||||
|
on e : Exception do
|
||||||
|
mDebugLn('ERROR in HandleWriteFileData: ' + e.message);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TForm1.HandleScriptStartData;
|
||||||
|
var
|
||||||
|
Args : TVariantArray;
|
||||||
|
begin
|
||||||
|
SetLength(Args,2);
|
||||||
|
Args[0] := ScriptStartData.Script^;
|
||||||
|
Args[1] := ScriptStartData.Continue^;
|
||||||
|
try
|
||||||
|
ExtManager.HandleHook(EventHooks[SExt_onScriptStart].HookName,Args);
|
||||||
|
ScriptStartData.Script^ := Args[0];
|
||||||
|
ScriptStartData.Continue^ := Args[1];
|
||||||
|
except
|
||||||
|
on e : Exception do
|
||||||
|
mDebugLn('ERROR in HandleScriptStartData: ' + e.message);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
procedure TForm1.ProcessDebugStream(Sender: TObject);
|
procedure TForm1.ProcessDebugStream(Sender: TObject);
|
||||||
begin
|
begin
|
||||||
if length(DebugStream) = 0 then
|
if length(DebugStream) = 0 then
|
||||||
@ -604,6 +690,32 @@ begin
|
|||||||
// PluginsGlob.FreePlugins;
|
// PluginsGlob.FreePlugins;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
procedure TForm1.ThreadOpenConnectionEvent(Sender: TObject; var url: string;var Continue: boolean);
|
||||||
|
begin
|
||||||
|
OpenConnectionData.Sender := Sender;
|
||||||
|
OpenConnectionData.URL:= @URL;
|
||||||
|
OpenConnectionData.Continue:= @Continue;
|
||||||
|
TThread.Synchronize(nil,@HandleConnectionData);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TForm1.ThreadOpenFileEvent(Sender: TObject; var Filename: string;
|
||||||
|
var Continue: boolean);
|
||||||
|
begin
|
||||||
|
OpenFileData.Sender := Sender;
|
||||||
|
OpenFileData.FileName:= @FileName;
|
||||||
|
OpenFileData.Continue:= @Continue;
|
||||||
|
TThread.Synchronize(nil,@HandleOpenFileData);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TForm1.ThreadWriteFileEvent(Sender: TObject; var Filename: string;
|
||||||
|
var Continue: boolean);
|
||||||
|
begin
|
||||||
|
WriteFileData.Sender := Sender;
|
||||||
|
WriteFileData.FileName:= @FileName;
|
||||||
|
WriteFileData.Continue:= @Continue;
|
||||||
|
TThread.Synchronize(nil,@HandleWriteFileData);
|
||||||
|
end;
|
||||||
|
|
||||||
procedure TForm1.TrayPopupPopup(Sender: TObject);
|
procedure TForm1.TrayPopupPopup(Sender: TObject);
|
||||||
begin
|
begin
|
||||||
MenuItemHide.enabled:= Form1.Visible;
|
MenuItemHide.enabled:= Form1.Visible;
|
||||||
@ -1214,9 +1326,19 @@ var
|
|||||||
AppPath : string;
|
AppPath : string;
|
||||||
ScriptPath : string;
|
ScriptPath : string;
|
||||||
UseCPascal: String;
|
UseCPascal: String;
|
||||||
|
Script : string;
|
||||||
Se: TMMLSettingsSandbox;
|
Se: TMMLSettingsSandbox;
|
||||||
loadFontsOnScriptStart: boolean;
|
loadFontsOnScriptStart: boolean;
|
||||||
|
Continue : boolean;
|
||||||
begin
|
begin
|
||||||
|
Script :=CurrScript.SynEdit.Lines.Text;
|
||||||
|
if Assigned(OnScriptStart) then
|
||||||
|
begin
|
||||||
|
Continue := True;
|
||||||
|
OnScriptStart(Self,script,continue);
|
||||||
|
if not Continue then
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
AppPath:= MainDir + DS;
|
AppPath:= MainDir + DS;
|
||||||
CurrScript.ScriptErrorLine:= -1;
|
CurrScript.ScriptErrorLine:= -1;
|
||||||
CurrentSyncInfo.SyncMethod:= @Self.SafeCallThread;
|
CurrentSyncInfo.SyncMethod:= @Self.SafeCallThread;
|
||||||
@ -1234,7 +1356,7 @@ begin
|
|||||||
Thread.SetDebug(@formWriteln);
|
Thread.SetDebug(@formWriteln);
|
||||||
Thread.SetDebugClear(@ClearDebug);
|
Thread.SetDebugClear(@ClearDebug);
|
||||||
{$ENDIF}
|
{$ENDIF}
|
||||||
Thread.SetScript(CurrScript.SynEdit.Lines.Text);
|
Thread.SetScript(Script);
|
||||||
DbgImgInfo.DispSize := @DebugImgForm.DispSize;
|
DbgImgInfo.DispSize := @DebugImgForm.DispSize;
|
||||||
DbgImgInfo.ShowForm := @DebugImgForm.ShowDebugImgForm;
|
DbgImgInfo.ShowForm := @DebugImgForm.ShowDebugImgForm;
|
||||||
DbgImgInfo.ToDrawBitmap:= @DebugImgForm.ToDrawBmp;
|
DbgImgInfo.ToDrawBitmap:= @DebugImgForm.ToDrawBmp;
|
||||||
@ -1275,6 +1397,9 @@ begin
|
|||||||
Se := TMMLSettingsSandbox.Create(SettingsForm.Settings);
|
Se := TMMLSettingsSandbox.Create(SettingsForm.Settings);
|
||||||
Se.Prefix := 'Scripts/';
|
Se.Prefix := 'Scripts/';
|
||||||
Thread.SetSettings(Se);
|
Thread.SetSettings(Se);
|
||||||
|
Thread.OpenConnectionEvent:=@ThreadOpenConnectionEvent;
|
||||||
|
Thread.WriteFileEvent:=@ThreadWriteFileEvent;
|
||||||
|
Thread.OpenFileEvent:=@ThreadOpenFileEvent;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TForm1.HandleParameters;
|
procedure TForm1.HandleParameters;
|
||||||
@ -1899,6 +2024,9 @@ begin
|
|||||||
TT_Console.Visible:= false;
|
TT_Console.Visible:= false;
|
||||||
{$endif}
|
{$endif}
|
||||||
InitmDebug;
|
InitmDebug;
|
||||||
|
|
||||||
|
Self.OnScriptStart:= @ScriptStartEvent;
|
||||||
|
|
||||||
FillThread := TProcThread.Create(true);
|
FillThread := TProcThread.Create(true);
|
||||||
FillThread.FreeOnTerminate:= True;
|
FillThread.FreeOnTerminate:= True;
|
||||||
FillThread.NormalProc:= @CCFillCore;
|
FillThread.NormalProc:= @CCFillCore;
|
||||||
@ -1922,6 +2050,7 @@ begin
|
|||||||
AddTab;//Give it alteast 1 tab ;-).
|
AddTab;//Give it alteast 1 tab ;-).
|
||||||
Manager := TIOManager.Create; //No need to load plugins for the Global manager
|
Manager := TIOManager.Create; //No need to load plugins for the Global manager
|
||||||
Picker := TMColorPicker.Create(Manager);
|
Picker := TMColorPicker.Create(Manager);
|
||||||
|
Picker.OnPick:=@PickerPick;
|
||||||
Selector := TMWindowSelector.Create(Manager);
|
Selector := TMWindowSelector.Create(Manager);
|
||||||
{ For writeln }
|
{ For writeln }
|
||||||
SetLength(DebugStream, 0);
|
SetLength(DebugStream, 0);
|
||||||
@ -2345,6 +2474,18 @@ begin
|
|||||||
DeleteTab(PageControl1.TabIndexAtClientPos(Classes.Point(x,y)), False);
|
DeleteTab(PageControl1.TabIndexAtClientPos(Classes.Point(x,y)), False);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
procedure TForm1.PickerPick(Sender: TObject; const Colour, colourx,
|
||||||
|
coloury: integer);
|
||||||
|
var
|
||||||
|
Args : TVariantArray;
|
||||||
|
begin
|
||||||
|
SetLength(args,3);
|
||||||
|
Args[0] := Colour;
|
||||||
|
Args[1] := Colourx;
|
||||||
|
Args[2] := Coloury;
|
||||||
|
ExtManager.HandleHook(EventHooks[SExt_OnColourPick].HookName,Args);
|
||||||
|
end;
|
||||||
|
|
||||||
procedure TForm1.PopupItemFindClick(Sender: TObject);
|
procedure TForm1.PopupItemFindClick(Sender: TObject);
|
||||||
begin
|
begin
|
||||||
SearchString := CurrScript.SynEdit.SelText;
|
SearchString := CurrScript.SynEdit.SelText;
|
||||||
@ -2500,6 +2641,15 @@ begin
|
|||||||
UpdatingFonts := False;
|
UpdatingFonts := False;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
procedure TForm1.ScriptStartEvent(Sender: TObject; var Script: string;
|
||||||
|
var Continue: boolean);
|
||||||
|
begin
|
||||||
|
ScriptStartData.Sender:=Sender;
|
||||||
|
ScriptStartData.Script:= @Script;
|
||||||
|
ScriptStartData.Continue:= @Continue;
|
||||||
|
TThread.Synchronize(nil,@HandleScriptStartData);
|
||||||
|
end;
|
||||||
|
|
||||||
procedure TForm1.SetShowHintAuto(const AValue: boolean);
|
procedure TForm1.SetShowHintAuto(const AValue: boolean);
|
||||||
begin
|
begin
|
||||||
SetSetting('Settings/CodeHints/ShowAutomatically',Booltostr(AValue,true));
|
SetSetting('Settings/CodeHints/ShowAutomatically',Booltostr(AValue,true));
|
||||||
@ -2573,7 +2723,7 @@ begin
|
|||||||
with TPSThread(thread).PSScript do
|
with TPSThread(thread).PSScript do
|
||||||
begin
|
begin
|
||||||
OnLine:=@OnLinePSScript;
|
OnLine:=@OnLinePSScript;
|
||||||
CurrentSyncInfo.Res:= Exec.RunProcPVar(CurrentSyncInfo.V,Exec.GetProc(CurrentSyncInfo.MethodName));
|
CurrentSyncInfo.Res:= Exec.RunProcPVar(CurrentSyncInfo.V^,Exec.GetProc(CurrentSyncInfo.MethodName));
|
||||||
Online := nil;
|
Online := nil;
|
||||||
end;
|
end;
|
||||||
end else
|
end else
|
||||||
|
@ -5,7 +5,7 @@ unit virtualextension;
|
|||||||
interface
|
interface
|
||||||
|
|
||||||
uses
|
uses
|
||||||
Classes, SysUtils,settingssandbox;
|
Classes, SysUtils,settingssandbox,MufasaTypes;
|
||||||
|
|
||||||
type
|
type
|
||||||
{ TVirtualSimbaExtension }
|
{ TVirtualSimbaExtension }
|
||||||
@ -21,10 +21,10 @@ type
|
|||||||
public
|
public
|
||||||
OnChange : TNotifyEvent;
|
OnChange : TNotifyEvent;
|
||||||
{ Must be implemented }
|
{ Must be implemented }
|
||||||
function HookExists(HookName: String): Boolean; virtual; abstract;
|
function HookExists(const HookName: String): Boolean; virtual; abstract;
|
||||||
|
|
||||||
{ No Custom Arguments just yet... }
|
{ No Custom Arguments just yet... }
|
||||||
function ExecuteHook(HookName: String; fArgs: Array of Variant; out OutVariant : variant): Integer; virtual; abstract;
|
function ExecuteHook(const HookName: String;var Args: TVariantArray; out OutVariant : variant): Integer; virtual; abstract;
|
||||||
|
|
||||||
function GetName : string;
|
function GetName : string;
|
||||||
function GetVersion : String;
|
function GetVersion : String;
|
||||||
@ -47,15 +47,23 @@ type
|
|||||||
const
|
const
|
||||||
SExt_ok = 0;
|
SExt_ok = 0;
|
||||||
SExt_error = 1;
|
SExt_error = 1;
|
||||||
EventHooks: Array [0..7] of TEventHook =
|
SExt_OnColourPick = 0;
|
||||||
( (HookName : 'onScriptCompile' ; ArgumentCount : 1),
|
SExt_onOpenFile = 1;
|
||||||
(HookName : 'onScriptStart' ; ArgumentCount : 1),
|
SExt_onWriteFile = 2;
|
||||||
|
SExt_onOpenConnection = 3;
|
||||||
|
SExt_onScriptStart = 4;
|
||||||
|
|
||||||
|
EventHooks: Array [0..8] of TEventHook =
|
||||||
|
( (HookName : 'onColourPick' ; ArgumentCount : 3), //const colour,colourx,coloury : integer;
|
||||||
|
(HookName : 'onOpenFile' ; ArgumentCount : 2), //var filename : string; var Continue : boolean
|
||||||
|
(HookName : 'onWriteFile' ; ArgumentCount : 2), //var filename : string; var Continue : boolean
|
||||||
|
(HookName : 'onOpenConnection'; ArgumentCount : 2), //var url : string; var Continue : boolean
|
||||||
|
(HookName : 'onScriptStart' ; ArgumentCount : 2), //var Script : string; var Continue : boolean; This is called BEFORE it compiles/executes
|
||||||
|
(HookName : 'onScriptCompile' ; ArgumentCount : 1),
|
||||||
|
(HookName : 'onScriptExecute' ; ArgumentCount : 1),
|
||||||
(HookName : 'onScriptPause' ; ArgumentCount : 1),
|
(HookName : 'onScriptPause' ; ArgumentCount : 1),
|
||||||
(HookName : 'onScriptStop' ; ArgumentCount : 1),
|
(HookName : 'onScriptStop' ; ArgumentCount : 1));
|
||||||
(HookName : 'onColourPick' ; ArgumentCount : 3),
|
|
||||||
(HookName : 'onOpenFile' ; ArgumentCount : 1),
|
|
||||||
(HookName : 'onOpenSocket' ; ArgumentCount : 1),
|
|
||||||
(HookName : 'onWriteFile' ; ArgumentCount : 1));
|
|
||||||
|
|
||||||
implementation
|
implementation
|
||||||
|
|
||||||
@ -71,13 +79,14 @@ end;
|
|||||||
function TVirtualSimbaExtension.GetName: string;
|
function TVirtualSimbaExtension.GetName: string;
|
||||||
var
|
var
|
||||||
OutPut : Variant;
|
OutPut : Variant;
|
||||||
|
Args : TVariantArray;
|
||||||
begin
|
begin
|
||||||
Result := '';
|
Result := '';
|
||||||
if FName <> '' then
|
if FName <> '' then
|
||||||
Result := FName
|
Result := FName
|
||||||
else if self.HookExists('GetName') then
|
else if self.HookExists('GetName') then
|
||||||
begin;
|
begin;
|
||||||
if ExecuteHook('GetName',[],OutPut) <> SExt_ok then
|
if ExecuteHook('GetName',Args,OutPut) <> SExt_ok then
|
||||||
FName := ''
|
FName := ''
|
||||||
else
|
else
|
||||||
FName := OutPut;
|
FName := OutPut;
|
||||||
@ -88,13 +97,14 @@ end;
|
|||||||
function TVirtualSimbaExtension.GetVersion: String;
|
function TVirtualSimbaExtension.GetVersion: String;
|
||||||
var
|
var
|
||||||
OutPut : Variant;
|
OutPut : Variant;
|
||||||
|
Args : TVariantArray;
|
||||||
begin
|
begin
|
||||||
Result := '';
|
Result := '';
|
||||||
if FVersion <> '' then
|
if FVersion <> '' then
|
||||||
Result := FVersion
|
Result := FVersion
|
||||||
else if self.HookExists('GetVersion') then
|
else if self.HookExists('GetVersion') then
|
||||||
begin;
|
begin;
|
||||||
if ExecuteHook('GetVersion',[],OutPut) <> SExt_ok then
|
if ExecuteHook('GetVersion',Args,OutPut) <> SExt_ok then
|
||||||
FVersion := ''
|
FVersion := ''
|
||||||
else
|
else
|
||||||
FVersion := Output;
|
FVersion := Output;
|
||||||
|
@ -1,6 +1,6 @@
|
|||||||
function ps_GetPage(S: String): String; extdecl;
|
function ps_GetPage(S: String): String; extdecl;
|
||||||
begin
|
begin
|
||||||
result := GetPage(S);
|
result := CurrThread.MInternet.GetPage(S);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function ps_InitializeHTTPClient(HandleCookies: Boolean): Integer; extdecl;
|
function ps_InitializeHTTPClient(HandleCookies: Boolean): Integer; extdecl;
|
||||||
|
@ -1 +1 @@
|
|||||||
function ps_Format(const fmt : string;const args : array of const) : string; extdecl;
begin;
Result := Format(fmt,Args);
end;
function ps_Capitalize(str : string) : string;extdecl;
begin
result := Capitalize(str);
end;
function ps_ExtractFromStr( Str : string; Extract : StrExtr) : string; extdecl;
begin
result := extractfromstr(str,extract);
end;
function ps_BoolToStr(bool : boolean) : string; extdecl;
begin;
result := BoolToStr(bool,true);
end;
function ps_Replace(Text, FindStr, ReplaceStr: string; Flags: TReplaceFlags): string; extdecl;
begin;
result := StringReplace(Text,FindStr,ReplaceStr,Flags);
end;
function ps_IntToStr(int : integer) : string; extdecl;
begin
result := inttostr(int);
end;
function ps_FloatToStr(flt : extended) : string; extdecl;
begin
result := floattostr(flt);
end;
function ps_StrToInt(value: String): Integer; extdecl;
begin
result := StrToInt(value);
end;
function ps_StrToIntDef(value: String; default: Integer): Integer; extdecl;
begin
result := StrToIntDef(value,default);
end;
function ps_StrToFloat(value: String): Extended; extdecl;
begin
result := StrToFloat(value);
end;
function ps_StrToFloatDef(value: String; default: Extended): Extended; extdecl;
begin
result := StrToFloatDef(value,default);
end;
function ps_StrToBool(value: String): Boolean;extdecl;
begin
result := StrToBool(value);
end;
function ps_StrToBoolDef(value: String; default: Boolean): Boolean; extdecl;
begin
result := StrToBoolDef(value,default);
end;
function ps_Between(s1, s2, str: string): string; extdecl;
var
I,J : integer;
begin;
Result := '';
I := pos(s1,str);
if I > 0 then
begin;
i := i + length(s1);
j := posex(s2,str,i);
if j > 0 then
Result := copy(str,i,j-i);
end;
end;
function ps_Implode(Glue : string; Pieces: TStringArray): string;extdecl;
begin
result := implode(glue,pieces);
end;
function ps_Explode(del, str: string): TStringArray;extdecl;
begin
result := Explode(del,str);
end;
procedure ps_ExplodeWrap(del, str: string; var res : TStringArray);extdecl;
begin
res := Explode(del,str);
end;
|
function ps_Format(const fmt : string;const args : array of const) : string; extdecl;
begin;
Result := Format(fmt,Args);
end;
function ps_Capitalize(str : string) : string;extdecl;
begin
result := Capitalize(str);
end;
function ps_ExtractFromStr( Str : string; Extract : StrExtr) : string; extdecl;
begin
result := extractfromstr(str,extract);
end;
function ps_BoolToStr(bool : boolean) : string; extdecl;
begin;
result := BoolToStr(bool,true);
end;
function ps_Replace(Text, FindStr, ReplaceStr: string; Flags: TReplaceFlags): string; extdecl;
begin;
result := StringReplace(Text,FindStr,ReplaceStr,Flags);
end;
function ps_IntToStr(int : integer) : string; extdecl;
begin
result := inttostr(int);
end;
function ps_FloatToStr(flt : extended) : string; extdecl;
begin
result := floattostr(flt);
end;
function ps_StrToInt(value: String): Integer; extdecl;
begin
result := StrToInt(value);
end;
function ps_StrToIntDef(value: String; default: Integer): Integer; extdecl;
begin
result := StrToIntDef(value,default);
end;
function ps_StrToFloat(value: String): Extended; extdecl;
begin
result := StrToFloat(value);
end;
function ps_StrToFloatDef(value: String; default: Extended): Extended; extdecl;
begin
result := StrToFloatDef(value,default);
end;
function ps_StrToBool(value: String): Boolean;extdecl;
begin
result := StrToBool(value);
end;
function ps_StrToBoolDef(value: String; default: Boolean): Boolean; extdecl;
begin
result := StrToBoolDef(value,default);
end;
function ps_Between(s1, s2, str: string): string; extdecl;
var
I,J : integer;
begin;
Result := '';
I := pos(s1,str);
if I > 0 then
begin;
i := i + length(s1);
j := posex(s2,str,i);
if j > 0 then
Result := copy(str,i,j-i);
end;
end;
function ps_Implode(Glue : string; Pieces: TStringArray): string;extdecl;
begin
result := implode(glue,pieces);
end;
function ps_Explode(del, str: string): TStringArray;extdecl;
begin
result := Explode(del,str);
end;
procedure ps_ExplodeWrap(del, str: string; var res : TStringArray);extdecl;
begin
res := Explode(del,str);
end;
function ps_Padl(s: String; i: longInt): String;extdecl;
begin
result := StringOfChar(Char(' '), i - length(s)) + s;
end;
function ps_Padz(s: String; i: longInt): String;extdecl;
begin
result := StringOfChar(Char('0'), i - length(s)) + s;
end;
function ps_Padr(s: String; i: longInt): String;extdecl;
begin
result := s + StringOfChar(Char(' '), i - Length(s));
end;
|
@ -155,6 +155,9 @@ AddFunction(@ps_Replace,'function ReplaceWrap(Text, FindStr, ReplaceStr: string;
|
|||||||
AddFunction(@ps_Implode,'function Implode(Glue: string; Pieces: TStringArray): string;');
|
AddFunction(@ps_Implode,'function Implode(Glue: string; Pieces: TStringArray): string;');
|
||||||
AddFunction(@ps_Explode,'function Explode(del, str: string): TStringArray;');
|
AddFunction(@ps_Explode,'function Explode(del, str: string): TStringArray;');
|
||||||
AddFunction(@ps_explodewrap,'procedure ExplodeWrap(del, str: string; var res : TStringArray);');
|
AddFunction(@ps_explodewrap,'procedure ExplodeWrap(del, str: string; var res : TStringArray);');
|
||||||
|
AddFunction(@ps_PadL,'function Padl(s: String; i: longInt): String;');
|
||||||
|
AddFunction(@Ps_Padz,'function Padz(s: String; i: longInt): String;');
|
||||||
|
AddFunction(@ps_padR,'function Padr(s: String; i: longInt): String;');
|
||||||
|
|
||||||
{web}
|
{web}
|
||||||
SetCurrSection('Web');
|
SetCurrSection('Web');
|
||||||
|
@ -43,36 +43,33 @@ uses
|
|||||||
|
|
||||||
|
|
||||||
type
|
type
|
||||||
TPickEvent = procedure (Sender: TObject; Color, X, Y: Integer);
|
|
||||||
|
|
||||||
TMColorPicker = class(TObject)
|
TMColorPicker = class(TObject)
|
||||||
constructor Create(manager: TIOManager);
|
constructor Create(manager: TIOManager);
|
||||||
destructor Destroy; override;
|
destructor Destroy; override;
|
||||||
|
|
||||||
procedure Pick(Out C, X, Y: Integer);
|
procedure Pick(Out C, X, Y: Integer);
|
||||||
|
|
||||||
procedure ImageMainMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
|
procedure ImageMainMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
|
||||||
procedure ImageInfoMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
|
procedure ImageInfoMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
|
||||||
Procedure ColorPickUp(Sender: TObject; Button: TMouseButton;Shift: TShiftState; X, Y: Integer);
|
Procedure ColorPickUp(Sender: TObject; Button: TMouseButton;Shift: TShiftState; X, Y: Integer);
|
||||||
public
|
public
|
||||||
manager: TIOManager;
|
manager: TIOManager;
|
||||||
|
{ Form components }
|
||||||
|
ScreenForm, InfoForm : TForm;
|
||||||
|
ImageMain, ImageInfo: TImage;
|
||||||
|
Text : string;
|
||||||
|
FPickEvent : TColourPickEvent;
|
||||||
|
|
||||||
{ Form components }
|
{ Some temp vars }
|
||||||
ScreenForm, InfoForm : TForm;
|
oldx, oldy, Color, colorx, colory: Integer;
|
||||||
ImageMain, ImageInfo: TImage;
|
// targetleft,targettop : integer;
|
||||||
Text : string;
|
|
||||||
FPickEvent : TPickEvent;
|
|
||||||
|
|
||||||
{ Some temp vars }
|
TheChangedEvent,TheChangingEvent : TNotifyEvent;
|
||||||
oldx, oldy, Color, colorx, colory: Integer;
|
|
||||||
// targetleft,targettop : integer;
|
|
||||||
|
|
||||||
TheChangedEvent,TheChangingEvent : TNotifyEvent;
|
{ Handles }
|
||||||
|
InfoHandle, ImageHandle : HDC;
|
||||||
{ Handles }
|
|
||||||
InfoHandle, ImageHandle : HDC;
|
|
||||||
public
|
public
|
||||||
property OnPick: TPickEvent read FPickEvent write FPickEvent;
|
property OnPick: TColourPickEvent read FPickEvent write FPickEvent;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
@ -284,7 +281,7 @@ begin;
|
|||||||
Color:= WidgetSet.DCGetPixel(ImageMain.Canvas.Handle,x,y);
|
Color:= WidgetSet.DCGetPixel(ImageMain.Canvas.Handle,x,y);
|
||||||
Manager.GetMousePos(ColorX, ColorY);
|
Manager.GetMousePos(ColorX, ColorY);
|
||||||
|
|
||||||
if OnPick <> nil then
|
if Assigned(OnPick) then
|
||||||
Onpick(Sender,Color,Colorx,Colory);
|
Onpick(Sender,Color,Colorx,Colory);
|
||||||
|
|
||||||
{ Tell Pick() that we are done }
|
{ Tell Pick() that we are done }
|
||||||
|
@ -5,7 +5,7 @@ unit internets;
|
|||||||
interface
|
interface
|
||||||
|
|
||||||
uses
|
uses
|
||||||
Classes, SysUtils,httpsend;
|
Classes, SysUtils,httpsend,MufasaTypes;
|
||||||
|
|
||||||
function GetPage(URL: String): String;
|
function GetPage(URL: String): String;
|
||||||
|
|
||||||
@ -20,6 +20,7 @@ type
|
|||||||
PostVariables : TStringList;
|
PostVariables : TStringList;
|
||||||
Client : TObject;
|
Client : TObject;
|
||||||
public
|
public
|
||||||
|
OpenConnectionEvent : TOpenConnectionEvent;
|
||||||
procedure SetHTTPUserAgent(agent : string);
|
procedure SetHTTPUserAgent(agent : string);
|
||||||
function GetHTTPPage(url : string ) : string;
|
function GetHTTPPage(url : string ) : string;
|
||||||
function PostHTTPPage(Url: string; PostData: string): string;overload;
|
function PostHTTPPage(Url: string; PostData: string): string;overload;
|
||||||
@ -37,6 +38,8 @@ type
|
|||||||
Connections : TList;
|
Connections : TList;
|
||||||
HTTPClients : TList;
|
HTTPClients : TList;
|
||||||
public
|
public
|
||||||
|
OpenConnectionEvent : TOpenConnectionEvent;
|
||||||
|
function GetPage(URL: String): String;
|
||||||
function CreateHTTPClient(HandleCookies : boolean = true) : integer;
|
function CreateHTTPClient(HandleCookies : boolean = true) : integer;
|
||||||
function GetHTTPClient(Index : integer) : THTTPClient;
|
function GetHTTPClient(Index : integer) : THTTPClient;
|
||||||
procedure FreeHTTPClient(Index: Integer);
|
procedure FreeHTTPClient(Index: Integer);
|
||||||
@ -66,11 +69,26 @@ begin;
|
|||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
function TMInternet.GetPage(URL: String): String;
|
||||||
|
var
|
||||||
|
Continue : boolean = true;
|
||||||
|
begin
|
||||||
|
Result := '';
|
||||||
|
if Assigned(OpenConnectionEvent) then
|
||||||
|
begin;
|
||||||
|
OpenConnectionEvent(Self,url,continue);
|
||||||
|
if not Continue then
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
Result := Internets.GetPage(url);
|
||||||
|
end;
|
||||||
|
|
||||||
{ TMInternet }
|
{ TMInternet }
|
||||||
|
|
||||||
function TMInternet.CreateHTTPClient(HandleCookies: boolean = true): integer;
|
function TMInternet.CreateHTTPClient(HandleCookies: boolean = true): integer;
|
||||||
begin;
|
begin;
|
||||||
Result := HTTPClients.Add(THTTPClient.Create(Client,HandleCookies));
|
Result := HTTPClients.Add(THTTPClient.Create(Client,HandleCookies));
|
||||||
|
THttpClient(HTTPClients[result]).OpenConnectionEvent:= OpenConnectionEvent;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function TMInternet.GetHTTPClient(Index: integer): THTTPClient;
|
function TMInternet.GetHTTPClient(Index: integer): THTTPClient;
|
||||||
@ -129,7 +147,16 @@ begin
|
|||||||
end;
|
end;
|
||||||
|
|
||||||
function THTTPClient.GetHTTPPage(url: string): string;
|
function THTTPClient.GetHTTPPage(url: string): string;
|
||||||
|
var
|
||||||
|
Continue : boolean = true;
|
||||||
begin
|
begin
|
||||||
|
Result := '';
|
||||||
|
if Assigned(OpenConnectionEvent) then
|
||||||
|
begin;
|
||||||
|
OpenConnectionEvent(Self,url,continue);
|
||||||
|
if not Continue then
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
if not fHandleCookies then
|
if not fHandleCookies then
|
||||||
HTTPSend.Cookies.Clear;
|
HTTPSend.Cookies.Clear;
|
||||||
HTTPSend.MimeType := 'text/html';
|
HTTPSend.MimeType := 'text/html';
|
||||||
@ -168,7 +195,15 @@ function THTTPClient.PostHTTPPage(Url: string): string;
|
|||||||
var
|
var
|
||||||
PostData : string;
|
PostData : string;
|
||||||
i : integer;
|
i : integer;
|
||||||
|
Continue : boolean = true;
|
||||||
begin
|
begin
|
||||||
|
Result := '';
|
||||||
|
if Assigned(OpenConnectionEvent) then
|
||||||
|
begin;
|
||||||
|
OpenConnectionEvent(Self,url,continue);
|
||||||
|
if not Continue then
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
PostData := '';
|
PostData := '';
|
||||||
for i := 0 to PostVariables.Count - 1 do
|
for i := 0 to PostVariables.Count - 1 do
|
||||||
PostData := PostData + PostVariables[i] +'&';
|
PostData := PostData + PostVariables[i] +'&';
|
||||||
|
@ -39,7 +39,7 @@ uses
|
|||||||
type
|
type
|
||||||
{ TMMLPSThread }
|
{ TMMLPSThread }
|
||||||
TSyncInfo = record
|
TSyncInfo = record
|
||||||
V : MufasaTypes.TVariantArray;
|
V : MufasaTypes.PVariantArray;
|
||||||
MethodName : string;
|
MethodName : string;
|
||||||
Res : Variant;
|
Res : Variant;
|
||||||
SyncMethod : procedure of object;
|
SyncMethod : procedure of object;
|
||||||
@ -76,6 +76,10 @@ type
|
|||||||
{ TMThread }
|
{ TMThread }
|
||||||
|
|
||||||
TMThread = class(TThread)
|
TMThread = class(TThread)
|
||||||
|
private
|
||||||
|
procedure SetOpenConnectionEvent(const AValue: TOpenConnectionEvent);
|
||||||
|
procedure SetOpenFileEvent(const AValue: TOpenFileEvent);
|
||||||
|
procedure SetWriteFileEvent(const AValue: TWriteFileEvent);
|
||||||
protected
|
protected
|
||||||
ScriptPath, AppPath, IncludePath, PluginPath, FontPath: string;
|
ScriptPath, AppPath, IncludePath, PluginPath, FontPath: string;
|
||||||
DebugTo: TWritelnProc;
|
DebugTo: TWritelnProc;
|
||||||
@ -84,6 +88,9 @@ type
|
|||||||
ExportedMethods : TExpMethodArr;
|
ExportedMethods : TExpMethodArr;
|
||||||
Includes : TStringList;
|
Includes : TStringList;
|
||||||
Prop: TScriptProperties;
|
Prop: TScriptProperties;
|
||||||
|
FOpenConnectionEvent : TOpenConnectionEvent;
|
||||||
|
FWriteFileEvent : TWriteFileEvent;
|
||||||
|
FOpenFileEvent : TOpenFileEvent;
|
||||||
procedure LoadPlugin(plugidx: integer); virtual; abstract;
|
procedure LoadPlugin(plugidx: integer); virtual; abstract;
|
||||||
|
|
||||||
public
|
public
|
||||||
@ -97,6 +104,7 @@ type
|
|||||||
OnError : TOnError; //Error handeler
|
OnError : TOnError; //Error handeler
|
||||||
|
|
||||||
CompileOnly : boolean;
|
CompileOnly : boolean;
|
||||||
|
|
||||||
procedure HandleError(ErrorRow,ErrorCol,ErrorPosition : integer; ErrorStr : string; ErrorType : TErrorType; ErrorModule : string);
|
procedure HandleError(ErrorRow,ErrorCol,ErrorPosition : integer; ErrorStr : string; ErrorType : TErrorType; ErrorModule : string);
|
||||||
function ProcessDirective(DirectiveName, DirectiveArgs: string): boolean;
|
function ProcessDirective(DirectiveName, DirectiveArgs: string): boolean;
|
||||||
function LoadFile(ParentFile : string; var filename, contents: string): boolean;
|
function LoadFile(ParentFile : string; var filename, contents: string): boolean;
|
||||||
@ -117,6 +125,10 @@ type
|
|||||||
destructor Destroy; override;
|
destructor Destroy; override;
|
||||||
|
|
||||||
class function GetExportedMethods : TExpMethodArr;
|
class function GetExportedMethods : TExpMethodArr;
|
||||||
|
|
||||||
|
property OpenConnectionEvent : TOpenConnectionEvent read FOpenConnectionEvent write SetOpenConnectionEvent;
|
||||||
|
property WriteFileEvent : TWriteFileEvent read FWriteFileEvent write SetWriteFileEvent;
|
||||||
|
property OpenFileEvent : TOpenFileEvent read FOpenFileEvent write SetOpenFileEvent;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
TPSThread = class(TMThread)
|
TPSThread = class(TMThread)
|
||||||
@ -190,6 +202,7 @@ uses
|
|||||||
IOmanager,//TTarget_Exported
|
IOmanager,//TTarget_Exported
|
||||||
IniFiles,//Silly INI files
|
IniFiles,//Silly INI files
|
||||||
stringutil, //String st00f
|
stringutil, //String st00f
|
||||||
|
|
||||||
uPSR_std, uPSR_controls,uPSR_classes,uPSR_graphics,uPSR_stdctrls,uPSR_forms,
|
uPSR_std, uPSR_controls,uPSR_classes,uPSR_graphics,uPSR_stdctrls,uPSR_forms,
|
||||||
uPSR_menus,
|
uPSR_menus,
|
||||||
files,
|
files,
|
||||||
@ -278,7 +291,13 @@ constructor TMThread.Create(CreateSuspended: boolean; TheSyncInfo: PSyncInfo; pl
|
|||||||
begin
|
begin
|
||||||
inherited Create(CreateSuspended);
|
inherited Create(CreateSuspended);
|
||||||
Client := TClient.Create(plugin_dir);
|
Client := TClient.Create(plugin_dir);
|
||||||
|
if Assigned(WriteFileEvent) then
|
||||||
|
Client.MFiles.WriteFileEvent := WriteFileEvent;
|
||||||
|
if Assigned(OpenFileEvent) then
|
||||||
|
Client.MFiles.OpenFileEvent := OpenFileEvent;
|
||||||
MInternet := TMInternet.Create(Client);
|
MInternet := TMInternet.Create(Client);
|
||||||
|
if Assigned(OpenConnectionEvent) then
|
||||||
|
MInternet.OpenConnectionEvent := Self.OpenConnectionEvent;
|
||||||
SyncInfo:= TheSyncInfo;
|
SyncInfo:= TheSyncInfo;
|
||||||
ExportedMethods:= GetExportedMethods;
|
ExportedMethods:= GetExportedMethods;
|
||||||
FreeOnTerminate := True;
|
FreeOnTerminate := True;
|
||||||
@ -303,6 +322,27 @@ begin
|
|||||||
inherited Destroy;
|
inherited Destroy;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
procedure TMThread.SetOpenConnectionEvent(const AValue: TOpenConnectionEvent);
|
||||||
|
begin
|
||||||
|
FOpenConnectionEvent:= AValue;
|
||||||
|
if Assigned(MInternet) then
|
||||||
|
self.MInternet.OpenConnectionEvent := AValue;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TMThread.SetOpenFileEvent(const AValue: TOpenFileEvent);
|
||||||
|
begin
|
||||||
|
FOpenFileEvent:= AValue;
|
||||||
|
if Assigned(Client) then
|
||||||
|
self.Client.MFiles.OpenFileEvent := AValue;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TMThread.SetWriteFileEvent(const AValue: TWriteFileEvent);
|
||||||
|
begin
|
||||||
|
FWriteFileEvent:= AValue;
|
||||||
|
if Assigned(Client) then
|
||||||
|
self.Client.MFiles.WriteFileEvent := AValue;;
|
||||||
|
end;
|
||||||
|
|
||||||
procedure TMThread.HandleError(ErrorRow,ErrorCol, ErrorPosition: integer; ErrorStr: string; ErrorType: TErrorType; ErrorModule : string);
|
procedure TMThread.HandleError(ErrorRow,ErrorCol, ErrorPosition: integer; ErrorStr: string; ErrorType: TErrorType; ErrorModule : string);
|
||||||
begin
|
begin
|
||||||
if OnError = nil then
|
if OnError = nil then
|
||||||
@ -423,7 +463,7 @@ end;
|
|||||||
function ThreadSafeCall(ProcName: string; var V: TVariantArray): Variant; extdecl;
|
function ThreadSafeCall(ProcName: string; var V: TVariantArray): Variant; extdecl;
|
||||||
begin
|
begin
|
||||||
CurrThread.SyncInfo^.MethodName:= ProcName;
|
CurrThread.SyncInfo^.MethodName:= ProcName;
|
||||||
CurrThread.SyncInfo^.V:= V;
|
CurrThread.SyncInfo^.V:= @V;
|
||||||
CurrThread.SyncInfo^.OldThread := CurrThread;
|
CurrThread.SyncInfo^.OldThread := CurrThread;
|
||||||
CurrThread.Synchronize(CurrThread.SyncInfo^.SyncMethod);
|
CurrThread.Synchronize(CurrThread.SyncInfo^.SyncMethod);
|
||||||
Result := CurrThread.SyncInfo^.Res;
|
Result := CurrThread.SyncInfo^.Res;
|
||||||
|
@ -39,20 +39,21 @@ TClient is a full-blown instance of the MML.
|
|||||||
It binds all the components together.
|
It binds all the components together.
|
||||||
}
|
}
|
||||||
|
|
||||||
type
|
type
|
||||||
TClient = class(TObject)
|
|
||||||
public
|
TClient = class(TObject)
|
||||||
IOManager: TIOManager;
|
public
|
||||||
MFiles: TMFiles;
|
IOManager: TIOManager;
|
||||||
MFinder: TMFinder;
|
MFiles: TMFiles;
|
||||||
MBitmaps : TMBitmaps;
|
MFinder: TMFinder;
|
||||||
MDTM: TMDTM;
|
MBitmaps : TMBitmaps;
|
||||||
MOCR: TMOCR;
|
MDTM: TMDTM;
|
||||||
WritelnProc : TWritelnProc;
|
MOCR: TMOCR;
|
||||||
procedure WriteLn(s : string);
|
WritelnProc : TWritelnProc;
|
||||||
constructor Create(plugin_dir: string);
|
procedure WriteLn(s : string);
|
||||||
destructor Destroy; override;
|
constructor Create(plugin_dir: string);
|
||||||
end;
|
destructor Destroy; override;
|
||||||
|
end;
|
||||||
|
|
||||||
implementation
|
implementation
|
||||||
|
|
||||||
|
@ -29,44 +29,43 @@ interface
|
|||||||
|
|
||||||
uses
|
uses
|
||||||
Classes, SysUtils, MufasaTypes;
|
Classes, SysUtils, MufasaTypes;
|
||||||
|
const
|
||||||
|
File_AccesError = -1;
|
||||||
|
File_EventError = -2;
|
||||||
|
|
||||||
type
|
type
|
||||||
TMufasaFile = record
|
|
||||||
Path: String;
|
|
||||||
FS: TFileStream;
|
|
||||||
BytesRead, Mode: Integer;
|
|
||||||
end;
|
|
||||||
|
|
||||||
TMufasaFilesArray = Array Of TMufasaFile;
|
{ TMFiles }
|
||||||
|
|
||||||
TMFiles = class(TObject)
|
TMFiles = class(TObject)
|
||||||
constructor Create(Owner : TObject);
|
public
|
||||||
destructor Destroy; override;
|
OpenFileEvent : TOpenFileEvent;
|
||||||
public
|
WriteFileEvent: TWriteFileEvent;
|
||||||
function CreateFile(const Path: string): Integer;
|
function CreateFile(Path: string): Integer;
|
||||||
function OpenFile(const Path: string; Shared: Boolean): Integer;
|
function OpenFile(Path: string; Shared: Boolean): Integer;
|
||||||
function RewriteFile(const Path: string; Shared: Boolean): Integer;
|
function RewriteFile(Path: string; Shared: Boolean): Integer;
|
||||||
procedure CloseFile(FileNum: Integer);
|
procedure CloseFile(FileNum: Integer);
|
||||||
function EndOfFile(FileNum: Integer): Boolean;
|
function EndOfFile(FileNum: Integer): Boolean;
|
||||||
function FileSizeMuf(FileNum: Integer): LongInt;
|
function FileSizeMuf(FileNum: Integer): LongInt;
|
||||||
function ReadFileString(FileNum: Integer; out s: string; x: Integer): Boolean;
|
function ReadFileString(FileNum: Integer; out s: string; x: Integer): Boolean;
|
||||||
function WriteFileString(FileNum: Integer;const s: string): Boolean;
|
function WriteFileString(FileNum: Integer;const s: string): Boolean;
|
||||||
Function SetFileCharPointer(FileNum, cChars, Origin: Integer): Integer;
|
function SetFileCharPointer(FileNum, cChars, Origin: Integer): Integer;
|
||||||
function FilePointerPos(FileNum: Integer): Integer;
|
function FilePointerPos(FileNum: Integer): Integer;
|
||||||
protected
|
constructor Create(Owner : TObject);
|
||||||
MFiles: TMufasaFilesArray;
|
destructor Destroy; override;
|
||||||
FreeSpots: Array Of Integer;
|
private
|
||||||
Client : TObject;
|
MFiles: TMufasaFilesArray;
|
||||||
private
|
FreeSpots: Array Of Integer;
|
||||||
procedure FreeFileList;
|
Client : TObject;
|
||||||
function AddFileToManagedList(Path: string; FS: TFileStream; Mode: Integer): Integer;
|
procedure CheckFileNum(FileNum : integer);
|
||||||
|
procedure FreeFileList;
|
||||||
end;
|
function AddFileToManagedList(Path: string; FS: TFileStream; Mode: Integer): Integer;
|
||||||
|
end;
|
||||||
|
|
||||||
// We don't need one per object. :-)
|
// We don't need one per object. :-)
|
||||||
function GetFiles(Path, Ext: string): TStringArray;
|
function GetFiles(Path, Ext: string): TStringArray;
|
||||||
function GetDirectories(Path: string): TstringArray;
|
function GetDirectories(Path: string): TstringArray;
|
||||||
function FindFile(filename : string; Dirs : array of string) : string; //Results '' if not found
|
function FindFile(filename : string; Dirs : array of string) : string; //Results '' if not found
|
||||||
|
|
||||||
implementation
|
implementation
|
||||||
uses
|
uses
|
||||||
@ -85,7 +84,7 @@ begin
|
|||||||
repeat
|
repeat
|
||||||
inc(c);
|
inc(c);
|
||||||
SetLength(Result,c);
|
SetLength(Result,c);
|
||||||
Result[c-1] := SearchRec.Name;
|
Result[c-1] := SearchRec.Name;
|
||||||
until FindNext(SearchRec) <> 0;
|
until FindNext(SearchRec) <> 0;
|
||||||
SysUtils.FindClose(SearchRec);
|
SysUtils.FindClose(SearchRec);
|
||||||
end;
|
end;
|
||||||
@ -141,15 +140,15 @@ var
|
|||||||
I : integer;
|
I : integer;
|
||||||
begin;
|
begin;
|
||||||
For I := 0 To High(MFiles) Do
|
For I := 0 To High(MFiles) Do
|
||||||
If MFiles[i].FS <> nil Then
|
if MFiles[i].FS <> nil then
|
||||||
Begin
|
begin
|
||||||
TClient(Client).Writeln(Format('File[%s] has not been freed in the script, freeing it now.',[MFiles[i].Path]));
|
TClient(Client).Writeln(Format('File[%s] has not been freed in the script, freeing it now.',[MFiles[i].Path]));
|
||||||
Try
|
try
|
||||||
MFiles[I].FS.Free;
|
MFiles[I].FS.Free;
|
||||||
Except
|
except
|
||||||
TClient(Client).Writeln('FreeFileList - Exception when freeing FileStream');
|
TClient(Client).Writeln('FreeFileList - Exception when freeing FileStream');
|
||||||
End;
|
end;
|
||||||
End;
|
end;
|
||||||
SetLength(MFiles, 0);
|
SetLength(MFiles, 0);
|
||||||
SetLength(FreeSpots, 0);
|
SetLength(FreeSpots, 0);
|
||||||
end;
|
end;
|
||||||
@ -160,197 +159,165 @@ begin
|
|||||||
inherited;
|
inherited;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
Function TMFiles.AddFileToManagedList(Path: String; FS: TFileStream; Mode: Integer): Integer;
|
procedure TMFiles.CheckFileNum(FileNum: integer);
|
||||||
Var
|
begin
|
||||||
tFile: TMufasaFile;
|
if(FileNum < 0) or (FileNum >= Length(MFiles)) then
|
||||||
Begin
|
|
||||||
tFile.Path := Path;
|
|
||||||
tFile.FS := FS;
|
|
||||||
tFile.Mode := Mode;
|
|
||||||
tFile.BytesRead := 0;
|
|
||||||
|
|
||||||
If Length(FreeSpots) > 0 Then
|
|
||||||
Begin
|
|
||||||
//WriteLn('There is a free spot: ' + IntToStr(FreeSpots[High(FreeSpots)]));
|
|
||||||
MFiles[FreeSpots[High(FreeSpots)]] := tFile;
|
|
||||||
Result := FreeSpots[High(FreeSpots)];
|
|
||||||
SetLength(FreeSpots, High(FreeSpots));
|
|
||||||
End Else
|
|
||||||
Begin
|
|
||||||
// Increase by * 2.
|
|
||||||
//WriteLn('No Free Spot. Increasing the size');
|
|
||||||
SetLength(MFiles, Length(MFiles) + 1);
|
|
||||||
//Writeln('Length of Files: ' + IntToStr(Length(Files)));
|
|
||||||
MFiles[High(MFiles)] := tFile;
|
|
||||||
Result := High(MFiles);
|
|
||||||
End;
|
|
||||||
End;
|
|
||||||
|
|
||||||
Function TMFiles.SetFileCharPointer(FileNum, cChars, Origin: Integer): Integer;
|
|
||||||
Begin
|
|
||||||
If(FileNum < 0) or (FileNum >= Length(MFiles)) Then
|
|
||||||
raise Exception.CreateFmt('Invalid FileNum passed: %d',[FileNum]);
|
raise Exception.CreateFmt('Invalid FileNum passed: %d',[FileNum]);
|
||||||
|
end;
|
||||||
|
|
||||||
{If Files[FileNum].Handle = -1 Then
|
function TMFiles.AddFileToManagedList(Path: String; FS: TFileStream; Mode: Integer): Integer;
|
||||||
Begin
|
var
|
||||||
WriteLn('SetFileCharPointer: Invalid Internal Handle');
|
tFile: TMufasaFile;
|
||||||
Result := -1;
|
begin
|
||||||
Exit;
|
tFile.Path := Path;
|
||||||
End;}
|
tFile.FS := FS;
|
||||||
|
tFile.Mode := Mode;
|
||||||
|
tFile.BytesRead := 0;
|
||||||
|
if Length(FreeSpots) > 0 then
|
||||||
|
begin
|
||||||
|
MFiles[FreeSpots[High(FreeSpots)]] := tFile;
|
||||||
|
Result := FreeSpots[High(FreeSpots)];
|
||||||
|
SetLength(FreeSpots, High(FreeSpots));
|
||||||
|
end else
|
||||||
|
begin
|
||||||
|
SetLength(MFiles, Length(MFiles) + 1);
|
||||||
|
MFiles[High(MFiles)] := tFile;
|
||||||
|
Result := High(MFiles);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TMFiles.SetFileCharPointer(FileNum, cChars, Origin: Integer): Integer;
|
||||||
|
begin
|
||||||
|
CheckFileNum(FileNum);
|
||||||
case Origin of
|
case Origin of
|
||||||
fsFromBeginning:
|
fsFromBeginning:
|
||||||
If(cChars < 0) Then
|
if(cChars < 0) then
|
||||||
raise Exception.CreateFmt('fsFromBeginning takes no negative cChars. (%d)',[cChars]);
|
raise Exception.CreateFmt('fsFromBeginning takes no negative cChars. (%d)',[cChars]);
|
||||||
fsFromCurrent:
|
fsFromCurrent:
|
||||||
;
|
;
|
||||||
fsFromEnd:
|
fsFromEnd:
|
||||||
If(cChars > 0) Then
|
if(cChars > 0) then
|
||||||
raise Exception.CreateFmt('fsFromEnd takes no positive cChars. (%d)',[cChars]);
|
raise Exception.CreateFmt('fsFromEnd takes no positive cChars. (%d)',[cChars]);
|
||||||
else
|
else
|
||||||
raise Exception.CreateFmt('Invalid Origin: %d',[Origin]);
|
raise Exception.CreateFmt('Invalid Origin: %d',[Origin]);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
Try
|
try
|
||||||
Result := MFiles[FileNum].FS.Seek(cChars, Origin);
|
Result := MFiles[FileNum].FS.Seek(cChars, Origin);
|
||||||
Except
|
except
|
||||||
TClient(Client).Writeln('SetFileCharPointer - Exception Occured.');
|
TClient(Client).Writeln('SetFileCharPointer - Exception Occured.');
|
||||||
Result := -1;
|
Result := File_AccesError;
|
||||||
End;
|
end;
|
||||||
//Result := FileSeek(Files[FileNum].Handle, cChars, Origin);
|
//Result := FileSeek(Files[FileNum].Handle, cChars, Origin);
|
||||||
End;
|
end;
|
||||||
|
|
||||||
{/\
|
{/\
|
||||||
Creates a file for reading/writing.
|
Creates a file for reading/writing.
|
||||||
Returns the handle (index) to the File Array.
|
Returns the handle (index) to the File Array.
|
||||||
Returns -1 if unsuccesfull.
|
Returns File_AccesError if unsuccesfull.
|
||||||
/\}
|
/\}
|
||||||
|
|
||||||
function TMFiles.CreateFile(const Path: string): Integer;
|
function TMFiles.CreateFile(Path: string): Integer;
|
||||||
|
var
|
||||||
Var
|
FS: TFileStream;
|
||||||
FS: TFileStream;
|
Continue : Boolean;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
Try
|
if Assigned(WriteFileEvent) then
|
||||||
|
begin;
|
||||||
|
Continue := true;
|
||||||
|
WriteFileEvent(Self,path,continue);
|
||||||
|
if not Continue then
|
||||||
|
exit(File_EventError);
|
||||||
|
end;
|
||||||
|
try
|
||||||
FS := TFileStream.Create(Path, fmCreate);
|
FS := TFileStream.Create(Path, fmCreate);
|
||||||
Except
|
Result := AddFileToManagedList(Path, FS, fmCreate);
|
||||||
Result := -1;
|
except
|
||||||
|
Result := File_AccesError;
|
||||||
TClient(Client).Writeln(Format('CreateFile - Exception. Could not create file: %s',[path]));
|
TClient(Client).Writeln(Format('CreateFile - Exception. Could not create file: %s',[path]));
|
||||||
Exit;
|
end;
|
||||||
End;
|
|
||||||
|
|
||||||
Result := AddFileToManagedList(Path, FS, fmCreate);
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
{/\
|
{/\
|
||||||
Opens a file for reading.
|
Opens a file for reading.
|
||||||
Returns the handle (index) to the File Array.
|
Returns the handle (index) to the File Array.
|
||||||
Returns -1 if unsuccesfull.
|
Returns File_AccesError if unsuccesfull.
|
||||||
/\}
|
/\}
|
||||||
|
|
||||||
function TMFiles.OpenFile(const Path: string; Shared: Boolean): Integer;
|
function TMFiles.OpenFile(Path: string; Shared: Boolean): Integer;
|
||||||
|
var
|
||||||
Var
|
FS: TFileStream;
|
||||||
FS: TFileStream;
|
fMode: Integer;
|
||||||
fMode: Integer;
|
Continue : Boolean;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
If Shared Then
|
if Assigned(OpenFileEvent) then
|
||||||
|
begin;
|
||||||
|
Continue := true;
|
||||||
|
OpenFileEvent(Self,path,continue);
|
||||||
|
if not Continue then
|
||||||
|
exit(File_EventError);
|
||||||
|
end;
|
||||||
|
if Shared then
|
||||||
fMode := fmOpenRead or fmShareDenyNone
|
fMode := fmOpenRead or fmShareDenyNone
|
||||||
Else
|
else
|
||||||
fMode := fmOpenRead or fmShareExclusive;
|
fMode := fmOpenRead or fmShareExclusive;
|
||||||
|
try
|
||||||
Try
|
|
||||||
FS := TFileStream.Create(Path, fMode)
|
FS := TFileStream.Create(Path, fMode)
|
||||||
Except
|
except
|
||||||
Result := -1;
|
Result := File_AccesError;
|
||||||
TClient(Client).Writeln(Format('OpenFile - Exception. Could not open file: %s',[path]));
|
TClient(Client).Writeln(Format('OpenFile - Exception. Could not open file: %s',[path]));
|
||||||
Exit;
|
Exit;
|
||||||
End;
|
end;
|
||||||
|
|
||||||
Result := AddFileToManagedList(Path, FS, fMode);
|
Result := AddFileToManagedList(Path, FS, fMode);
|
||||||
|
|
||||||
{Result := FileOpen(Path, fmOpenRead);
|
|
||||||
If Result <> -1 Then
|
|
||||||
Begin
|
|
||||||
//WriteLn('File was successfully opened');
|
|
||||||
Result := AddFileToManagedList(Path, Result, fmOpenRead);
|
|
||||||
{If Result <> -1 Then
|
|
||||||
WriteLn('File was successfully added: ' + IntToStr(Result));}
|
|
||||||
End Else
|
|
||||||
Begin
|
|
||||||
WriteLn('Could not open file. Returning -1');
|
|
||||||
End; }
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
{/\
|
{/\
|
||||||
Opens a file for writing.
|
Opens a file for writing. And deletes the contents.
|
||||||
Returns the handle (index) to the File Array.
|
Returns the handle (index) to the File Array.
|
||||||
Returns -1 if unsuccesfull.
|
Returns File_AccesError if unsuccesfull.
|
||||||
/\}
|
/\}
|
||||||
|
|
||||||
function TMFiles.RewriteFile(const Path: string; Shared: Boolean): Integer;
|
function TMFiles.RewriteFile(Path: string; Shared: Boolean): Integer;
|
||||||
|
var
|
||||||
Var
|
FS: TFileStream;
|
||||||
FS: TFileStream;
|
fMode: Integer;
|
||||||
fMode: Integer;
|
Continue : Boolean;
|
||||||
begin
|
begin
|
||||||
If Shared Then
|
if Assigned(WriteFileEvent) then
|
||||||
|
begin;
|
||||||
|
Continue := true;
|
||||||
|
WriteFileEvent(Self,path,continue);
|
||||||
|
if not Continue then
|
||||||
|
exit(File_EventError);
|
||||||
|
end;
|
||||||
|
if Shared then
|
||||||
fMode := fmOpenReadWrite or fmShareDenyNone or fmCreate
|
fMode := fmOpenReadWrite or fmShareDenyNone or fmCreate
|
||||||
Else
|
else
|
||||||
fMode := fmOpenReadWrite or fmShareDenyWrite or fmShareDenyRead or fmCreate;
|
fMode := fmOpenReadWrite or fmShareDenyWrite or fmShareDenyRead or fmCreate;
|
||||||
|
try
|
||||||
Try
|
|
||||||
FS := TFileStream.Create(Path, fMode);
|
FS := TFileStream.Create(Path, fMode);
|
||||||
Except
|
FS.Size:=0;
|
||||||
Result := -1;
|
Result := AddFileToManagedList(Path, FS, fMode);
|
||||||
|
except
|
||||||
|
Result := File_AccesError;
|
||||||
TClient(Client).Writeln(Format('ReWriteFile - Exception. Could not create file: %s',[path]));
|
TClient(Client).Writeln(Format('ReWriteFile - Exception. Could not create file: %s',[path]));
|
||||||
Exit;
|
end;
|
||||||
End;
|
|
||||||
|
|
||||||
Result := AddFileToManagedList(Path, FS, fMode);
|
|
||||||
|
|
||||||
{Result := FileOpen(Path, fmOpenReadWrite);
|
|
||||||
If Result <> -1 Then
|
|
||||||
Begin
|
|
||||||
//WriteLn('File was successfully opened.');
|
|
||||||
Result := AddFileToManagedList(Path, Result, fmOpenReadWrite);
|
|
||||||
{If Result <> -1 Then
|
|
||||||
WriteLn('File was successfully added: ' + IntToStr(Result)); }
|
|
||||||
End Else
|
|
||||||
Begin
|
|
||||||
WriteLn('Could not open file. Returning -1');
|
|
||||||
End; }
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
{/\
|
{/\
|
||||||
Free's the given File at the given index.
|
Free's the given File at the given index.
|
||||||
/\}
|
/\}
|
||||||
procedure TMFiles.CloseFile(FileNum: Integer);
|
procedure TMFiles.CloseFile(FileNum: Integer);
|
||||||
|
|
||||||
begin
|
begin
|
||||||
If (FileNum >= Length(MFiles)) or (FileNum < 0) Then
|
CheckFileNum(filenum);
|
||||||
raise Exception.CreateFmt('Invalid FileNum passed: %d',[FileNum]);
|
try
|
||||||
|
MFiles[FileNum].FS.Free;
|
||||||
Try
|
MFiles[FileNum].FS := nil;
|
||||||
MFiles[FileNum].FS.Free;
|
SetLength(FreeSpots, Length(FreeSpots) + 1);
|
||||||
Except
|
FreeSpots[High(FreeSpots)] := FileNum;
|
||||||
|
except
|
||||||
TClient(Client).Writeln(Format('CloseFile, exception when freeing the file: %d',[filenum]));
|
TClient(Client).Writeln(Format('CloseFile, exception when freeing the file: %d',[filenum]));
|
||||||
Exit;
|
end;
|
||||||
End;
|
|
||||||
|
|
||||||
MFiles[FileNum].FS := nil;
|
|
||||||
SetLength(FreeSpots, Length(FreeSpots) + 1);
|
|
||||||
FreeSpots[High(FreeSpots)] := FileNum;
|
|
||||||
|
|
||||||
{If Files[FileNum].Handle = -1 Then
|
|
||||||
Begin
|
|
||||||
WriteLn('CloseFile: Invalid Internal Handle');
|
|
||||||
Exit;
|
|
||||||
End;
|
|
||||||
FileClose(Files[FileNum].Handle); }
|
|
||||||
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
{/\
|
{/\
|
||||||
@ -360,15 +327,13 @@ end;
|
|||||||
|
|
||||||
function TMFiles.EndOfFile(FileNum: Integer): Boolean;
|
function TMFiles.EndOfFile(FileNum: Integer): Boolean;
|
||||||
begin
|
begin
|
||||||
If(FileNum < 0) or (FileNum >= Length(MFiles)) Then
|
CheckFileNum(filenum);
|
||||||
raise Exception.CreateFmt('Invalid FileNum passed: %d',[FileNum]);
|
if MFiles[FileNum].FS = nil then
|
||||||
If MFiles[FileNum].FS = nil Then
|
begin
|
||||||
Begin
|
|
||||||
TClient(Client).Writeln(format('EndOfFile: Invalid Internal Handle of File: %d',[filenum]));
|
TClient(Client).Writeln(format('EndOfFile: Invalid Internal Handle of File: %d',[filenum]));
|
||||||
Result := True;
|
Result := True;
|
||||||
Exit;
|
Exit;
|
||||||
End;
|
end;
|
||||||
|
|
||||||
Result := FilePointerPos(FileNum) >= FileSizeMuf(FileNum);
|
Result := FilePointerPos(FileNum) >= FileSizeMuf(FileNum);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
@ -378,52 +343,31 @@ end;
|
|||||||
|
|
||||||
function TMFiles.FileSizeMuf(FileNum: Integer): LongInt;
|
function TMFiles.FileSizeMuf(FileNum: Integer): LongInt;
|
||||||
begin
|
begin
|
||||||
If(FileNum < 0) or (FileNum >= Length(MFiles)) Then
|
CheckFileNum(filenum);
|
||||||
raise Exception.CreateFmt('Invalid FileNum passed: %d',[FileNum]);
|
if MFiles[FileNum].FS = nil then
|
||||||
|
begin
|
||||||
If MFiles[FileNum].FS = nil Then
|
|
||||||
Begin
|
|
||||||
TClient(Client).Writeln(format('FileSize: Invalid Internal Handle of File: %d',[filenum]));
|
TClient(Client).Writeln(format('FileSize: Invalid Internal Handle of File: %d',[filenum]));
|
||||||
Result := -1;
|
Result := File_AccesError;
|
||||||
Exit;
|
Exit;
|
||||||
End;
|
end;
|
||||||
|
|
||||||
Result := MFiles[FileNum].FS.Size;
|
Result := MFiles[FileNum].FS.Size;
|
||||||
|
|
||||||
{
|
|
||||||
If Files[FileNum].Handle = -1 Then
|
|
||||||
Begin
|
|
||||||
WriteLn('FileSize: Invalid Internal Handle');
|
|
||||||
Result := -1;
|
|
||||||
Exit;
|
|
||||||
End;
|
|
||||||
// Get our current position.
|
|
||||||
tempPos := FileSeek(Files[FileNum].Handle, 0, fsFromCurrent);
|
|
||||||
|
|
||||||
// End of the file.
|
|
||||||
Result := FileSeek(Files[FileNum].Handle, 0, fsFromEnd);
|
|
||||||
|
|
||||||
// Reset the position.
|
|
||||||
FileSeek(Files[FileNum].Handle, tempPos, fsFromBeginning); }
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function TMFiles.FilePointerPos(FileNum: Integer): Integer;
|
function TMFiles.FilePointerPos(FileNum: Integer): Integer;
|
||||||
begin
|
begin
|
||||||
If(FileNum < 0) or (FileNum >= Length(MFiles)) Then
|
CheckFileNum(filenum);
|
||||||
raise Exception.CreateFmt('Invalid FileNum passed: %d',[FileNum]);
|
if MFiles[FileNum].FS = nil then
|
||||||
If MFiles[FileNum].FS = nil Then
|
begin
|
||||||
Begin
|
|
||||||
TClient(Client).Writeln(format('FilePointerPos: Invalid Internal Handle of File: %d',[filenum]));
|
TClient(Client).Writeln(format('FilePointerPos: Invalid Internal Handle of File: %d',[filenum]));
|
||||||
Result := -1;
|
Result := File_AccesError;
|
||||||
Exit;
|
Exit;
|
||||||
End;
|
end;
|
||||||
|
|
||||||
try
|
try
|
||||||
Result := MFiles[FileNum].FS.Seek(0, fsFromCurrent);
|
Result := MFiles[FileNum].FS.Seek(0, fsFromCurrent);
|
||||||
Except
|
except
|
||||||
TClient(Client).Writeln('Exception in FilePointerPos');
|
TClient(Client).Writeln('Exception in FilePointerPos');
|
||||||
End;
|
end;
|
||||||
//Result := FileSeek(Files[FileNum].FS, 0, fsFromCurrent);
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
{/\
|
{/\
|
||||||
@ -431,17 +375,14 @@ end;
|
|||||||
/\}
|
/\}
|
||||||
|
|
||||||
function TMFiles.ReadFileString(FileNum: Integer; out s: string; x: Integer): Boolean;
|
function TMFiles.ReadFileString(FileNum: Integer; out s: string; x: Integer): Boolean;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
If(FileNum < 0) or (FileNum >= Length(MFiles)) Then
|
CheckFileNum(filenum);
|
||||||
raise Exception.CreateFmt('Invalid FileNum passed: %d',[FileNum]);
|
if MFiles[FileNum].FS = nil then
|
||||||
If MFiles[FileNum].FS = nil Then
|
begin
|
||||||
Begin
|
|
||||||
TClient(Client).Writeln(format('ReadFileString: Invalid Internal Handle of File: %d',[filenum]));
|
TClient(Client).Writeln(format('ReadFileString: Invalid Internal Handle of File: %d',[filenum]));
|
||||||
Exit;
|
Exit;
|
||||||
End;
|
end;
|
||||||
|
|
||||||
SetLength(S, 0);
|
|
||||||
SetLength(S, X);
|
SetLength(S, X);
|
||||||
MFiles[FileNum].FS.Read(S[1], x);
|
MFiles[FileNum].FS.Read(S[1], x);
|
||||||
|
|
||||||
@ -456,32 +397,21 @@ end;
|
|||||||
|
|
||||||
function TMFiles.WriteFileString(FileNum: Integer;const s: string): Boolean;
|
function TMFiles.WriteFileString(FileNum: Integer;const s: string): Boolean;
|
||||||
begin
|
begin
|
||||||
If(FileNum < 0) or (FileNum >= Length(MFiles)) Then
|
result := false;
|
||||||
raise Exception.CreateFmt('Invalid FileNum passed: %d',[FileNum]);
|
CheckFileNum(filenum);
|
||||||
If(MFiles[FileNum].FS = nil) Then
|
if(MFiles[FileNum].FS = nil) then
|
||||||
Begin
|
begin
|
||||||
TClient(Client).Writeln(format('WriteFileString: Invalid Internal Handle of File: %d',[filenum]));
|
TClient(Client).Writeln(format('WriteFileString: Invalid Internal Handle of File: %d',[filenum]));
|
||||||
Result := False;
|
|
||||||
Exit;
|
Exit;
|
||||||
End;
|
end;
|
||||||
|
if (MFiles[FileNum].Mode and (fmOpenWrite or fmOpenReadWrite)) = 0 then //Checks if we have write rights..
|
||||||
{If((Files[FileNum].Mode and fmOpenWrite) = 0) Then
|
exit;
|
||||||
Begin
|
|
||||||
WriteLn('This file may not write');
|
|
||||||
Exit;
|
|
||||||
End; }
|
|
||||||
|
|
||||||
try
|
try
|
||||||
Result := MFiles[FileNum].FS.Write(S[1], Length(S)) <> 1;
|
Result := MFiles[FileNum].FS.Write(S[1], Length(S)) <> 1;
|
||||||
except
|
except
|
||||||
TClient(Client).Writeln('Exception - WriteFileString.');
|
TClient(Client).Writeln('Exception - WriteFileString.');
|
||||||
Result := False;
|
Result := False;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
{If(FileWrite(Files[FileNum].Handle, S[1], Length(S)) <> -1) Then
|
|
||||||
Result := True
|
|
||||||
Else
|
|
||||||
Result := False; }
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
end.
|
end.
|
||||||
|
@ -70,6 +70,7 @@ type
|
|||||||
TPointArray = array of TPoint;
|
TPointArray = array of TPoint;
|
||||||
T2DPointArray = array of TPointArray;
|
T2DPointArray = array of TPointArray;
|
||||||
TVariantArray = Array of Variant;
|
TVariantArray = Array of Variant;
|
||||||
|
PVariantArray = ^TVariantArray;
|
||||||
TIntegerArray = Array of Integer;
|
TIntegerArray = Array of Integer;
|
||||||
T2DIntArray = array of TIntegerArray;
|
T2DIntArray = array of TIntegerArray;
|
||||||
T2DIntegerArray = T2DIntArray;
|
T2DIntegerArray = T2DIntArray;
|
||||||
@ -83,6 +84,14 @@ type
|
|||||||
WhiteHi,BlackHi : integer;
|
WhiteHi,BlackHi : integer;
|
||||||
W,H : integer;
|
W,H : integer;
|
||||||
end;
|
end;
|
||||||
|
{ File types }
|
||||||
|
|
||||||
|
TMufasaFile = record
|
||||||
|
Path: String;
|
||||||
|
FS: TFileStream;
|
||||||
|
BytesRead, Mode: Integer;
|
||||||
|
end;
|
||||||
|
TMufasaFilesArray = Array Of TMufasaFile;
|
||||||
|
|
||||||
{ DTM Types }
|
{ DTM Types }
|
||||||
{
|
{
|
||||||
@ -123,6 +132,34 @@ type
|
|||||||
end;
|
end;
|
||||||
|
|
||||||
TWritelnProc = procedure(s: string);
|
TWritelnProc = procedure(s: string);
|
||||||
|
{events}
|
||||||
|
TOpenFileEvent = procedure(Sender : TObject;var Filename : string; var Continue : boolean) of object;
|
||||||
|
TWriteFileEvent = TOpenFileEvent;
|
||||||
|
TOpenConnectionEvent = procedure(Sender : TObject; var url : string; var Continue : boolean) of object;
|
||||||
|
TColourPickEvent = procedure(Sender : TObject; const Colour,colourx,coloury : integer) of object;
|
||||||
|
TScriptStartEvent = procedure(Sender: TObject; var Script : string; var Continue : boolean) of object;
|
||||||
|
TScriptCompileEvent = procedure(Sender: TObject; var Script : string; var Continue : boolean);
|
||||||
|
TScriptExecuteEvent = procedure(Sender : TObject; const Script : string; var Continue : boolean);
|
||||||
|
TScriptPauseEvent = TScriptExecuteEvent;
|
||||||
|
TScriptStopEvent = TScriptExecuteEvent;
|
||||||
|
TOpenConnectionData = record
|
||||||
|
Sender : TObject;
|
||||||
|
URL : PString;
|
||||||
|
Continue : PBoolean;
|
||||||
|
end;
|
||||||
|
TOpenFileData = record
|
||||||
|
Sender : TObject;
|
||||||
|
FileName : PString;
|
||||||
|
Continue : PBoolean;
|
||||||
|
end;
|
||||||
|
TWriteFileData = TOpenFileData;
|
||||||
|
TScriptStartData = record
|
||||||
|
Sender : TObject;
|
||||||
|
Script : PString;
|
||||||
|
Continue : PBoolean;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
type
|
type
|
||||||
VirtualKeyInfo = record
|
VirtualKeyInfo = record
|
||||||
Str : string;
|
Str : string;
|
||||||
|
@ -583,13 +583,17 @@ begin;
|
|||||||
exit;
|
exit;
|
||||||
if beginpos.x > length(strings[beginpos.y]) then
|
if beginpos.x > length(strings[beginpos.y]) then
|
||||||
exit;
|
exit;
|
||||||
if endpos.x > length(strings[endpos.y]) then
|
if endpos.x > (length(strings[endpos.y])+1) then
|
||||||
exit;
|
exit;
|
||||||
|
if EndPos.y = beginpos.y then
|
||||||
|
begin
|
||||||
|
result := copy(strings[beginpos.y],beginpos.x, endpos.x - beginpos.x + 1);
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
result := copy(strings[beginpos.y],beginpos.x, length(strings[beginpos.y]) - beginpos.x + 1);
|
result := copy(strings[beginpos.y],beginpos.x, length(strings[beginpos.y]) - beginpos.x + 1);
|
||||||
for i := beginpos.y + 1 to endpos.y-1 do
|
for i := beginpos.y + 1 to endpos.y-1 do
|
||||||
result := result + strings[i];
|
result := result + strings[i];
|
||||||
if endpos.y <> beginpos.y then
|
result := result + copy(strings[endpos.y],0,endpos.x-1); //Position <> count!
|
||||||
result := result + copy(strings[endpos.y],0,endpos.x);
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function TParamHint.PrepareParamString(out Str: string; out MustHide : boolean): Integer;
|
function TParamHint.PrepareParamString(out Str: string; out MustHide : boolean): Integer;
|
||||||
@ -606,7 +610,7 @@ begin
|
|||||||
MustHide := True;
|
MustHide := True;
|
||||||
Parser := TmwPasLex.Create; //The position of the bracket
|
Parser := TmwPasLex.Create; //The position of the bracket
|
||||||
parser.Origin:= PChar(StringListPartToText(Point(FBracketPoint.x,FBracketPoint.y-1),
|
parser.Origin:= PChar(StringListPartToText(Point(FBracketPoint.x,FBracketPoint.y-1),
|
||||||
point(min(FSynEdit.CaretX,length(FSynEdit.Lines[FSynEdit.CaretY - 1])),FSynEdit.CaretY-1),
|
point(min(FSynEdit.CaretX,length(FSynEdit.Lines[FSynEdit.CaretY - 1])+1),FSynEdit.CaretY-1),
|
||||||
FSynEdit.lines));
|
FSynEdit.lines));
|
||||||
bracketcount := 0;
|
bracketcount := 0;
|
||||||
ParameterIndex := -1;
|
ParameterIndex := -1;
|
||||||
|
Loading…
Reference in New Issue
Block a user