mirror of
https://bitbucket.org/Dennis07/lina-components.git
synced 2024-11-24 08:02:12 +02:00
39c0916f1c
Signed-off-by: Dennis07 <den.goehlert@t-online.de>
741 lines
24 KiB
ObjectPascal
741 lines
24 KiB
ObjectPascal
unit uScriptMgr;
|
|
|
|
//////////////////////////////////////
|
|
/// Lina Script Manager Unit ///
|
|
/// **************************** ///
|
|
/// (c) 2014 Dennis Göhlert a.o. ///
|
|
//////////////////////////////////////
|
|
|
|
interface
|
|
|
|
{ Wegen Kompatibilitätsgründen mussten einige AnsiString-Werte eingebaut
|
|
werden, da die PascalScript-Engine von RemObjects noch für ältere Versionen
|
|
von Delphi ausgelegt war. Damit TScriptManager auch unter neueren Delphi-
|
|
Versionen kompiliert werden kann, müssen die AnsiString-Werte so belassen
|
|
werden, da es sonst zu Fehlern kommt. }
|
|
|
|
uses
|
|
{ Standard-Units }
|
|
Classes, SysUtils, Dialogs, Forms,
|
|
{ PS Komponenten-Units }
|
|
uPSCompiler, uPSRuntime, uPSComponent,
|
|
{ PS Syntax-Libraries }
|
|
uPSComponent_Default, uPSComponent_COM, uPSComponent_Controls,
|
|
uPSComponent_Forms, uPSComponent_StdCtrls, uPSComponent_DB,
|
|
{ Andere Package-Units }
|
|
uBase, uFileTools;
|
|
|
|
type
|
|
{ Fehlermeldungen }
|
|
EMissingReturnTarget = class(Exception);
|
|
EMissingComponentName = class(Exception);
|
|
EInvalidCodeLine = class(Exception);
|
|
|
|
type
|
|
{ Hilfsklassen }
|
|
TScriptReturnMode = (srNone,srAll,srErrors);
|
|
TScriptReturnStyle = (srSimple,srTime,srDateTime,srName);
|
|
TScriptLibraries = set of (slClasses,slControls,slStdCtrls,slForms,slDateUtils,slComObj,slDB,slCustom);
|
|
|
|
type
|
|
{ Ereignisse }
|
|
TScriptCreateEvent = procedure(Sender: TObject) of object;
|
|
TScriptDestroyEvent = procedure(Sender: TObject) of object;
|
|
TScriptReturnEvent = procedure(Sender: TObject; const Msg: String) of object;
|
|
TScriptNeedFileEvent = function(Sender:TObject; const OriginFileName: AnsiString; var FileName, Output: AnsiString): Boolean of object;
|
|
TScriptCompileEvent = procedure(Sender: TObject) of object;
|
|
TScriptExecuteEvent = procedure(Sender: TObject) of object;
|
|
TScriptAfterExecuteEvent = procedure(Sender: TObject) of object;
|
|
TScriptLineEvent = procedure(Sender: TObject) of object;
|
|
TScriptCodeAssignEvent = procedure(Sender: TObject) of object;
|
|
TScriptCodeLoadEvent = procedure(Sender: TObject) of object;
|
|
|
|
type
|
|
{ Hauptklassen }
|
|
TScriptManager = class(TComponent)
|
|
private
|
|
{ Private-Deklarationen }
|
|
ScriptEngine: TPSScript;
|
|
Log: TStrings;
|
|
Code: TStrings;
|
|
CustomPlugins: TPSPlugIns;
|
|
FAbout: TComponentAbout;
|
|
FReturnMode: TScriptReturnMode;
|
|
FReturnStyle: TScriptReturnStyle;
|
|
FReturnTarget: TStrings;
|
|
FSecureMode: Boolean;
|
|
FVarApplication: TApplication;
|
|
FVarSelf: TForm;
|
|
FLibraries: TScriptLibraries;
|
|
{ Ereignisse }
|
|
FCreateEvent: TScriptCreateEvent;
|
|
FDestroyEvent: TScriptDestroyEvent;
|
|
FReturnEvent: TScriptReturnEvent;
|
|
FNeedFileEvent: TScriptNeedFileEvent;
|
|
FCompileEvent: TScriptCompileEvent;
|
|
FExecuteEvent: TScriptExecuteEvent;
|
|
FAfterExecuteEvent: TScriptAfterExecuteEvent;
|
|
FLineEvent: TScriptLineEvent;
|
|
FCodeAssignEvent: TScriptCodeAssignEvent;
|
|
FCodeLoadEvent: TScriptCodeLoadEvent;
|
|
{ Methoden }
|
|
function GetCompilerOptions: TPSCompOptions;
|
|
procedure SetCompilerOptions(const Value: TPSCompOptions);
|
|
function GetCodeLines(Index: Integer): String; //Int. Dekl. für: CodeLines[Index]
|
|
procedure SetCodeLines(Index: Integer; const Value: String); //Int. Dekl. für: CodeLines[Index]
|
|
function GetCodeCount: Integer;
|
|
function GetRunning: Boolean;
|
|
function GetPluginItems(Index: Integer): TPSPlugin;
|
|
procedure SetPluginItems(Index: Integer; const Value: TPSPlugin);
|
|
procedure SetLibraries(const Value: TScriptLibraries);
|
|
function GetUsePreProcessor: Boolean;
|
|
procedure SetUsePreProcessor(const Value: Boolean);
|
|
function GetMainFileName: AnsiString;
|
|
procedure SetMainFileName(const Value: AnsiString);
|
|
function GetDefines: TStrings;
|
|
procedure SetDefines(const Value: TStrings);
|
|
function GetPluginCount: Integer;
|
|
published
|
|
{ Published-Deklarationen }
|
|
{ Ereignisse}
|
|
property OnCreate: TScriptCreateEvent read FCreateEvent write FCreateEvent;
|
|
property OnDestroy: TScriptDestroyEvent read FDestroyEvent write FDestroyEvent;
|
|
property OnReturn: TScriptReturnEvent read FReturnEvent write FReturnEvent;
|
|
property OnNeedFile: TScriptNeedFileEvent read FNeedFileEvent write FNeedFileEvent;
|
|
property OnCompile: TScriptCompileEvent read FCompileEvent write FCompileEvent;
|
|
property OnExecute: TScriptExecuteEvent read FExecuteEvent write FExecuteEvent;
|
|
property OnAfterExecute: TScriptAfterExecuteEvent read FAfterExecuteEvent write FAfterExecuteEvent;
|
|
property OnLine: TScriptLineEvent read FLineEvent write FLineEvent;
|
|
property OnCodeAssign: TScriptCodeAssignEvent read FCodeAssignEvent write FCodeAssignEvent;
|
|
property OnCodeLoad: TScriptCodeLoadEvent read FCodeLoadEvent write FCodeLoadEvent;
|
|
{ Eigenschaften }
|
|
property CompilerOptions: TPSCompOptions read GetCompilerOptions write SetCompilerOptions default [];
|
|
property ReturnMode: TScriptReturnMode read FReturnMode write FReturnMode default srNone; //Wann soll eine Rückmeldung erfolgen?
|
|
property ReturnStyle: TScriptReturnStyle read FReturnStyle write FReturnStyle default srSimple; //Wie soll diese Rückmeldung aussehen?
|
|
property ReturnTarget: TStrings read FReturnTarget write FReturnTarget; //Wohin soll die Rückmeldung geschrieben werden?
|
|
property SecureMode: Boolean read FSecureMode write FSecureMode default True; //Darf der Script auf den ScriptMgr zugreifen?
|
|
property VarApplication: TApplication read FVarApplication write FVarApplication; //Variable "Application"
|
|
property VarSelf: TForm read FVarSelf write FVarSelf; //Variable "Self"
|
|
property Libraries: TScriptLibraries read FLibraries write SetLibraries default [slClasses,slControls,slStdCtrls,slForms,slDateUtils,slCustom];
|
|
property UsePreProcessor: Boolean read GetUsePreProcessor write SetUsePreProcessor; //Sind "Include"-Anweisungen erlaubt?
|
|
property MainFileName: AnsiString read GetMainFileName write SetMainFileName; //Dateiname für "Include"-Anweisungen
|
|
property Defines: TStrings read GetDefines write SetDefines; //Standardwerte für "Include"-Anweisung
|
|
{ Meta-Daten }
|
|
property About: TComponentAbout read FAbout;
|
|
protected
|
|
{ Protected-Deklarationen }
|
|
procedure AddLog(Entry: String);
|
|
procedure AddCustomPlugins;
|
|
function ScriptEngineNeedFile(Sender:TObject; const OriginFileName: AnsiString; var FileName, Output: AnsiString): Boolean; //TPSScript.OnNeedFile-Ereignis
|
|
procedure ScriptEngineCompile(Sender: TPSScript); //TPSScript.OnCompile-Ereignis
|
|
procedure ScriptEngineExecute(Sender: TPSScript); //TPSScript.OnExecute-Ereignis
|
|
procedure ScriptEngineAfterExecute(Sender: TPSScript); //TPSScript.OnAfterExecute-Ereignis
|
|
procedure ScriptEngineLine(Sender: TObject); //TPSScript.OnLine-Ereignis
|
|
{ Skript-Funktionen }
|
|
function PS_Random(LimitPlusOne : Integer): Integer;
|
|
function PS_ExecuteFile(FileName: String; ExecMode: TFileExecuteMode): Boolean;
|
|
function PS_InputBox(const ACaption, APrompt, ADefault: String): String;
|
|
function PS_InputQuery(const ACaption, APrompt: String; var Value: String): Boolean;
|
|
procedure PS_ShowMessage(const Msg: String);
|
|
procedure PS_Randomize;
|
|
procedure PS_Sleep(Milliseconds: Cardinal);
|
|
procedure PS_About;
|
|
public
|
|
{ Public-Deklarationen }
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
property Running: Boolean read GetRunning;
|
|
procedure Stop; virtual;
|
|
property CodeLines[Index: Integer]: String read GetCodeLines write SetCodeLines;
|
|
property CodeCount: Integer read GetCodeCount;
|
|
function CodeAddLine(const S: String): Integer;
|
|
procedure CodeAddLines(Strings: TStrings);
|
|
procedure CodeDeleteLine(Index: Integer);
|
|
procedure CodeLoadFromFile(FileName: String);
|
|
procedure CodeLoadFromStream(Stream: TStream);
|
|
procedure CodeAssign(Source: TPersistent);
|
|
procedure CodeClear;
|
|
function CompileAndExecute: Boolean;
|
|
property PluginItems[Index: Integer]: TPSPlugin read GetPluginItems write SetPluginItems;
|
|
property PluginCount: Integer read GetPluginCount;
|
|
procedure PluginAdd(Plugin: TPSPlugin);
|
|
procedure PluginDelete(Plugin: TPSPlugin);
|
|
end;
|
|
|
|
procedure AddPlugin(PluginList: TPSPlugins; Plugin: TPSPlugin);
|
|
procedure DeletePlugin(PluginList: TPSPlugins; Plugin: TPSPlugin);
|
|
|
|
procedure Register;
|
|
|
|
const
|
|
{ Meta-Daten }
|
|
ScriptComponent_Name = 'ScriptManager';
|
|
ScriptComponent_Version = 1.0;
|
|
ScriptComponent_Copyright = 'Copyright © 2014';
|
|
ScriptComponent_Author = 'Dennis Göhlert a.o.';
|
|
{ Fehlermeldungen }
|
|
Error_InvalidCodeLine = 'Invalid cole-line number';
|
|
Error_MissingReturnTarget = 'Missing log-return target';
|
|
Error_MissingComponentName = 'Missing component name';
|
|
|
|
var
|
|
{ PS Import-Units }
|
|
PS_Import_Classes: TPSImport_Classes;
|
|
PS_Import_Controls: TPSImport_Controls;
|
|
PS_Import_StdCtrls: TPSImport_StdCtrls;
|
|
PS_Import_Forms: TPSImport_Forms;
|
|
PS_Import_DateUtils: TPSImport_DateUtils;
|
|
PS_Import_ComObj: TPSImport_ComObj;
|
|
PS_Import_DB: TPSImport_DB;
|
|
|
|
implementation
|
|
|
|
procedure Register;
|
|
begin
|
|
RegisterComponents(ComponentsPage,[TScriptManager]);
|
|
end;
|
|
|
|
procedure AddPlugin(PluginList: TPSPlugins; Plugin: TPSPlugin);
|
|
begin
|
|
TPSPluginItem(PluginList.Add).Plugin := Plugin;
|
|
end;
|
|
|
|
procedure DeletePlugin(PluginList: TPSPlugins; Plugin: TPSPlugin);
|
|
var
|
|
Index: Integer;
|
|
PluginFound: Boolean;
|
|
begin
|
|
PluginFound := False;
|
|
Index := 0;
|
|
if PluginList.Count > Index then
|
|
begin
|
|
repeat
|
|
if TPSPluginItem(PluginList.Items[Index]).Plugin = Plugin then
|
|
begin
|
|
PluginList.Delete(Index);
|
|
PluginFound := True;
|
|
end else
|
|
begin
|
|
Index := Index + 1;
|
|
end;
|
|
until (PluginFound = True);
|
|
end;
|
|
end;
|
|
|
|
constructor TScriptManager.Create(AOwner: TComponent);
|
|
begin
|
|
inherited;
|
|
FAbout := TComponentAbout.Create(ScriptComponent_Name,ScriptComponent_Version,ScriptComponent_Copyright,ScriptComponent_Author);
|
|
//ReturnMode := srNone; Durch DEFAULT festgelegt!
|
|
//ReturnStyle := srSimple; Durch DEFAULT festgelegt!
|
|
SecureMode := True;
|
|
//ReturnSL := TStringList.Create; Nicht erstellen, Property ist nur ein Pointer auf ext. TStrings
|
|
FLibraries := [slClasses,slControls,slStdCtrls,slForms,slDateUtils,slCustom];
|
|
if (Self.Owner is TForm) or (Owner.ClassParent = TForm) then
|
|
begin
|
|
VarSelf := (Self.Owner as TForm);
|
|
end;
|
|
Log := TStringList.Create;
|
|
Code := TStringList.Create;
|
|
CustomPlugins := TPSPlugins.Create(ScriptEngine);
|
|
ScriptEngine := TPSScript.Create(nil);
|
|
ScriptEngine.OnNeedFile := ScriptEngineNeedFile;
|
|
ScriptEngine.OnCompile := ScriptEngineCompile;
|
|
ScriptEngine.OnExecute := ScriptEngineExecute;
|
|
ScriptEngine.OnAfterExecute := ScriptEngineAfterExecute;
|
|
ScriptEngine.OnLine := ScriptEngineLine;
|
|
|
|
{ Import-Unit-Komponenten erstellen }
|
|
PS_Import_Classes := TPSImport_Classes.Create(Self);
|
|
PS_Import_Controls := TPSImport_Controls.Create(Self);
|
|
PS_Import_StdCtrls := TPSImport_StdCtrls.Create(Self);
|
|
PS_Import_Forms := TPSImport_Forms.Create(Self);
|
|
PS_Import_DateUtils := TPSImport_DateUtils.Create(Self);
|
|
PS_Import_ComObj := TPSImport_ComObj.Create(Self);
|
|
PS_Import_DB := TPSImport_DB.Create(Self);
|
|
//Libraries := [slClasses,slControls,slStdCtrls,slForms,slDateUtils,slCustom]; Durch DEFAULT festgelegt!
|
|
if Assigned(OnCreate) then
|
|
begin
|
|
OnCreate(Self);
|
|
end;
|
|
end;
|
|
|
|
destructor TScriptManager.Destroy;
|
|
begin
|
|
if Assigned(OnDestroy) then
|
|
begin
|
|
OnDestroy(Self);
|
|
end;
|
|
VarSelf := nil;
|
|
VarApplication := nil;
|
|
ReturnMode := srNone;
|
|
ReturnStyle := srSimple;
|
|
//ReturnSL.Free; Pointer auf ext. Komponente, nicht freigeben
|
|
Log.Free;
|
|
Code.Free;
|
|
//ScriptEngine.Free; Wird automatisch mit dem Owner vom TScriptManager freigegeben
|
|
About.Free;
|
|
{PS_Import_DB.Free;
|
|
PS_Import_ComObj.Free;
|
|
PS_Import_DateUtils.Free;
|
|
PS_Import_Forms.Free;
|
|
PS_Import_StdCtrls.Free;
|
|
PS_Import_Controls.Free;
|
|
PS_Import_Classes.Free; }
|
|
CustomPlugins.Free;
|
|
ScriptEngine.Free;
|
|
inherited;
|
|
end;
|
|
|
|
function TScriptManager.GetCompilerOptions: TPSCompOptions;
|
|
begin
|
|
Result := ScriptEngine.CompilerOptions;
|
|
end;
|
|
|
|
procedure TScriptManager.SetCompilerOptions(const Value: TPSCompOptions);
|
|
begin
|
|
ScriptEngine.CompilerOptions := Value;
|
|
ScriptEngine.Stop
|
|
end;
|
|
|
|
function TScriptManager.GetCodeLines(Index: Integer): String;
|
|
begin
|
|
if (Index >= 0) and (Index <= Code.Count - 1) then
|
|
begin
|
|
Result := Code.Strings[Index];
|
|
end else
|
|
begin
|
|
raise EInvalidCodeLine.Create(Error_InvalidCodeLine);
|
|
end;
|
|
end;
|
|
|
|
procedure TScriptManager.SetCodeLines(Index: Integer; const Value: String);
|
|
begin
|
|
if (Index >= 0) and (Index <= Code.Count - 1) then
|
|
begin
|
|
Code.Strings[Index] := Value;
|
|
if ReturnMode = srAll then
|
|
begin
|
|
AddLog('Code line ' + IntToStr(Index + 1) + ' modified');
|
|
end;
|
|
end else
|
|
begin
|
|
raise EInvalidCodeLine.Create(Error_InvalidCodeLine);
|
|
end;
|
|
end;
|
|
|
|
function TScriptManager.GetCodeCount;
|
|
begin
|
|
Result := Code.Count;
|
|
end;
|
|
|
|
function TScriptManager.GetRunning: Boolean;
|
|
begin
|
|
Result := ScriptEngine.Running;
|
|
end;
|
|
|
|
procedure TScriptManager.Stop;
|
|
begin
|
|
ScriptEngine.Stop;
|
|
end;
|
|
|
|
function TScriptManager.GetPluginItems(Index: Integer): TPSPlugin;
|
|
begin
|
|
Result := TPSPluginItem(CustomPlugins.Items[Index]).Plugin;
|
|
end;
|
|
|
|
procedure TScriptManager.SetPluginItems(Index: Integer; const Value: TPSPlugin);
|
|
begin
|
|
TPSPluginItem(CustomPlugins.Items[Index]).Plugin := Value;
|
|
end;
|
|
|
|
function TScriptManager.GetPluginCount: Integer;
|
|
begin
|
|
Result := ScriptEngine.Plugins.Count;
|
|
end;
|
|
|
|
procedure TScriptManager.SetLibraries(const Value: TScriptLibraries);
|
|
begin
|
|
ScriptEngine.Plugins.Clear;
|
|
FLibraries := Value;
|
|
{ Import-Unit-Komponenten integrieren }
|
|
if slClasses in FLibraries then
|
|
begin
|
|
AddPlugin(ScriptEngine.Plugins,PS_Import_Classes);
|
|
end else
|
|
begin
|
|
FLibraries := FLibraries - [slControls,slStdCtrls,slForms,slDateUtils,slComObj,slDB];
|
|
end;
|
|
if slControls in FLibraries then
|
|
begin
|
|
AddPlugin(ScriptEngine.Plugins,PS_Import_Controls);
|
|
end else
|
|
begin
|
|
FLibraries := FLibraries - [slStdCtrls,slForms];
|
|
end;
|
|
if slStdCtrls in Libraries then
|
|
begin
|
|
AddPlugin(ScriptEngine.Plugins,PS_Import_StdCtrls);
|
|
end else
|
|
begin
|
|
FLibraries := FLibraries - [slForms];
|
|
end;
|
|
if slForms in FLibraries then
|
|
begin
|
|
AddPlugin(ScriptEngine.Plugins,PS_Import_Forms);
|
|
end;
|
|
if slDateUtils in FLibraries then
|
|
begin
|
|
AddPlugin(ScriptEngine.Plugins,PS_Import_DateUtils);
|
|
end;
|
|
if slComObj in FLibraries then
|
|
begin
|
|
AddPlugin(ScriptEngine.Plugins,PS_Import_ComObj);
|
|
end;
|
|
if slDB in FLibraries then
|
|
begin
|
|
AddPlugin(ScriptEngine.Plugins,PS_Import_DB);
|
|
end;
|
|
if slCustom in FLibraries then
|
|
begin
|
|
AddCustomPlugins;
|
|
end;
|
|
end;
|
|
|
|
function TScriptManager.GetUsePreProcessor: Boolean;
|
|
begin
|
|
Result := ScriptEngine.UsePreProcessor;
|
|
end;
|
|
|
|
procedure TScriptManager.SetUsePreProcessor(const Value: Boolean);
|
|
begin
|
|
ScriptEngine.UsePreProcessor := Value;
|
|
end;
|
|
|
|
function TScriptManager.GetMainFileName: AnsiString;
|
|
begin
|
|
Result := ScriptEngine.MainFileName;
|
|
end;
|
|
|
|
procedure TScriptManager.SetMainFileName(const Value: AnsiString);
|
|
begin
|
|
ScriptEngine.MainFileName := Value;
|
|
end;
|
|
|
|
function TScriptManager.GetDefines: TStrings;
|
|
begin
|
|
Result := ScriptEngine.Defines;
|
|
end;
|
|
|
|
procedure TScriptManager.SetDefines(const Value: TStrings);
|
|
begin
|
|
ScriptEngine.Defines := Value;
|
|
end;
|
|
|
|
procedure TScriptManager.AddLog(Entry: string);
|
|
const
|
|
PrefixBegin = '[';
|
|
PrefixEnd = ']';
|
|
begin
|
|
Log.Add(Entry);
|
|
if ReturnTarget = nil then
|
|
begin
|
|
raise EMissingReturnTarget.Create(Error_MissingReturnTarget);
|
|
end;
|
|
if ReturnStyle = srTime then
|
|
begin
|
|
Entry := PrefixBegin + TimeToStr(Time) + PrefixEnd + ' ' + Entry;
|
|
end;
|
|
if ReturnStyle = srDateTime then
|
|
begin
|
|
Entry := PrefixBegin + DateToStr(Date) + ' ' + TimeToStr(Time) + PrefixEnd + ' ' + Entry;
|
|
end;
|
|
if ReturnStyle = srName then
|
|
begin
|
|
if Length(Name) > 0 then
|
|
begin
|
|
Entry := PrefixBegin + Name + PrefixEnd + ' ' + Entry;
|
|
end else
|
|
begin
|
|
raise EMissingComponentName.Create(Error_MissingComponentName);
|
|
end;
|
|
end;
|
|
ReturnTarget.Add(Entry);
|
|
if Assigned(OnReturn) then
|
|
begin
|
|
OnReturn(Self,Entry);
|
|
end;
|
|
end;
|
|
|
|
procedure TScriptManager.AddCustomPlugins;
|
|
var
|
|
Index: Integer;
|
|
begin
|
|
for Index := 0 to CustomPlugins.Count - 1 do
|
|
begin
|
|
AddPlugin(ScriptEngine.Plugins,TPSPluginItem(CustomPlugins.Items[Index]).Plugin);
|
|
end;
|
|
end;
|
|
|
|
function TScriptManager.CompileAndExecute: Boolean;
|
|
begin
|
|
Result := False;
|
|
ScriptEngine.Script.Assign(Code);
|
|
if ReturnMode = srAll then
|
|
begin
|
|
AddLog('Compiling script...');
|
|
end;
|
|
if ScriptEngine.Compile = True then
|
|
begin
|
|
if ReturnMode = srAll then
|
|
begin
|
|
AddLog('Script succesfully compiled');
|
|
end;
|
|
if ReturnMode = srAll then
|
|
begin
|
|
AddLog('Executing script...');
|
|
end;
|
|
if ScriptEngine.Execute = False then
|
|
begin
|
|
if (ReturnMode = srAll) or (ReturnMode = srErrors) then
|
|
begin
|
|
AddLog(ScriptEngine.ExecErrorToString + ' at ' + Inttostr(ScriptEngine.ExecErrorProcNo) + '.'+Inttostr(ScriptEngine.ExecErrorByteCodePosition));
|
|
end;
|
|
end else
|
|
begin
|
|
if ReturnMode = srAll then
|
|
begin
|
|
AddLog('Script succesfully executed');
|
|
end;
|
|
Result := True;
|
|
end;
|
|
end else
|
|
begin
|
|
if ReturnMode = srAll then
|
|
begin
|
|
AddLog('Script compilation failed');
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TScriptManager.CodeAddLine(const S: String): Integer;
|
|
begin
|
|
Result := Code.Add(S);
|
|
end;
|
|
|
|
procedure TScriptManager.CodeAddLines(Strings: TStrings);
|
|
begin
|
|
Code.AddStrings(Strings);
|
|
end;
|
|
|
|
procedure TScriptManager.CodeDeleteLine(Index: Integer);
|
|
begin
|
|
Code.Delete(Index);
|
|
end;
|
|
|
|
procedure TScriptManager.CodeLoadFromFile(FileName: String);
|
|
begin
|
|
Code.LoadFromFile(FileName);
|
|
if ReturnMode = srAll then
|
|
begin
|
|
AddLog('Script code loaded successfully');
|
|
end;
|
|
if Assigned(OnCodeLoad) then
|
|
begin
|
|
OnCodeLoad(Self);
|
|
end;
|
|
end;
|
|
|
|
procedure TScriptManager.CodeLoadFromStream(Stream: TStream);
|
|
begin
|
|
Code.LoadFromStream(Stream);
|
|
if ReturnMode = srAll then
|
|
begin
|
|
AddLog('Script code loaded successfully');
|
|
end;
|
|
if Assigned(OnCodeLoad) then
|
|
begin
|
|
OnCodeLoad(Self);
|
|
end;
|
|
end;
|
|
|
|
procedure TScriptManager.CodeAssign(Source: TPersistent);
|
|
begin
|
|
Code.Assign(Source);
|
|
if ReturnMode = srAll then
|
|
begin
|
|
AddLog('Script code assigned successfully');
|
|
end;
|
|
if Assigned(OnCodeAssign) then
|
|
begin
|
|
OnCodeAssign(Self);
|
|
end;
|
|
end;
|
|
|
|
procedure TScriptManager.CodeClear;
|
|
begin
|
|
Code.Clear;
|
|
if ReturnMode = srAll then
|
|
begin
|
|
AddLog('Script code cleared successfully');
|
|
end;
|
|
end;
|
|
|
|
procedure TScriptManager.PluginAdd(Plugin: TPSPlugin);
|
|
begin
|
|
AddPlugin(CustomPlugins,Plugin);
|
|
SetLibraries(Libraries);
|
|
end;
|
|
|
|
procedure TScriptManager.PluginDelete(Plugin: TPSPlugin);
|
|
begin
|
|
DeletePlugin(CustomPlugins,Plugin);
|
|
SetLibraries(Libraries);
|
|
end;
|
|
|
|
function TScriptManager.ScriptEngineNeedFile(Sender:TObject; const OriginFileName: AnsiString; var FileName, Output: AnsiString): Boolean;
|
|
begin
|
|
Result := ScriptEngine.OnNeedFile(Sender,OriginFileName,FileName,Output);
|
|
if Assigned(OnNeedFile) then
|
|
begin
|
|
OnNeedFile(Self,OriginFileName,FileName,OutPut);
|
|
end;
|
|
end;
|
|
|
|
procedure TScriptManager.ScriptEngineCompile(Sender: TPSScript);
|
|
begin
|
|
with (Sender as TPSScript) do
|
|
begin
|
|
{ VARIABLEN }
|
|
if slForms in Libraries then
|
|
begin
|
|
if Assigned(VarSelf) = True then
|
|
begin
|
|
AddRegisteredVariable('Self','TForm');
|
|
end;
|
|
if Assigned(VarApplication) = True then
|
|
begin
|
|
AddRegisteredVariable('Application','TApplication');
|
|
end;
|
|
end;
|
|
{ TYPEN }
|
|
//Comp.AddTypeS('TFileExecuteMode','(feOpen,feEdit)');
|
|
{ FUNKTIONEN }
|
|
AddMethod(Self,@TScriptManager.PS_Random,'function Random(LimitPlusOne: Integer): Integer');
|
|
//AddMethod(Self,@TScriptManager.PS_ExecuteFile,'function ExecuteFile(FileName: String; ExecMode: TFileExecuteMode): Boolean');
|
|
AddMethod(Self,@TScriptManager.PS_InputBox,'function InputBox(const ACaption, APrompt, ADefault: String): String');
|
|
AddMethod(Self,@TScriptManager.PS_InputQuery,'function InputQuery(const ACaption, APrompt: String; var Value: String): Boolean');
|
|
{ PROZEDUREN }
|
|
AddMethod(Self,@TScriptManager.PS_ShowMessage,'procedure ShowMessage (const Msg: String)');
|
|
AddMethod(Self,@TScriptManager.PS_Randomize,'procedure Randomize');
|
|
AddMethod(Self,@TScriptManager.PS_Sleep,'procedure Sleep(Milliseconds: Cardinal)');
|
|
AddMethod(Self,@TScriptManager.PS_About,'procedure About');
|
|
if SecureMode = False then
|
|
begin
|
|
AddMethod(Self,@TScriptManager.CodeAddLine,'function CodeAddLine(const S: String): Integer)');
|
|
AddMethod(Self,@TScriptManager.CodeAddLines,'procedure CodeAddLines(Strings: TStrings)');
|
|
AddMethod(Self,@TScriptManager.CodeDeleteLine,'procedure CodeDeleteLine(Index: Integer)');
|
|
AddMethod(Self,@TScriptManager.CodeLoadFromFile,'procedure CodeLoadFromFile(FileName: String)');
|
|
AddMethod(Self,@TScriptManager.CodeLoadFromStream,'procedure CodeLoadFromStream(Stream: TStream)');
|
|
AddMethod(Self,@TScriptManager.CodeAssign,'procedure CodeAssign(Source: TPersistent)');
|
|
AddMethod(Self,@TScriptManager.CodeClear,'procedure CodeClear');
|
|
AddMethod(Self,@TScriptManager.CompileAndExecute,'function CompileAndExecute: Boolean');
|
|
end;
|
|
end;
|
|
if Assigned(OnCompile) then
|
|
begin
|
|
OnCompile(Self);
|
|
end;
|
|
end;
|
|
|
|
procedure TScriptManager.ScriptEngineExecute(Sender: TPSScript);
|
|
begin
|
|
with (Sender as TPSScript) do
|
|
begin
|
|
if Assigned(VarSelf) = True then
|
|
begin
|
|
SetVarToInstance('Self',VarSelf);
|
|
end;
|
|
if Assigned(VarApplication) = True then
|
|
begin
|
|
SetVarToInstance('Application',VarApplication);
|
|
end;
|
|
end;
|
|
if Assigned(OnExecute) then
|
|
begin
|
|
OnExecute(Self);
|
|
end;
|
|
end;
|
|
|
|
procedure TScriptManager.ScriptEngineAfterExecute(Sender: TPSScript);
|
|
begin
|
|
with (Sender as TPSScript) do
|
|
begin
|
|
// ScriptEngine.Plugins.Clear; NICHT BENUTZEN!
|
|
end;
|
|
if Assigned(OnAfterExecute) then
|
|
begin
|
|
OnAfterExecute(Self);
|
|
end;
|
|
end;
|
|
|
|
procedure TScriptManager.ScriptEngineLine(Sender: TObject);
|
|
begin
|
|
with (Sender as TPSScript) do
|
|
begin
|
|
//... Nur definieren falls verwendet/benötigt!
|
|
end;
|
|
if Assigned(OnLine) then
|
|
begin
|
|
OnLine(Self);
|
|
end;
|
|
end;
|
|
|
|
function TScriptManager.PS_Random(LimitPlusOne: Integer): Integer;
|
|
begin
|
|
Result := Random(LimitPlusOne);
|
|
end;
|
|
|
|
function TScriptManager.PS_ExecuteFile(FileName: String; ExecMode: TFileExecuteMode): Boolean;
|
|
begin
|
|
Result := ExecuteFile(FileName,feOpen);
|
|
end;
|
|
|
|
function TScriptManager.PS_InputBox(const ACaption, APrompt, ADefault: String): String;
|
|
begin
|
|
Result := InputBox(ACaption,APrompt,ADefault);
|
|
end;
|
|
|
|
function TScriptManager.PS_InputQuery(const ACaption, APrompt: String; var Value: String): Boolean;
|
|
begin
|
|
Result := InputQuery(ACaption,APrompt,Value);
|
|
end;
|
|
|
|
procedure TScriptManager.PS_ShowMessage(const Msg: string);
|
|
begin
|
|
ShowMessage(Msg);
|
|
end;
|
|
|
|
procedure TScriptManager.PS_Randomize;
|
|
begin
|
|
Randomize;
|
|
end;
|
|
|
|
procedure TScriptManager.PS_Sleep(Milliseconds: Cardinal);
|
|
begin
|
|
Sleep(Milliseconds);
|
|
end;
|
|
|
|
procedure TScriptManager.PS_About;
|
|
begin
|
|
MessageDlg(ScriptComponent_Name + ' Component v'
|
|
+ FloatToStr(ScriptComponent_Version) + #10
|
|
+ 'For: Borland Delphi' + #10
|
|
+ ScriptComponent_Copyright + ' by '
|
|
+ ScriptComponent_Author + #10
|
|
+ 'Requires and uses: RemObjects PascalScript component library',
|
|
mtInformation,[mbOK],0);
|
|
end;
|
|
|
|
end.
|