unit Unit1;

{$O-}
interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, PaxCompiler, PaxInvoke, PaxProgram, PaxRegister;
type
  TForm1 = class(TForm)
    PaxCompiler1: TPaxCompiler;
    PaxPascalLanguage1: TPaxPascalLanguage;
    PaxProgram1: TPaxProgram;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    PaxInvoke1: TPaxInvoke;
    Button4: TButton;
    Button5: TButton;
    Button6: TButton;
    Button7: TButton;
    Button8: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure Button7Click(Sender: TObject);
    procedure Button8Click(Sender: TObject);
  private
    { Private declarations }
  public
    function MyHostMethod(const X, Y: ShortString; Z: Integer): String;
    function Safe(X, Y: Integer): HResult; safecall;
    { Public declarations }
  end;

type
  ITest = interface
  ['{E7AA427A-0F4D-4A96-A914-FAB1CA336337}']
    procedure Proc(const S: String);
  end;

  TTest = class(TInterfacedObject, ITest)
  public
    procedure Proc(const S: String);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses
  IMPORT_SysUtils;

procedure TTest.Proc(const S: String);
begin
  ShowMessage(S);
end;

procedure TForm1.Button1Click(Sender: TObject);

procedure Print(const S: String);
begin
  ShowMessage(S);
end;

var
  H_MyFunc: Integer;
  I: Integer;
  P: Pointer;
begin
{$O-}
  PaxCompiler1.Reset;
  PaxCompiler1.RegisterLanguage(PaxPascalLanguage1);
  PaxCompiler1.RegisterHeader(0, 'procedure Print(const S: String);', @Print);

  PaxCompiler1.AddModule('1', PaxPascalLanguage1.LanguageName);
  PaxCompiler1.AddCode('1', 'uses SysUtils;');
  PaxCompiler1.AddCode('1', 'function MyFunc(U, V: Integer): Currency; cdecl;');
  PaxCompiler1.AddCode('1', 'begin');
  PaxCompiler1.AddCode('1', '  try');
  PaxCompiler1.AddCode('1', '    result := U / V;');
  PaxCompiler1.AddCode('1', '  except');
  PaxCompiler1.AddCode('1', '    on E: Exception do');
  PaxCompiler1.AddCode('1', '    begin');
  PaxCompiler1.AddCode('1', '      print(E.Message);');
  PaxCompiler1.AddCode('1', '      result := 7;');
  PaxCompiler1.AddCode('1', '    end;');
  PaxCompiler1.AddCode('1', '  end;');
  PaxCompiler1.AddCode('1', 'end;');
  PaxCompiler1.AddCode('1', 'begin');
  PaxCompiler1.AddCode('1', 'end.');

  if PaxCompiler1.Compile(PaxProgram1) then
  begin
    H_MyFunc := PaxCompiler1.GetHandle(0, 'MyFunc', true);

    P := PaxProgram1.GetAddress(H_MyFunc); // get address of script-defined function

    PaxInvoke1.Address := P;
    PaxInvoke1.This := nil; // this is not a method, but global function.
    PaxInvoke1.ClearArguments;
    PaxInvoke1.AddArgAsInteger(8);
    PaxInvoke1.AddArgAsInteger(2); // set it to '0' to try exeption handling
    PaxInvoke1.SetResultAsCurrency;
    PaxInvoke1.CallConv := _ccCDECL;

    PaxProgram1.SetEntryPoint(PaxInvoke1);
    PaxProgram1.Run;

    ShowMessage(CurrToStr(Currency(PaxInvoke1.GetResultPtr^)));
  end
  else
    for I:=0 to PaxCompiler1.ErrorCount do
      ShowMessage(PaxCompiler1.ErrorMessage[I]);
end;

procedure TForm1.Button2Click(Sender: TObject);

type
  TCharRec = record
    X, Y: Char;
  end;

function MyHostFunc(const U, V: TCharRec): String; stdcall;
begin
  result := U.X + V.Y;
end;

var
  R: TCharRec;
  S: String;
begin
  R.X := 'a';
  R.Y := 'b';

  PaxInvoke1.Address := @ MyHostFunc;
  PaxInvoke1.This := nil; // this is not a method
  PaxInvoke1.ClearArguments;
  PaxInvoke1.AddArgAsRecord(R, SizeOf(R));
  PaxInvoke1.AddArgAsRecord(R, SizeOf(R));
  PaxInvoke1.SetResultAsAnsiString;
  PaxInvoke1.CallConv := _ccSTDCALL;
  PaxInvoke1.CallHost; // call host-defined function
  S := String(PaxInvoke1.GetResultPtr^);
  ShowMessage(S);

  PaxInvoke1.ClearResult;
end;

function TForm1.MyHostMethod(const X, Y: ShortString; Z: Integer): String;
begin
  result := X + Y + IntToStr(Z);
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  PaxInvoke1.Address := @ TForm1.MyHostMethod;
  PaxInvoke1.This := Self; // we call a method
  PaxInvoke1.ClearArguments;
  PaxInvoke1.AddArgAsShortString('xyz');
  PaxInvoke1.AddArgAsShortString('uv');
  PaxInvoke1.AddArgAsInteger(8);
  PaxInvoke1.SetResultAsAnsiString;
  PaxInvoke1.CallConv := _ccREGISTER;
  PaxInvoke1.CallHost; 
  ShowMessage(String(PaxInvoke1.GetResultPtr^));

  PaxInvoke1.ClearResult;
end;

procedure TForm1.Button4Click(Sender: TObject);

procedure DynArrayProc(const A: array of String); cdecl;
begin
  ShowMessage(A[0] + A[1]);
end;

var
  A: array of string;
begin
  SetLength(A, 2);
  A[0] := 'abc';
  A[1] := 'pqr';

  PaxInvoke1.Address := @ DynArrayProc;
  PaxInvoke1.This := nil; // this is not a method
  PaxInvoke1.ClearArguments;
  PaxInvoke1.AddArgAsDynArray(A);
  PaxInvoke1.SetResultAsVoid;
  PaxInvoke1.CallConv := _ccCDECL;
  PaxInvoke1.CallHost; // call host-defined function
end;

procedure TForm1.Button5Click(Sender: TObject);

type
  TSetType = set of 'a'..'z';

procedure SetProc(S: TSetType);
begin
  if 'c' in S then
    ShowMessage('ok');
end;

var
  S: TSetType;
begin
  S := ['b'..'d'];

  PaxInvoke1.Address := @ SetProc;
  PaxInvoke1.This := nil; // this is not a method
  PaxInvoke1.ClearArguments;
  PaxInvoke1.AddArgAsSet(S, SizeOf(S));
  PaxInvoke1.SetResultAsVoid;
  PaxInvoke1.CallConv := _ccREGISTER;
  PaxInvoke1.CallHost; // call host-defined function
end;

procedure TForm1.Button6Click(Sender: TObject);
type
  TMyPoint = record
    x, y, z: Integer;
  end;
  TMyPoint2 = record
    x, y: Integer;
  end;
var
  a: array[0..5] of Double;
  r: TMyPoint;
  r2: TMyPoint2;
begin
  a[0] := 5.3;
  a[1] := 10.1;

  PaxInvoke1.This := nil; // this is not a method
  PaxInvoke1.CallConv := _ccMSFASTCALL;

  PaxInvoke1.LoadAddress('CppDll.dll', 'cube');
  PaxInvoke1.ClearArguments;
  PaxInvoke1.AddArgAsInteger(2);
  PaxInvoke1.SetResultAsInteger;
  PaxInvoke1.CallHost; // call host-defined function
  ShowMessage(IntToStr(Integer(PaxInvoke1.GetResultPtr^)));

  PaxInvoke1.LoadAddress('CppDll.dll', 'arr');
  PaxInvoke1.ClearArguments;
  PaxInvoke1.AddArgAsPointer(@a);
  PaxInvoke1.AddArgAsInteger(2);
  PaxInvoke1.AddArgAsInteger(3);
  PaxInvoke1.AddArgAsSingle(6.8);
  PaxInvoke1.SetResultAsDouble;
  PaxInvoke1.CallHost; // call host-defined function
  ShowMessage(FloatToStr(Double(PaxInvoke1.GetResultPtr^)));

  PaxInvoke1.LoadAddress('CppDll.dll', 'ret_char');
  PaxInvoke1.ClearArguments;
  PaxInvoke1.AddArgAsPChar('abc');
  PaxInvoke1.SetResultAsChar;
  PaxInvoke1.CallHost; // call host-defined function
  ShowMessage(Char(PaxInvoke1.GetResultPtr^));

  PaxInvoke1.LoadAddress('CppDll.dll', 'ret_struct');
  PaxInvoke1.ClearArguments;
  PaxInvoke1.AddArgAsInteger(2);
  PaxInvoke1.AddArgAsInteger(3);
  PaxInvoke1.AddArgAsInteger(5);
  PaxInvoke1.SetResultAsRecord(SizeOf(TMyPoint));
  PaxInvoke1.CallHost; // call host-defined function
  r := TMyPoint(PaxInvoke1.GetResultPtr^);
  ShowMessage(IntToStr(r.x) + ' ' + IntToStr(r.y) + ' ' + IntToStr(r.z));

  PaxInvoke1.LoadAddress('CppDll.dll', 'ret_struct2');
  PaxInvoke1.ClearArguments;
  PaxInvoke1.AddArgAsInteger(2);
  PaxInvoke1.AddArgAsInteger(3);
  PaxInvoke1.SetResultAsRecord(SizeOf(TMyPoint2));
  PaxInvoke1.CallHost; // call host-defined function
  r2 := TMyPoint2(PaxInvoke1.GetResultPtr^);
  ShowMessage(IntToStr(r.x) + ' ' + IntToStr(r.y));

  PaxInvoke1.LoadAddress('CppDll.dll', 'pass_struct');
  PaxInvoke1.ClearArguments;
  PaxInvoke1.AddArgAsPointer(@ r);
  PaxInvoke1.SetResultAsRecord(SizeOf(TMyPoint));
  PaxInvoke1.CallHost; // call host-defined function
  r := TMyPoint(PaxInvoke1.GetResultPtr^);
  ShowMessage(IntToStr(r.x) + ' ' + IntToStr(r.y) + ' ' + IntToStr(r.z));

  PaxInvoke1.LoadAddress('CppDll.dll', 'pass_struct_byval');
  PaxInvoke1.ClearArguments;
  PaxInvoke1.AddArgAsRecordByVal(r, SizeOf(r));
  PaxInvoke1.SetResultAsRecord(SizeOf(TMyPoint));
  PaxInvoke1.CallHost; // call host-defined function
  r := TMyPoint(PaxInvoke1.GetResultPtr^);
  ShowMessage(IntToStr(r.x) + ' ' + IntToStr(r.y) + ' ' + IntToStr(r.z));

  PaxInvoke1.LoadAddress('CppDll.dll', 'dcube');
  PaxInvoke1.ClearArguments;
  PaxInvoke1.AddArgAsDouble(2);
  PaxInvoke1.SetResultAsDouble;
  PaxInvoke1.CallHost; // call host-defined function
  ShowMessage(FloatToStr(Double(PaxInvoke1.GetResultPtr^)));
end;

function TForm1.Safe(X, Y: Integer): HResult; safecall;
begin
  result := X + Y;
end;

procedure TForm1.Button7Click(Sender: TObject);

function P(X, Y: Currency): String; safecall;
begin
  result := CurrToStr(X + Y);
end;

begin
  PaxInvoke1.This := nil; // this is not a method
  PaxInvoke1.CallConv := _ccSAFECALL;
  PaxInvoke1.Address := @P;
  PaxInvoke1.ClearArguments;
  PaxInvoke1.AddArgAsCurrency(2.2);
  PaxInvoke1.AddArgAsCurrency(3.4);
  PaxInvoke1.SetResultAsAnsiString;
  PaxInvoke1.CallHost; // call host-defined function
  ShowMessage(String(PaxInvoke1.GetResultPtr^));
  PaxInvoke1.ClearResult;

  PaxInvoke1.This := Self; // this is a method
  PaxInvoke1.CallConv := _ccSAFECALL;
  PaxInvoke1.Address := @TForm1.Safe;
  PaxInvoke1.ClearArguments;
  PaxInvoke1.AddArgAsInteger(2);
  PaxInvoke1.AddArgAsInteger(3);
  PaxInvoke1.SetResultAsInteger;
  PaxInvoke1.CallHost; // call host-defined function
  ShowMessage(IntToStr(Integer(PaxInvoke1.GetResultPtr^)));
end;

procedure TForm1.Button8Click(Sender: TObject);

function GetIntf(I: ITest): ITest;
begin
  if Assigned(I) then
    result := I
  else
    result := TTest.Create;
end;

var
  I, J: ITest;
begin
  J := TTest.Create;
  
  PaxInvoke1.This := nil; // this is not a method
  PaxInvoke1.CallConv := _ccREGISTER;
  PaxInvoke1.Address := @GetIntf;
  PaxInvoke1.ClearArguments;
  PaxInvoke1.AddArgAsInterface(J);
  PaxInvoke1.SetResultAsInterface;
  PaxInvoke1.CallHost; // call host-defined function
  IUnknown(I) := IUnknown(PaxInvoke1.GetResultPtr^);
  I.Proc('hello');

  PaxInvoke1.ClearResult;
end;

end.
