I'm struggling with some anonymous methods in Delphi.
When a call the Execute method and the timer created inside that method timeout, it throws a "privileged instruction" exception.
Is that because my anonymous function go out of scope?
unit OneShotTimerReloaded;
interface
uses
System.SysUtils, System.Classes;
type
IOneShotTimerReloaded = interface
['{51DE72F0-4784-4CEB-A065-0B64D6EEA626}']
procedure Execute(Proc: TProc; TimeOut: Cardinal = 1000); overload;
procedure Execute(Proc: TProcedure; TimeOut: Cardinal = 1000); overload;
procedure Execute(Event: TNotifyEvent; TimeOut: Cardinal = 1000; Sender: TObject = nil); overload;
end;
TOneShotTimerReloaded = class(TInterfacedObject, IOneShotTimerReloaded)
public
procedure Execute(Proc: TProc; TimeOut: Cardinal = 1000); overload;
procedure Execute(Proc: TProcedure; TimeOut: Cardinal = 1000); overload;
procedure Execute(Event: TNotifyEvent; TimeOut: Cardinal = 1000; Sender: TObject = nil); overload;
end;
implementation
uses
Winapi.Windows;
{ TOneShotTimerReloaded }
procedure TOneShotTimerReloaded.Execute(Proc: TProc; TimeOut: Cardinal);
var
TimerID: UIntPtr;
begin
TimerID := SetTimer(HWND(0), 0, TimeOut, #procedure
begin
if (Assigned(Proc)) then
Proc;
KillTimer(HWND(0), TimerID);
end
);
end;
procedure TOneShotTimerReloaded.Execute(Proc: TProcedure; TimeOut: Cardinal);
var
TimerID: UIntPtr;
begin
TimerID := SetTimer(HWND(0), 0, TimeOut, #procedure
begin
if (Assigned(Proc)) then
Proc;
KillTimer(HWND(0), TimerID);
end
);
end;
procedure TOneShotTimerReloaded.Execute(Event: TNotifyEvent; TimeOut: Cardinal; Sender: TObject);
var
TimerID: UIntPtr;
begin
TimerID := SetTimer(HWND(0), 0, TimeOut, #procedure
begin
if (Assigned(Event)) then
Event(Sender);
KillTimer(HWND(0), TimerID);
end
);
end;
end.
The way I'm currently using this class is:
procedure TForm1.FormCreate(Sender: TObject);
var
t1: TOneShotTimerReloaded;
t2: TOneShotTimerReloaded;
begin
t1 := TOneShotTimerReloaded.Create;
t2 := TOneShotTimerReloaded.Create;
t1.Execute(btn1Click, 5000, btn1);
t2.Execute(procedure begin ShowMessage('Anonymous'); end, 2000);
// Not worried with t1 and t2 memory leaks yet!!! ;)
end;
Any ideas or suggestions are appreciated. Thanks!
You cannot use an anonymous procedure for a Win32 API callback, any more than you can use a non-static class method (without writing a proxy stub), or a local inner function (not safely, anyway). An anonymous procedure is implemented as a compiler-generated reference-counted interface that has a hidden Invoke() method that is executed whenever the procedure is called. That does not match the signature that SetTimer() (or any other API) is expecting for its callback.
Your code is essentially (but not exactly) doing the following behind the scenes:
type
TOneShotTimerReloaded_Execute_AnonProc = interface(IInterface)
procedure Invoke;
end;
TOneShotTimerReloaded_Execute_AnonProc_Impl = class(TInterfacedObject, TOneShotTimerReloaded_Execute_AnonProc)
public
Captured_Proc: ^TProc;
Captured_TimerID: ^UIntPtr;
procedure Invoke;
end;
procedure TOneShotTimerReloaded_Execute_AnonProc_Impl.Invoke;
begin
if (Assigned(Captured_Proc^)) then
Captured_Proc^();
KillTimer(HWND(0), Captured_TimerID^);
end
procedure TOneShotTimerReloaded.Execute(Proc: TProcedure; TimeOut: Cardinal);
var
TimerID: UIntPtr;
AnonProc: TOneShotTimerReloaded_Execute_AnonProc;
begin
AnonProc := TOneShotTimerReloaded_Execute_AnonProc_Impl.Create;
AnonProc.Captured_Proc := #Proc;
AnonProc.Captured_TimerID := #TimerID;
TimerID := SetTimer(HWND(0), 0, TimeOut, #AnonProc);
end;
See why it cannot possibly ever work?
Even if it were possible, your anonymous procedures are missing the input parameters that SetTimer() passes to its callback, as well as the stdcall calling convention, so you would be mismanaging the call stack anyway.
Your use of the # address operator is hiding compiler errors from you. Get rid of # and let the compiler fail. That should have been your first indication that you are doing something wrong.
To do what you are attempting, you are going to have to create a dynamic proxy stub (similar to what Classes.MakeObjectInstance() does) so SetTimer() can call your Proc handlers (almost) directly. Anonymous procedures will not help you with that.
Related
I have created a factory unit that contains multiple subclasses for different functions.
FACTORY UNIT
//parent
type
TfactoryU = class(Tobject)
public
constructor create;
end;
//subclass 1
TFormPosition = class (TfactoryU)
private
fFormName:tform;
public
constructor create (formName:tform);
procedure centerForm(frm:tform);
end;
implementation
{ TfactoryU }
constructor TFormPosition.Create(formName:tform);
begin
Inherited Create;
fFormName:=formname;
end;
procedure TFormPosition.centerForm(frm:tform);
begin
frm.Left := (Screen.Width - frm.Width) div 2;
frm.Top := (Screen.Height - frm.Height) div 2;
end;
constructor TfactoryU.create;
begin
end;
However, I do not know how to call the subclass procedure from a different unit.
MAIN UNIT
procedure TfrmMERCH.FormActivate(Sender: TObject);
var
objfactoryU:TfactoryU;
begin
objfactoryU:=tformposition.create(frmmerch);
objfactoryU.centerForm(frmmerch);
The calling of the procedure centerForm is underlined in red.
centerForm() is not a member of TfactoryU, that is why you get an error when trying to call it via a TfactoryU variable. You need to use a type-cast to reach it, eg:
procedure TfrmMERCH.FormActivate(Sender: TObject);
var
objfactoryU: TfactoryU;
begin
objfactoryU := tformposition.create(frmmerch);
tformposition(objfactoryU).centerForm(frmmerch);
However, since both the declaration of objfactoryU and the call to the centerForm() method are in the same procedure, you should just change the declaration instead:
procedure TfrmMERCH.FormActivate(Sender: TObject);
var
objfactoryU: tformposition;
begin
objfactoryU := tformposition.create(frmmerch);
objfactoryU.centerForm(frmmerch);
IUfMessung = interface
['{6C258E04-BCC9-4349-912B-57A38F103570}']
function MacheMessung(Ifl,Ufl: double): double;
end;
TUFMessungMitHalten = class(TInterfacedObject,IUfMessung)
private
SWZeitHalten: double;
public
constructor Create(ASWZeitHalten: double); // Time to keep
destructor Destroy; override;
function MacheMessung(Ifl,Ufl: double): double; // do measuring
end; // measuring with holding
TUFMessungMitPause = class(TInterfacedObject,IUfMessung)
private
SWZeitPause: double;
IfMin: double;
public
constructor Create(ASWZeitPause: double; AIfMin: double); // Time to keep + I[A]
destructor Destroy; override;
function MacheMessung(Ifl,Ufl: double): double;
end; // measuring with Pause
TUFMessung = class(TInterfacedObject)
private
//...
Messungsart: IUfMessung;
public
procedure SetMessungsart(art: IUfMessung); // set measuring type
procedure MessungsArtAswahl; // measuring type choice
//...
end; // do measuring
{ TUFMessung }
procedure TUFMessung.MessungsArtAswahl;
begin
if not FMitHalten and not FMitPause then // Uf simple measuring
begin
SetMessungsart(TUFMessungEinfach.Create);
end;
if FMitHalten and not FMitPause then // Uf with holding
begin
SetMessungsart(TUFMessungMitHalten.Create(FSWZeitHalten));
end;
if not FMitHalten and FMitPause then // Uf with pause
begin
SetMessungsart(TUFMessungMitPause.Create(FSWZeitPause, FStartIf));
end;
end;
procedure TUFMessung.Start(StartIf, EndIf, StepIf, Uleer: double);
begin
//...
while not FIstFertig and FUfKannStart do
begin
Uf:= Messungsart.MacheMessung(Ifl, FUleer); // <= CALL the measuring
//...
end;
end;
{ TUFMessungMitHalten }
function TUFMessungMitHalten.MacheMessung(Ifl, Ufl: double): double;
var i_Zeit: integer;
begin // Messvorgang
hole_Uf(true, Ifl, Ufl); // set value
i_Zeit:= Trunc(SWZeitHalten*1000);
Application.ProcessMessages;
Sleep(i_Zeit); // wait Time ms.
result:= hole_Uf(false, Ifl, Ufl); // measuring
end;
{ TUFMessungMitPause }
function TUFMessungMitPause.MacheMessung(Ifl, Ufl: double): double;
var i_Zeit: integer;
begin // Messvorgang
result:= hole_Uf(false, Ifl, Ufl); // measuring
hole_Uf(true, IfMin, Ufl); // set value
i_Zeit:= Trunc(SWZeitPause*1000);
Application.ProcessMessages;
Sleep(i_Zeit); // wait Time ms.
end;
I need to wait between the measuring processes for a time from 0 to 5 seconds. The solution with sleep () works well only till 1 second because I have in the program an RS232 communication and some timers.
Is there an alternative to sleep () function so that the program precisely at this point a certain time is waiting for? Thank you in advance.
I can't tell from your source, but if you're combining RS232 and waiting, Sleep sounds like a bad idea. The best you could do is have the system respond to you as soon as data comes in, not blindly wait for it. Depending on what you use to do RS232 communication, you should look for something like SetCommTimeouts and fine-tune how read operations behave: if the data is not in yet, stall for the receive timeout, and after that respond that zero bytes were received. This is best done from a dedicated thread (which might take a little learning to get a hang of). Another option is using asynchronous calls (which also take a little learning to get a hang of).
As David says, there may be more elegant solutions for an ideal world, or if you are willing to get your hands dirty with low level device I/O and threading. But until you have perhaps identified a more elegant solution, another approach would be to create your own time-out loop (a so called "busy loop") around Application.ProcessMessages to incorporate a "time-out" behaviour to return control to the caller after a specified time, processing messages in the meantime.
This might look something similar to this:
procedure ProcessMessagesFor(aTimeOut: Integer);
var
start: Int64;
elapsed: Integer;
begin
start := Trunc(Now * 24 * 60 * 60 * 1000);
elapsed := 0;
while elapsed < aTimeout do
begin
Application.ProcessMessages;
elapsed := Trunc(Now * 24 * 60 * 60 * 1000) - start;
end;
end;
This is also less than ideal however since Application.ProcessMessages will itself not return until any and all messages have been processed. It would be better to check for the elapsed timeout after each message so that we can get back into the normal message loop as soon as possible.
Application.ProcessMessages simply calls a ProcessMessage function, but this is private to the TApplication class, so we cannot call this directly.
Fortunately, in Delphi 7, the ProcessMessage function is itself relatively simple and can be easily replicated within the timeout loop of a custom message processor.
Note that to do this we need to change a couple of private references (fOnMessage event handler for example) to the public equivalents and a handful of TApplication protected methods are involved which we obtain access to using a local sub-class and type-casting (a primitive pre-cursor to "class helpers" but which works in all versions of Delphi):
type
// Creates a sub-class in scope which we can use in a typecast
// to gain access to protected members of the target superclass
TApplicationHelper = class(TApplication);
procedure ProcessMessagesFor(aTimeOut: Integer);
var
start: Int64;
elapsed: Integer;
wait: Boolean;
function ProcessMessage: Boolean;
var
msg: TMsg;
handled: Boolean;
app: TApplicationHelper;
begin
app := TApplicationHelper(Application);
result := False;
if PeekMessage(msg, 0, 0, 0, PM_REMOVE) then
begin
result := True;
if msg.Message <> WM_QUIT then
begin
handled := False;
if Assigned(Application.OnMessage) then
Application.OnMessage(msg, handled);
if not app.IsHintMsg(msg)
and not handled
and not app.IsMDIMsg(msg)
and not app.IsKeyMsg(msg)
and not app.IsDlgMsg(msg) then
begin
TranslateMessage(msg);
DispatchMessage(msg);
end;
end
else
PostQuitMessage(msg.wParam);
end;
end;
begin
wait := FALSE; // We will not wait for messages initially
start := Trunc(Now * 24 * 60 * 60 * 1000);
SetTimer(0, 0, aTimeout, NIL); // Makes sure we get a message (WM_TIMER) at the end of the timeout period
repeat
if wait then
WaitMessage;
wait := NOT ProcessMessage; // If there was no message then we will wait for one next time around
elapsed := Trunc(Now * 24 * 60 * 60 * 1000) - start;
until (elapsed >= aTimeout);
end;
I have used a crude multiplier and truncation of a Now date/time to obtain a millisecond precision elapsed time counter without having to deal with the wrap around (potential) issue with GetTickCount. You may want to modify this to use a HPC or simply deal with the GetTickCount wrap-around.
We incorporate a WaitMessage mechanism so that if there are no messages to be processed then the code simply waits (efficiently) for any new messages. To ensure that we are not waiting for messages beyond the timeout period, we initially set a timer event for the specified timeout. This guarantees that a WM_TIMER message will arrive to signal the expiry of the timeout, which will "wake up" our message loop if it is still waiting when the timeout has expired.
Another thing to note is that WM_QUIT messages are re-posted to the message queue. This is to ensure that these will be handled correctly when the ProcessMessagesFor() loop has timed out and messages are once again being handled by the main application message loop.
This function does not (strictly speaking) call Application.ProcessMessages, nor does it involve Sleep(), but it is still not an ideal solution being vulnerable to (potential) re-entrancy problems that having "inline" message loops always creates. These can be managed by controlling user interaction with parts of the UI that might cause such re-entrancy problems (i.e. disable forms or controls while processing is completed).
But even without such refinements it may keep you going with your current problem unless and until a more ideal solution is found.
Create you own sleep function:
procedure MySleep (const uSec: UInt);
var uStart : UInt;
begin
uStart := GetTickCount;
while (GetTickCount < (uStart + (uSec * 1000))) do
begin
Sleep (250);
Application.ProcessMessages;
end
end;
I'm trying to figure out how to run a stored procedure using firedac
unit DataLayer.OilCommanderConnection;
interface
uses
FireDAC.Phys.FB,
Generics.Collections,
Model.Sample,
Model.Batch,
FireDAC.Stan.Intf, FireDAC.Stan.Option, FireDAC.Stan.Error,
FireDAC.UI.Intf, FireDAC.Phys.Intf, FireDAC.Stan.Def, FireDAC.Stan.Pool,
FireDAC.Stan.Async, FireDAC.Phys, FireDAC.Phys.MySQL, Data.DB,
FireDAC.Comp.Client, FireDAC.Phys.MSSQL,
FireDAC.DApt,
FireDAC.Comp.UI
;
type
TOilCommanderConnection = class
strict private
public
Connection : TFDConnection;
function GetSampleTypesForBatch(Batch : TBatch) : Boolean;
function Connect:Boolean;
constructor Create;
destructor Destroy; override;
end;
implementation
uses
SysUtils
;
function TOilCommanderConnection.Connect:Boolean;
var
OK : Boolean;
begin
OK := true;
Connection := TFDConnection.Create(nil);
try
Connection.Params.LoadFromFile('MSSQL.ini');
finally
Result := OK;
end;
end;
function TOilCommanderConnection.GetSampleTypesForBatch(Batch : TBatch) : Boolean;
var
StoredProc : TFDStoredProc;
begin
Connect;
StoredProc := TFDStoredProc.Create(nil);
try
StoredProc.Connection := Connection;
StoredProc.StoredProcName := 'GetSampleTypesForBatch';
StoredProc.Prepare;
StoredProc.FetchOptions.Items := StoredProc.FetchOptions.Items - [fiMeta];
with StoredProc.Params do
begin
Clear;
with Add do
begin
Name := 'BatchNo';
ParamType := ptInput;
DataType := ftString;
Size := 6;
end;
end;
StoredProc.StoredProcName := 'GetSampleTypesForBatch';
StoredProc.Prepare;
StoredProc.Params[0].Value := Batch.RackNo;
StoredProc.ExecProc;
while not StoredProc.Eof do
begin
//StoredProc.FieldByName('').AsS
StoredProc.Next;
end;
finally
FreeAndNil(StoredProc);
end;
Result := true;
end;
constructor TOilCommanderConnection.Create;
begin
inherited;
Connection := TFDConnection.Create(nil);
end;
destructor TOilCommanderConnection.Destroy;
begin
if Assigned(Connection) then FreeAndNil(Connection);
inherited;
end;
end.
I get an error message a the first occurrence of the line
StoredProc.Prepare;
Here is the message
--------------------------- Debugger Exception Notification
Project RefractiveIndexTests.exe raised exception class Exception with message 'Object factory for class
{3E9B315B-F456-4175-A864-B2573C4A2201} is missing. To register it, you
can drop component [TFDGUIxWaitCursor] into your project'.
I've called the function using
OilCommanderConnection.GetSampleTypesForBatch(batch);
from a test project.
the tutorial I read didn't explain what to do about this situation.
I've tried adding TFDGUIxWaitCursor into my project as the error message suggests but this has not made any difference. I wonder if this problem is related to me keeping the Database connection logic in a separate unit to my Main Form. I would like to be able to separate my user interface from my Data Layer.
Depending on the type of your application, include one of the following units into any one "uses" clause:
FireDAC.VCLUI.Wait - for VCL applications;
FireDAC.FMXUI.Wait - for FireMonkey applications;
FireDAC.ConsoleUI.Wait - for console / non-visual applications.
So I've started playing with SMS and I've tried to make a program (label and button) to hit a website with a post request and display the result.
I have no problems with Hints/Warnings/Errors and everything looks good to me. The following code is a rework of a couple of existing examples mashed together.
procedure TForm1.ExecuteCmd;
var
whttp : TW3HttpRequest;
wParams : string;
begin
wHttp := TW3HttpRequest.Create;
try
whttp.OnDataReady := lambda (Sender)
if (w3Label1.caption = '') then
w3Label1.caption := wHttp.ResponseText;
end;
whttp.OnReadyStateChange := lambda (Sender)
if (wHttp.ReadyState = 4) and (wHttp.Status = 200) then
begin
if (w3Label1.caption = '') then
w3Label1.caption := wHttp.ResponseText;
end;
end;
wParams := 'cmd=TestID1';
whttp.open('POST','http://www.server1.com/executecmd.php');
whttp.RequestHeaders['Content-type'] := 'application/x-www-form-urlencoded';
whttp.Send(wParams);
finally
wHttp.free;
end;
end;
procedure TForm1.W3Button1Click(Sender: TObject);
begin
ExecuteCmd;
end;
The problem is this, when I actually click the button I get the following error message:
Uncaught TypeError: Cannot read property 'readyState' of null [line #6277]
The error is in the auto generated code and seems to have no relation to what I've written specifically. If I take out all references to ReadyState from my code I still get the error.
What am I missing? I feel like it has something to do with the Lambda functions.
Your problem is that you are expecting whttp.Send to block. Send, as its JavaScript equivalent, is asynchronous. Before the POST could even execute, whttp object is freed (in the finally block). When callback (OnReadyStateChanged) is called, whttp was already freed (and is now null) and you are then trying to call ReadyState on that freed (null) object.
Another reason for confusion is that object.Free in Delphi for Windows/OS X destroys the object while in Smart it merely sets the object reference to nil and leaves the destruction to JavaScript's garbage collection. That's why the whttp is still alive after the Free and why the OnReadyStateChanged is called at all.
This works fine:
uses
W3System, W3Graphics, W3Components, W3Forms, W3Fonts, W3Borders, W3Application,
W3Button, W3Inet, W3Memo;
type
TForm1=class(TW3form)
procedure W3Button1Click(Sender: TObject);
private
{$I 'Form1:intf'}
whttp: TW3HttpRequest;
protected
procedure InitializeForm; override;
procedure InitializeObject; override;
procedure Resize; override;
end;
implementation
{ TForm1}
procedure TForm1.W3Button1Click(Sender: TObject);
var
wParams: string;
begin
whttp := TW3HttpRequest.Create;
whttp.OnReadyStateChange := lambda (Sender)
if (whttp.ReadyState = 4) and (wHttp.Status = 200) then
begin
W3Memo1.Text := wHttp.ResponseText;
whttp.OnReadyStateChange := nil;
whttp := nil;
end;
end;
wParams := 'cmd=TestID1';
whttp.open('POST','http://httpbin.org/post');
whttp.RequestHeaders['Content-type'] := 'application/x-www-form-urlencoded';
whttp.Send(wParams);
end;
RemObjects PascalScript.
How to get the value of the variable after compilation?
var a,b,c: integer;
begin
a := 5;
b := 6;
c := a+b;
end;
cc := IntTostr(????c????);
You have two options:
You can register a function with
Sender.AddDelphiFunction('procedure MyOwnFunction(Data: string)');
and
Exec := TPSExec.Create; // Create an instance of the executer.
Exec.RegisterDelphiFunction(#MyOwnFunction, 'MYOWNFUNCTION', cdRegister);
and then call it from within your script.
Alternatively, you can define your script as a function and set the Result. Then you can retrieve it with
TestFunc := TTestFunction(Exec.GetProcAsMethodN('Test'));
Both methods are demonstrated in this example:
program sample8;
uses
uPSCompiler,
uPSRuntime,
uPSUtils,
Dialogs;
procedure MyOwnFunction(const Data: string);
begin
// Do something with Data
ShowMessage(Data);
end;
{$IFDEF UNICODE}
function ScriptOnExportCheck(Sender: TPSPascalCompiler; Proc: TPSInternalProcedure; const ProcDecl: AnsiString): Boolean;
{$ELSE}
function ScriptOnExportCheck(Sender: TPSPascalCompiler; Proc: TPSInternalProcedure; const ProcDecl: string): Boolean;
{$ENDIF}
{
The OnExportCheck callback function is called for each function in the script
(Also for the main proc, with '!MAIN' as a Proc^.Name). ProcDecl contains the
result type and parameter types of a function using this format:
ProcDecl: ResultType + ' ' + Parameter1 + ' ' + Parameter2 + ' '+Parameter3 + .....
Parameter: ParameterType+TypeName
ParameterType is # for a normal parameter and ! for a var parameter.
A result type of 0 means no result.
}
begin
if Proc.Name = 'TEST' then // Check if the proc is the Test proc we want.
begin
if not ExportCheck(Sender, Proc, {$IFDEF UNICODE}[btUnicodeString, btUnicodeString]{$ELSE}[btString, btString]{$ENDIF}, [pmIn]) then // Check if the proc has the correct params.
begin
{ Something is wrong, so cause an error. }
Sender.MakeError('', ecTypeMismatch, '');
Result := False;
Exit;
end;
Result := True;
end else Result := True;
end;
{$IFDEF UNICODE}
function ScriptOnUses(Sender: TPSPascalCompiler; const Name: AnsiString): Boolean;
{$ELSE}
function ScriptOnUses(Sender: TPSPascalCompiler; const Name: string): Boolean;
{$ENDIF}
{ the OnUses callback function is called for each "uses" in the script.
It's always called with the parameter 'SYSTEM' at the top of the script.
For example: uses ii1, ii2;
This will call this function 3 times. First with 'SYSTEM' then 'II1' and then 'II2'.
}
begin
if Name = 'SYSTEM' then
begin
Sender.AddDelphiFunction('procedure MyOwnFunction(Data: string)');
{ This will register the function to the script engine. Now it can be used from within the script. }
Result := True;
end else
Result := False;
end;
type
TTestFunction = function (const s: string): string of object;
// Header of the test function, added of object.
procedure ExecuteScript(const Script: string);
var
Compiler: TPSPascalCompiler;
{ TPSPascalCompiler is the compiler part of the scriptengine. This will
translate a Pascal script into a compiled form the executer understands. }
Exec: TPSExec;
{ TPSExec is the executer part of the scriptengine. It uses the output of
the compiler to run a script. }
{$IFDEF UNICODE}Data: AnsiString;{$ELSE}Data: string;{$ENDIF}
TestFunc: TTestFunction;
begin
Compiler := TPSPascalCompiler.Create; // create an instance of the compiler.
Compiler.OnUses := ScriptOnUses; // assign the OnUses event.
Compiler.OnExportCheck := ScriptOnExportCheck; // Assign the onExportCheck event.
Compiler.AllowNoBegin := True;
Compiler.AllowNoEnd := True; // AllowNoBegin and AllowNoEnd allows it that begin and end are not required in a script.
if not Compiler.Compile(Script) then // Compile the Pascal script into bytecode.
begin
Compiler.Free;
// You could raise an exception here.
Exit;
end;
Compiler.GetOutput(Data); // Save the output of the compiler in the string Data.
Compiler.Free; // After compiling the script, there is no need for the compiler anymore.
Exec := TPSExec.Create; // Create an instance of the executer.
Exec.RegisterDelphiFunction(#MyOwnFunction, 'MYOWNFUNCTION', cdRegister);
if not Exec.LoadData(Data) then // Load the data from the Data string.
begin
{ For some reason the script could not be loaded. This is usually the case when a
library that has been used at compile time isn't registered at runtime. }
Exec.Free;
// You could raise an exception here.
Exit;
end;
TestFunc := TTestFunction(Exec.GetProcAsMethodN('Test'));
if #TestFunc <> nil then
ShowMessage('Result from TestFunc(''test indata''): '+TestFunc('test indata'));
Exec.Free; // Free the executer.
end;
const
Script = 'function test(s: string): string; begin MyOwnFunction(''Test Called with param: ''+s); Result := ''Test Result: ''+s; end;';
begin
ExecuteScript(Script);
end.