moparisthebest/Simba
1
0
Fork 0
mirror of https://github.com/moparisthebest/Simba synced 2025-01-30 14:50:18 -05:00
Code Issues Releases Wiki Activity

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.

Browse Source
This commit is contained in:
Raymond 2010-04-07 14:01:26 +02:00
parent f5f100e75e
commit 0d5f9b7b89
16 changed files with 551 additions and 309 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
Extensions/test3.sex
View File

@ -4,7 +4,39 @@ procedure init;
begin;
Writeln('init your extension here');
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;
begin
Writeln('Free your extension here');

8
Projects/SAMufasaGUI/extensionmanager.pas
View File

@ -5,7 +5,7 @@ unit extensionmanager;
interface
uses
Classes, SysUtils,virtualextension,psextension,mufasabase;
Classes, SysUtils,virtualextension,psextension,mufasabase,mufasatypes;
type
TExtension = TVirtualSimbaExtension;
@ -30,7 +30,7 @@ type
function GetExtensionIndex(Filename : string) : integer;
function LoadPSExtension(Filename : string; enabled : boolean=false) : 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;
var
@ -38,7 +38,7 @@ var
implementation
uses
TestUnit, settingssandbox,simbasettings,MufasaTypes;
TestUnit, settingssandbox,simbasettings;
procedure TExtensionManager.SetOnchange(const AValue: TNotifyEvent);
var
@ -139,7 +139,7 @@ begin
end;
// 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
i: Integer;
begin

1
Projects/SAMufasaGUI/framefunctionlist.pas
View File

@ -236,6 +236,7 @@ begin
ScriptNode.DeleteChildren;
Analyzing := TCodeInsight.Create();
Analyzing.OnFindInclude:= @Form1.OnCCFindInclude;
Analyzing.OnMessage:= @Form1.OnCCMessage;
Analyzing.FileName:= Form1.CurrScript.ScriptFile;
MS := TMemoryStream.Create;
MS.Write(Script[1],length(script));

20
Projects/SAMufasaGUI/psextension.pas
View File

@ -5,7 +5,7 @@ unit psextension;
interface
uses
Classes, SysUtils,mufasabase, virtualextension,
Classes, SysUtils,mufasabase, virtualextension, MufasaTypes,
uPSComponent,uPSCompiler, uPSRuntime, uPSPreProcessor,forms;
@ -31,8 +31,8 @@ type
procedure RIRegister_Settings(Cl: TPSRuntimeClassImporter);
public
function HookExists(HookName: String): Boolean;override;
function ExecuteHook(HookName: String; fArgs: Array of Variant; out OutVariant : Variant): Integer;override;
function HookExists(const HookName: String): Boolean;override;
function ExecuteHook(const HookName: String;var Args:TVariantArray; out OutVariant : Variant): Integer;override;
property Working : boolean read FWorking;
protected
procedure RegisterPSCComponents(Sender: TObject; x: TPSPascalCompiler);
@ -52,7 +52,7 @@ uses
testunit,updateform,settingssandbox,bitmaps,mmisc//Writeln
;
function TSimbaPSExtension.HookExists(HookName: String): Boolean;
function TSimbaPSExtension.HookExists(const HookName: String): Boolean;
begin
Result := False;
if FWorking then
@ -60,13 +60,13 @@ begin
result := True;
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
result := SExt_error;
if not FWorking then
exit;
try
outvariant := PSInstance.ExecuteFunction(fArgs, HookName);
outvariant := PSInstance.ExecuteFunction(Args, HookName);
result := SExt_ok;
except
on e : exception do
@ -106,10 +106,11 @@ end;
function TSimbaPSExtension.FreeScript: boolean;
var
bla : variant;
Args : TVariantArray;
begin
if not HookExists('Free') then
exit(false);
result := ExecuteHook('Free',[],bla) = SExt_ok;
result := ExecuteHook('Free',Args,bla) = SExt_ok;
end;
{$I ../../Units/MMLAddon/PSInc/Wrappers/extensions.inc}
@ -143,6 +144,7 @@ end;
procedure TSimbaPSExtension.SetEnabled(bool: boolean);
var
temp : variant;
Args : TVariantArray;
begin
if bool <> FEnabled then
begin
@ -155,11 +157,11 @@ begin
if not FWorking then
Exit;
if hookexists('attach') then
ExecuteHook('attach',[],temp);
ExecuteHook('attach',Args,temp);
end;
end else
if HookExists('detach') then
ExecuteHook('detach',[],temp);
ExecuteHook('detach',Args,temp);
end;
inherited SetEnabled(bool);
end;

154
Projects/SAMufasaGUI/testunit.pas
View File

@ -301,6 +301,8 @@ type
Shift: TShiftState; X, Y: Integer);
procedure PageControl1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure PickerPick(Sender: TObject; const Colour, colourx,
coloury: integer);
procedure PopupItemFindClick(Sender: TObject);
procedure ProcessDebugStream(Sender: TObject);
procedure RecentFileItemsClick(Sender: TObject);
@ -313,6 +315,13 @@ type
procedure SplitterFunctionListCanResize(Sender: TObject; var NewSize: Integer;
var Accept: Boolean);
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 TT_UpdateClick(Sender: TObject);
procedure UpdateMenuButtonClick(Sender: TObject);
@ -329,6 +338,14 @@ type
SearchStart : TPoint;
LastTab : integer;
UpdatingFonts : boolean;
OpenConnectionData : TOpenConnectionData;
OpenFileData : TOpenFileData;
WriteFileData : TWriteFileData;
ScriptStartData : TScriptStartData;
procedure HandleConnectionData;
procedure HandleOpenFileData;
procedure HandleWriteFileData;
procedure HandleScriptStartData;
function GetExtPath: string;
function GetFontPath: String;
function GetHighlighter: TSynCustomHighlighter;
@ -361,6 +378,7 @@ type
OCR_Fonts: TMOCR;
Picker: TMColorPicker;
Selector: TMWindowSelector;
OnScriptStart : TScriptStartEvent;
{$ifdef mswindows}
ConsoleVisible : boolean;
procedure ShowConsole( ShowIt : boolean);
@ -513,6 +531,74 @@ begin
result := false;
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);
begin
if length(DebugStream) = 0 then
@ -604,6 +690,32 @@ begin
// PluginsGlob.FreePlugins;
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);
begin
MenuItemHide.enabled:= Form1.Visible;
@ -1214,9 +1326,19 @@ var
AppPath : string;
ScriptPath : string;
UseCPascal: String;
Script : string;
Se: TMMLSettingsSandbox;
loadFontsOnScriptStart: boolean;
Continue : boolean;
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;
CurrScript.ScriptErrorLine:= -1;
CurrentSyncInfo.SyncMethod:= @Self.SafeCallThread;
@ -1234,7 +1356,7 @@ begin
Thread.SetDebug(@formWriteln);
Thread.SetDebugClear(@ClearDebug);
{$ENDIF}
Thread.SetScript(CurrScript.SynEdit.Lines.Text);
Thread.SetScript(Script);
DbgImgInfo.DispSize := @DebugImgForm.DispSize;
DbgImgInfo.ShowForm := @DebugImgForm.ShowDebugImgForm;
DbgImgInfo.ToDrawBitmap:= @DebugImgForm.ToDrawBmp;
@ -1275,6 +1397,9 @@ begin
Se := TMMLSettingsSandbox.Create(SettingsForm.Settings);
Se.Prefix := 'Scripts/';
Thread.SetSettings(Se);
Thread.OpenConnectionEvent:=@ThreadOpenConnectionEvent;
Thread.WriteFileEvent:=@ThreadWriteFileEvent;
Thread.OpenFileEvent:=@ThreadOpenFileEvent;
end;
procedure TForm1.HandleParameters;
@ -1899,6 +2024,9 @@ begin
TT_Console.Visible:= false;
{$endif}
InitmDebug;
Self.OnScriptStart:= @ScriptStartEvent;
FillThread := TProcThread.Create(true);
FillThread.FreeOnTerminate:= True;
FillThread.NormalProc:= @CCFillCore;
@ -1922,6 +2050,7 @@ begin
AddTab;//Give it alteast 1 tab ;-).
Manager := TIOManager.Create; //No need to load plugins for the Global manager
Picker := TMColorPicker.Create(Manager);
Picker.OnPick:=@PickerPick;
Selector := TMWindowSelector.Create(Manager);
{ For writeln }
SetLength(DebugStream, 0);
@ -2345,6 +2474,18 @@ begin
DeleteTab(PageControl1.TabIndexAtClientPos(Classes.Point(x,y)), False);
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);
begin
SearchString := CurrScript.SynEdit.SelText;
@ -2500,6 +2641,15 @@ begin
UpdatingFonts := False;
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);
begin
SetSetting('Settings/CodeHints/ShowAutomatically',Booltostr(AValue,true));
@ -2573,7 +2723,7 @@ begin
with TPSThread(thread).PSScript do
begin
OnLine:=@OnLinePSScript;
CurrentSyncInfo.Res:= Exec.RunProcPVar(CurrentSyncInfo.V,Exec.GetProc(CurrentSyncInfo.MethodName));
CurrentSyncInfo.Res:= Exec.RunProcPVar(CurrentSyncInfo.V^,Exec.GetProc(CurrentSyncInfo.MethodName));
Online := nil;
end;
end else

36
Projects/SAMufasaGUI/virtualextension.pas
View File

@ -5,7 +5,7 @@ unit virtualextension;
interface
uses
Classes, SysUtils,settingssandbox;
Classes, SysUtils,settingssandbox,MufasaTypes;
type
{ TVirtualSimbaExtension }
@ -21,10 +21,10 @@ type
public
OnChange : TNotifyEvent;
{ Must be implemented }
function HookExists(HookName: String): Boolean; virtual; abstract;
function HookExists(const HookName: String): Boolean; virtual; abstract;
{ 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 GetVersion : String;
@ -47,15 +47,23 @@ type
const
SExt_ok = 0;
SExt_error = 1;
EventHooks: Array [0..7] of TEventHook =
( (HookName : 'onScriptCompile' ; ArgumentCount : 1),
(HookName : 'onScriptStart' ; ArgumentCount : 1),
SExt_OnColourPick = 0;
SExt_onOpenFile = 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 : 'onScriptStop' ; ArgumentCount : 1),
(HookName : 'onColourPick' ; ArgumentCount : 3),
(HookName : 'onOpenFile' ; ArgumentCount : 1),
(HookName : 'onOpenSocket' ; ArgumentCount : 1),
(HookName : 'onWriteFile' ; ArgumentCount : 1));
(HookName : 'onScriptStop' ; ArgumentCount : 1));
implementation
@ -71,13 +79,14 @@ end;
function TVirtualSimbaExtension.GetName: string;
var
OutPut : Variant;
Args : TVariantArray;
begin
Result := '';
if FName <> '' then
Result := FName
else if self.HookExists('GetName') then
begin;
if ExecuteHook('GetName',[],OutPut) <> SExt_ok then
if ExecuteHook('GetName',Args,OutPut) <> SExt_ok then
FName := ''
else
FName := OutPut;
@ -88,13 +97,14 @@ end;
function TVirtualSimbaExtension.GetVersion: String;
var
OutPut : Variant;
Args : TVariantArray;
begin
Result := '';
if FVersion <> '' then
Result := FVersion
else if self.HookExists('GetVersion') then
begin;
if ExecuteHook('GetVersion',[],OutPut) <> SExt_ok then
if ExecuteHook('GetVersion',Args,OutPut) <> SExt_ok then
FVersion := ''
else
FVersion := Output;

2
Units/MMLAddon/PSInc/Wrappers/internets.inc
View File

@ -1,6 +1,6 @@
function ps_GetPage(S: String): String; extdecl;
begin
result := GetPage(S);
result := CurrThread.MInternet.GetPage(S);
end;
function ps_InitializeHTTPClient(HandleCookies: Boolean): Integer; extdecl;

2
Units/MMLAddon/PSInc/Wrappers/strings.inc
View File

@ -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;

3
Units/MMLAddon/PSInc/psexportedmethods.inc
View File

@ -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_Explode,'function Explode(del, str: string): 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}
SetCurrSection('Web');

43
Units/MMLAddon/colourpicker.pas
View File

@ -43,36 +43,33 @@ uses
type
TPickEvent = procedure (Sender: TObject; Color, X, Y: Integer);
TMColorPicker = class(TObject)
constructor Create(manager: TIOManager);
destructor Destroy; override;
constructor Create(manager: TIOManager);
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 ImageInfoMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
Procedure ColorPickUp(Sender: TObject; Button: TMouseButton;Shift: TShiftState; X, Y: Integer);
procedure ImageMainMouseMove(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);
public
manager: TIOManager;
manager: TIOManager;
{ Form components }
ScreenForm, InfoForm : TForm;
ImageMain, ImageInfo: TImage;
Text : string;
FPickEvent : TColourPickEvent;
{ Form components }
ScreenForm, InfoForm : TForm;
ImageMain, ImageInfo: TImage;
Text : string;
FPickEvent : TPickEvent;
{ Some temp vars }
oldx, oldy, Color, colorx, colory: Integer;
// targetleft,targettop : integer;
{ Some temp vars }
oldx, oldy, Color, colorx, colory: Integer;
// targetleft,targettop : integer;
TheChangedEvent,TheChangingEvent : TNotifyEvent;
TheChangedEvent,TheChangingEvent : TNotifyEvent;
{ Handles }
InfoHandle, ImageHandle : HDC;
{ Handles }
InfoHandle, ImageHandle : HDC;
public
property OnPick: TPickEvent read FPickEvent write FPickEvent;
property OnPick: TColourPickEvent read FPickEvent write FPickEvent;
end;
@ -284,7 +281,7 @@ begin;
Color:= WidgetSet.DCGetPixel(ImageMain.Canvas.Handle,x,y);
Manager.GetMousePos(ColorX, ColorY);
if OnPick <> nil then
if Assigned(OnPick) then
Onpick(Sender,Color,Colorx,Colory);
{ Tell Pick() that we are done }

37
Units/MMLAddon/internets.pas
View File

@ -5,7 +5,7 @@ unit internets;
interface
uses
Classes, SysUtils,httpsend;
Classes, SysUtils,httpsend,MufasaTypes;
function GetPage(URL: String): String;
@ -20,6 +20,7 @@ type
PostVariables : TStringList;
Client : TObject;
public
OpenConnectionEvent : TOpenConnectionEvent;
procedure SetHTTPUserAgent(agent : string);
function GetHTTPPage(url : string ) : string;
function PostHTTPPage(Url: string; PostData: string): string;overload;
@ -37,6 +38,8 @@ type
Connections : TList;
HTTPClients : TList;
public
OpenConnectionEvent : TOpenConnectionEvent;
function GetPage(URL: String): String;
function CreateHTTPClient(HandleCookies : boolean = true) : integer;
function GetHTTPClient(Index : integer) : THTTPClient;
procedure FreeHTTPClient(Index: Integer);
@ -66,11 +69,26 @@ begin;
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 }
function TMInternet.CreateHTTPClient(HandleCookies: boolean = true): integer;
begin;
Result := HTTPClients.Add(THTTPClient.Create(Client,HandleCookies));
THttpClient(HTTPClients[result]).OpenConnectionEvent:= OpenConnectionEvent;
end;
function TMInternet.GetHTTPClient(Index: integer): THTTPClient;
@ -129,7 +147,16 @@ begin
end;
function THTTPClient.GetHTTPPage(url: string): string;
var
Continue : boolean = true;
begin
Result := '';
if Assigned(OpenConnectionEvent) then
begin;
OpenConnectionEvent(Self,url,continue);
if not Continue then
exit;
end;
if not fHandleCookies then
HTTPSend.Cookies.Clear;
HTTPSend.MimeType := 'text/html';
@ -168,7 +195,15 @@ function THTTPClient.PostHTTPPage(Url: string): string;
var
PostData : string;
i : integer;
Continue : boolean = true;
begin
Result := '';
if Assigned(OpenConnectionEvent) then
begin;
OpenConnectionEvent(Self,url,continue);
if not Continue then
exit;
end;
PostData := '';
for i := 0 to PostVariables.Count - 1 do
PostData := PostData + PostVariables[i] +'&';

44
Units/MMLAddon/mmlpsthread.pas
View File

@ -39,7 +39,7 @@ uses
type
{ TMMLPSThread }
TSyncInfo = record
V : MufasaTypes.TVariantArray;
V : MufasaTypes.PVariantArray;
MethodName : string;
Res : Variant;
SyncMethod : procedure of object;
@ -76,6 +76,10 @@ type
{ TMThread }
TMThread = class(TThread)
private
procedure SetOpenConnectionEvent(const AValue: TOpenConnectionEvent);
procedure SetOpenFileEvent(const AValue: TOpenFileEvent);
procedure SetWriteFileEvent(const AValue: TWriteFileEvent);
protected
ScriptPath, AppPath, IncludePath, PluginPath, FontPath: string;
DebugTo: TWritelnProc;
@ -84,6 +88,9 @@ type
ExportedMethods : TExpMethodArr;
Includes : TStringList;
Prop: TScriptProperties;
FOpenConnectionEvent : TOpenConnectionEvent;
FWriteFileEvent : TWriteFileEvent;
FOpenFileEvent : TOpenFileEvent;
procedure LoadPlugin(plugidx: integer); virtual; abstract;
public
@ -97,6 +104,7 @@ type
OnError : TOnError; //Error handeler
CompileOnly : boolean;
procedure HandleError(ErrorRow,ErrorCol,ErrorPosition : integer; ErrorStr : string; ErrorType : TErrorType; ErrorModule : string);
function ProcessDirective(DirectiveName, DirectiveArgs: string): boolean;
function LoadFile(ParentFile : string; var filename, contents: string): boolean;
@ -117,6 +125,10 @@ type
destructor Destroy; override;
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;
TPSThread = class(TMThread)
@ -190,6 +202,7 @@ uses
IOmanager,//TTarget_Exported
IniFiles,//Silly INI files
stringutil, //String st00f
uPSR_std, uPSR_controls,uPSR_classes,uPSR_graphics,uPSR_stdctrls,uPSR_forms,
uPSR_menus,
files,
@ -278,7 +291,13 @@ constructor TMThread.Create(CreateSuspended: boolean; TheSyncInfo: PSyncInfo; pl
begin
inherited Create(CreateSuspended);
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);
if Assigned(OpenConnectionEvent) then
MInternet.OpenConnectionEvent := Self.OpenConnectionEvent;
SyncInfo:= TheSyncInfo;
ExportedMethods:= GetExportedMethods;
FreeOnTerminate := True;
@ -303,6 +322,27 @@ begin
inherited Destroy;
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);
begin
if OnError = nil then
@ -423,7 +463,7 @@ end;
function ThreadSafeCall(ProcName: string; var V: TVariantArray): Variant; extdecl;
begin
CurrThread.SyncInfo^.MethodName:= ProcName;
CurrThread.SyncInfo^.V:= V;
CurrThread.SyncInfo^.V:= @V;
CurrThread.SyncInfo^.OldThread := CurrThread;
CurrThread.Synchronize(CurrThread.SyncInfo^.SyncMethod);
Result := CurrThread.SyncInfo^.Res;

29
Units/MMLCore/client.pas
View File

@ -39,20 +39,21 @@ TClient is a full-blown instance of the MML.
It binds all the components together.
}
type
TClient = class(TObject)
public
IOManager: TIOManager;
MFiles: TMFiles;
MFinder: TMFinder;
MBitmaps : TMBitmaps;
MDTM: TMDTM;
MOCR: TMOCR;
WritelnProc : TWritelnProc;
procedure WriteLn(s : string);
constructor Create(plugin_dir: string);
destructor Destroy; override;
end;
type
TClient = class(TObject)
public
IOManager: TIOManager;
MFiles: TMFiles;
MFinder: TMFinder;
MBitmaps : TMBitmaps;
MDTM: TMDTM;
MOCR: TMOCR;
WritelnProc : TWritelnProc;
procedure WriteLn(s : string);
constructor Create(plugin_dir: string);
destructor Destroy; override;
end;
implementation

400
Units/MMLCore/files.pas
View File

@ -29,44 +29,43 @@ interface
uses
Classes, SysUtils, MufasaTypes;
const
File_AccesError = -1;
File_EventError = -2;
type
TMufasaFile = record
Path: String;
FS: TFileStream;
BytesRead, Mode: Integer;
end;
TMufasaFilesArray = Array Of TMufasaFile;
{ TMFiles }
TMFiles = class(TObject)
constructor Create(Owner : TObject);
destructor Destroy; override;
public
function CreateFile(const Path: string): Integer;
function OpenFile(const Path: string; Shared: Boolean): Integer;
function RewriteFile(const Path: string; Shared: Boolean): Integer;
procedure CloseFile(FileNum: Integer);
function EndOfFile(FileNum: Integer): Boolean;
function FileSizeMuf(FileNum: Integer): LongInt;
function ReadFileString(FileNum: Integer; out s: string; x: Integer): Boolean;
function WriteFileString(FileNum: Integer;const s: string): Boolean;
Function SetFileCharPointer(FileNum, cChars, Origin: Integer): Integer;
function FilePointerPos(FileNum: Integer): Integer;
protected
MFiles: TMufasaFilesArray;
FreeSpots: Array Of Integer;
Client : TObject;
private
procedure FreeFileList;
function AddFileToManagedList(Path: string; FS: TFileStream; Mode: Integer): Integer;
end;
TMFiles = class(TObject)
public
OpenFileEvent : TOpenFileEvent;
WriteFileEvent: TWriteFileEvent;
function CreateFile(Path: string): Integer;
function OpenFile(Path: string; Shared: Boolean): Integer;
function RewriteFile(Path: string; Shared: Boolean): Integer;
procedure CloseFile(FileNum: Integer);
function EndOfFile(FileNum: Integer): Boolean;
function FileSizeMuf(FileNum: Integer): LongInt;
function ReadFileString(FileNum: Integer; out s: string; x: Integer): Boolean;
function WriteFileString(FileNum: Integer;const s: string): Boolean;
function SetFileCharPointer(FileNum, cChars, Origin: Integer): Integer;
function FilePointerPos(FileNum: Integer): Integer;
constructor Create(Owner : TObject);
destructor Destroy; override;
private
MFiles: TMufasaFilesArray;
FreeSpots: Array Of Integer;
Client : TObject;
procedure CheckFileNum(FileNum : integer);
procedure FreeFileList;
function AddFileToManagedList(Path: string; FS: TFileStream; Mode: Integer): Integer;
end;
// We don't need one per object. :-)
function GetFiles(Path, Ext: string): TStringArray;
function GetDirectories(Path: string): TstringArray;
function FindFile(filename : string; Dirs : array of string) : string; //Results '' if not found
function GetFiles(Path, Ext: string): TStringArray;
function GetDirectories(Path: string): TstringArray;
function FindFile(filename : string; Dirs : array of string) : string; //Results '' if not found
implementation
uses
@ -85,7 +84,7 @@ begin
repeat
inc(c);
SetLength(Result,c);
Result[c-1] := SearchRec.Name;
Result[c-1] := SearchRec.Name;
until FindNext(SearchRec) <> 0;
SysUtils.FindClose(SearchRec);
end;
@ -141,15 +140,15 @@ var
I : integer;
begin;
For I := 0 To High(MFiles) Do
If MFiles[i].FS <> nil Then
Begin
if MFiles[i].FS <> nil then
begin
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;
Except
except
TClient(Client).Writeln('FreeFileList - Exception when freeing FileStream');
End;
End;
end;
end;
SetLength(MFiles, 0);
SetLength(FreeSpots, 0);
end;
@ -160,197 +159,165 @@ begin
inherited;
end;
Function TMFiles.AddFileToManagedList(Path: String; FS: TFileStream; Mode: Integer): Integer;
Var
tFile: TMufasaFile;
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
procedure TMFiles.CheckFileNum(FileNum: integer);
begin
if(FileNum < 0) or (FileNum >= Length(MFiles)) then
raise Exception.CreateFmt('Invalid FileNum passed: %d',[FileNum]);
end;
{If Files[FileNum].Handle = -1 Then
Begin
WriteLn('SetFileCharPointer: Invalid Internal Handle');
Result := -1;
Exit;
End;}
function TMFiles.AddFileToManagedList(Path: String; FS: TFileStream; Mode: Integer): Integer;
var
tFile: TMufasaFile;
begin
tFile.Path := Path;
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
fsFromBeginning:
If(cChars < 0) Then
if(cChars < 0) then
raise Exception.CreateFmt('fsFromBeginning takes no negative cChars. (%d)',[cChars]);
fsFromCurrent:
;
fsFromEnd:
If(cChars > 0) Then
if(cChars > 0) then
raise Exception.CreateFmt('fsFromEnd takes no positive cChars. (%d)',[cChars]);
else
raise Exception.CreateFmt('Invalid Origin: %d',[Origin]);
end;
Try
try
Result := MFiles[FileNum].FS.Seek(cChars, Origin);
Except
except
TClient(Client).Writeln('SetFileCharPointer - Exception Occured.');
Result := -1;
End;
Result := File_AccesError;
end;
//Result := FileSeek(Files[FileNum].Handle, cChars, Origin);
End;
end;
{/\
Creates a file for reading/writing.
Returns the handle (index) to the File Array.
Returns -1 if unsuccesfull.
Returns File_AccesError if unsuccesfull.
/\}
function TMFiles.CreateFile(const Path: string): Integer;
Var
FS: TFileStream;
function TMFiles.CreateFile(Path: string): Integer;
var
FS: TFileStream;
Continue : Boolean;
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);
Except
Result := -1;
Result := AddFileToManagedList(Path, FS, fmCreate);
except
Result := File_AccesError;
TClient(Client).Writeln(Format('CreateFile - Exception. Could not create file: %s',[path]));
Exit;
End;
Result := AddFileToManagedList(Path, FS, fmCreate);
end;
end;
{/\
Opens a file for reading.
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;
Var
FS: TFileStream;
fMode: Integer;
function TMFiles.OpenFile(Path: string; Shared: Boolean): Integer;
var
FS: TFileStream;
fMode: Integer;
Continue : Boolean;
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
Else
else
fMode := fmOpenRead or fmShareExclusive;
Try
try
FS := TFileStream.Create(Path, fMode)
Except
Result := -1;
except
Result := File_AccesError;
TClient(Client).Writeln(Format('OpenFile - Exception. Could not open file: %s',[path]));
Exit;
End;
end;
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;
{/\
Opens a file for writing.
Opens a file for writing. And deletes the contents.
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;
Var
FS: TFileStream;
fMode: Integer;
function TMFiles.RewriteFile(Path: string; Shared: Boolean): Integer;
var
FS: TFileStream;
fMode: Integer;
Continue : Boolean;
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
Else
else
fMode := fmOpenReadWrite or fmShareDenyWrite or fmShareDenyRead or fmCreate;
Try
try
FS := TFileStream.Create(Path, fMode);
Except
Result := -1;
FS.Size:=0;
Result := AddFileToManagedList(Path, FS, fMode);
except
Result := File_AccesError;
TClient(Client).Writeln(Format('ReWriteFile - Exception. Could not create file: %s',[path]));
Exit;
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.
/\}
procedure TMFiles.CloseFile(FileNum: Integer);
begin
If (FileNum >= Length(MFiles)) or (FileNum < 0) Then
raise Exception.CreateFmt('Invalid FileNum passed: %d',[FileNum]);
Try
MFiles[FileNum].FS.Free;
Except
CheckFileNum(filenum);
try
MFiles[FileNum].FS.Free;
MFiles[FileNum].FS := nil;
SetLength(FreeSpots, Length(FreeSpots) + 1);
FreeSpots[High(FreeSpots)] := FileNum;
except
TClient(Client).Writeln(Format('CloseFile, exception when freeing the file: %d',[filenum]));
Exit;
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;
begin
If(FileNum < 0) or (FileNum >= Length(MFiles)) Then
raise Exception.CreateFmt('Invalid FileNum passed: %d',[FileNum]);
If MFiles[FileNum].FS = nil Then
Begin
CheckFileNum(filenum);
if MFiles[FileNum].FS = nil then
begin
TClient(Client).Writeln(format('EndOfFile: Invalid Internal Handle of File: %d',[filenum]));
Result := True;
Exit;
End;
end;
Result := FilePointerPos(FileNum) >= FileSizeMuf(FileNum);
end;
@ -378,52 +343,31 @@ end;
function TMFiles.FileSizeMuf(FileNum: Integer): LongInt;
begin
If(FileNum < 0) or (FileNum >= Length(MFiles)) Then
raise Exception.CreateFmt('Invalid FileNum passed: %d',[FileNum]);
If MFiles[FileNum].FS = nil Then
Begin
CheckFileNum(filenum);
if MFiles[FileNum].FS = nil then
begin
TClient(Client).Writeln(format('FileSize: Invalid Internal Handle of File: %d',[filenum]));
Result := -1;
Result := File_AccesError;
Exit;
End;
end;
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;
function TMFiles.FilePointerPos(FileNum: Integer): Integer;
begin
If(FileNum < 0) or (FileNum >= Length(MFiles)) Then
raise Exception.CreateFmt('Invalid FileNum passed: %d',[FileNum]);
If MFiles[FileNum].FS = nil Then
Begin
CheckFileNum(filenum);
if MFiles[FileNum].FS = nil then
begin
TClient(Client).Writeln(format('FilePointerPos: Invalid Internal Handle of File: %d',[filenum]));
Result := -1;
Result := File_AccesError;
Exit;
End;
end;
try
Result := MFiles[FileNum].FS.Seek(0, fsFromCurrent);
Except
except
TClient(Client).Writeln('Exception in FilePointerPos');
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;
begin
If(FileNum < 0) or (FileNum >= Length(MFiles)) Then
raise Exception.CreateFmt('Invalid FileNum passed: %d',[FileNum]);
If MFiles[FileNum].FS = nil Then
Begin
CheckFileNum(filenum);
if MFiles[FileNum].FS = nil then
begin
TClient(Client).Writeln(format('ReadFileString: Invalid Internal Handle of File: %d',[filenum]));
Exit;
End;
end;
SetLength(S, 0);
SetLength(S, X);
MFiles[FileNum].FS.Read(S[1], x);
@ -456,32 +397,21 @@ end;
function TMFiles.WriteFileString(FileNum: Integer;const s: string): Boolean;
begin
If(FileNum < 0) or (FileNum >= Length(MFiles)) Then
raise Exception.CreateFmt('Invalid FileNum passed: %d',[FileNum]);
If(MFiles[FileNum].FS = nil) Then
Begin
result := false;
CheckFileNum(filenum);
if(MFiles[FileNum].FS = nil) then
begin
TClient(Client).Writeln(format('WriteFileString: Invalid Internal Handle of File: %d',[filenum]));
Result := False;
Exit;
End;
{If((Files[FileNum].Mode and fmOpenWrite) = 0) Then
Begin
WriteLn('This file may not write');
Exit;
End; }
end;
if (MFiles[FileNum].Mode and (fmOpenWrite or fmOpenReadWrite)) = 0 then //Checks if we have write rights..
exit;
try
Result := MFiles[FileNum].FS.Write(S[1], Length(S)) <> 1;
except
TClient(Client).Writeln('Exception - WriteFileString.');
Result := False;
end;
{If(FileWrite(Files[FileNum].Handle, S[1], Length(S)) <> -1) Then
Result := True
Else
Result := False; }
end;
end.

37
Units/MMLCore/mufasatypes.pas
View File

@ -70,6 +70,7 @@ type
TPointArray = array of TPoint;
T2DPointArray = array of TPointArray;
TVariantArray = Array of Variant;
PVariantArray = ^TVariantArray;
TIntegerArray = Array of Integer;
T2DIntArray = array of TIntegerArray;
T2DIntegerArray = T2DIntArray;
@ -83,6 +84,14 @@ type
WhiteHi,BlackHi : integer;
W,H : integer;
end;
{ File types }
TMufasaFile = record
Path: String;
FS: TFileStream;
BytesRead, Mode: Integer;
end;
TMufasaFilesArray = Array Of TMufasaFile;
{ DTM Types }
{
@ -123,6 +132,34 @@ type
end;
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
VirtualKeyInfo = record
Str : string;

12
Units/Misc/v_autocompleteform.pas
View File

@ -583,13 +583,17 @@ begin;
exit;
if beginpos.x > length(strings[beginpos.y]) then
exit;
if endpos.x > length(strings[endpos.y]) then
if endpos.x > (length(strings[endpos.y])+1) then
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);
for i := beginpos.y + 1 to endpos.y-1 do
result := result + strings[i];
if endpos.y <> beginpos.y then
result := result + copy(strings[endpos.y],0,endpos.x);
result := result + copy(strings[endpos.y],0,endpos.x-1); //Position <> count!
end;
function TParamHint.PrepareParamString(out Str: string; out MustHide : boolean): Integer;
@ -606,7 +610,7 @@ begin
MustHide := True;
Parser := TmwPasLex.Create; //The position of the bracket
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));
bracketcount := 0;
ParameterIndex := -1;