paweld/pas2js
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/pas2js.git synced 2025-09-23 22:39:26 +02:00
Code Issues Packages Projects Releases Wiki Activity

wasi: job: read/write property

Browse Source
This commit is contained in:
mattias 2022-05-25 14:31:44 +02:00
parent 3496007ff2
commit 0bd91a14dd
6 changed files with 261 additions and 116 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
demo/wasienv/dom/BrowserDomTest1.lpi
View File

@ -43,6 +43,7 @@
<Unit> <Unit>
<Filename Value="job_browser.pp"/> <Filename Value="job_browser.pp"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<UnitName Value="JOB_Browser"/>
</Unit> </Unit>
</Units> </Units>
</ProjectOptions> </ProjectOptions>

2
demo/wasienv/dom/BrowserDomTest1.lpr
View File

@ -17,6 +17,8 @@ Type
procedure Proc; procedure Proc;
function ArgsToStr(Args: TJSFunctionArguments): string; function ArgsToStr(Args: TJSFunctionArguments): string;
published published
Size: integer;
Caption: string;
function GetBoolean: boolean; function GetBoolean: boolean;
function GetDouble: double; function GetDouble: double;
function GetString: string; function GetString: string;

27
demo/wasienv/dom/WasiDomTest1.lpr
View File

@ -12,13 +12,27 @@ type
{ TBird } { TBird }
TBird = class(TJSObject) TBird = class(TJSObject)
private
function GetSize: integer;
procedure SetSize(const AValue: integer);
public public
function GetDouble: double; function GetDouble: double;
function GetInteger: integer; function GetInteger: integer;
property Size: integer read GetSize write SetSize;
end; end;
{ TBird } { TBird }
function TBird.GetSize: integer;
begin
Result:=ReadJSPropertyLongInt('Size');
end;
procedure TBird.SetSize(const AValue: integer);
begin
WriteJSPropertyLongInt('Size',AValue);
end;
function TBird.GetDouble: double; function TBird.GetDouble: double;
begin begin
Result:=InvokeJSDoubleResult('GetDouble',[]); Result:=InvokeJSDoubleResult('GetDouble',[]);
@ -40,16 +54,15 @@ begin
writeln('AAA1 '); writeln('AAA1 ');
u:='äbc'; u:='äbc';
u:=obj.InvokeJSUnicodeStringResult('GetString',[u]);
writeln('AAA2 u="',u,'"');
//obj.InvokeJSNoResult('Proc',[]); //obj.InvokeJSNoResult('Proc',[]);
//d:=obj.InvokeJSDoubleResult('GetDouble',[u,12345678901]); //d:=obj.InvokeJSDoubleResult('GetDouble',[u,12345678901]);
Freddy:=obj.InvokeJSObjResult('CreateChick',TBird,['Freddy']) as TBird; Freddy:=obj.InvokeJSObjResult('CreateChick',['Freddy'],TBird) as TBird;
writeln('AAA3 '); writeln('AAA3 ');
i:=Freddy.GetInteger; Freddy.Size:=81;
writeln('AAA4 ',i); writeln('AAA4 ');
i:=Freddy.Size;
writeln('AAA5 ',i);
Freddy.Free; Freddy.Free;
writeln('AAA5 '); writeln('AAA6 ');
end. end.

82
demo/wasienv/dom/job_browser.pp
View File

@ -24,12 +24,12 @@ Type
FStringResult: string; FStringResult: string;
Protected Protected
function FindObject(ObjId: TJOBObjectID): TJSObject; virtual; function FindObject(ObjId: TJOBObjectID): TJSObject; virtual;
function Invoke_JSResult(ObjId: TJOBObjectID; FuncNameP, FuncNameLen, ArgsP: NativeInt; out JSResult: JSValue): TJOBResult; virtual; function Invoke_JSResult(ObjId: TJOBObjectID; NameP, NameLen, Invoke, ArgsP: NativeInt; out JSResult: JSValue): TJOBResult; virtual;
function Invoke_NoResult(ObjId: TJOBObjectID; FuncNameP, FuncNameLen, ArgsP, Dummy: NativeInt): TJOBResult; virtual; function Invoke_NoResult(ObjId: TJOBObjectID; NameP, NameLen, Invoke, ArgsP: NativeInt): TJOBResult; virtual;
function Invoke_BooleanResult(ObjId: TJOBObjectID; FuncNameP, FuncNameLen, ArgsP, ResultP: NativeInt): TJOBResult; virtual; function Invoke_BooleanResult(ObjId: TJOBObjectID; NameP, NameLen, Invoke, ArgsP, ResultP: NativeInt): TJOBResult; virtual;
function Invoke_DoubleResult(ObjId: TJOBObjectID; FuncNameP, FuncNameLen, ArgsP, ResultP: NativeInt): TJOBResult; virtual; function Invoke_DoubleResult(ObjId: TJOBObjectID; NameP, NameLen, Invoke, ArgsP, ResultP: NativeInt): TJOBResult; virtual;
function Invoke_StringResult(ObjId: TJOBObjectID; FuncNameP, FuncNameLen, ArgsP, ResultP: NativeInt): TJOBResult; virtual; function Invoke_StringResult(ObjId: TJOBObjectID; NameP, NameLen, Invoke, ArgsP, ResultP: NativeInt): TJOBResult; virtual;
function Invoke_ObjectResult(ObjId: TJOBObjectID; FuncNameP, FuncNameLen, ArgsP, ResultP: NativeInt): TJOBResult; virtual; function Invoke_ObjectResult(ObjId: TJOBObjectID; NameP, NameLen, Invoke, ArgsP, ResultP: NativeInt): TJOBResult; virtual;
function ReleaseObject(ObjId: TJOBObjectID): TJOBResult; virtual; function ReleaseObject(ObjId: TJOBObjectID): TJOBResult; virtual;
function GetStringResult(ResultP: NativeInt): TJOBResult; virtual; function GetStringResult(ResultP: NativeInt): TJOBResult; virtual;
function ReleaseStringResult: TJOBResult; virtual; function ReleaseStringResult: TJOBResult; virtual;
@ -93,29 +93,32 @@ begin
Result:=nil; Result:=nil;
end; end;
function TJOBBridge.Invoke_JSResult(ObjId: TJOBObjectID; FuncNameP, function TJOBBridge.Invoke_JSResult(ObjId: TJOBObjectID; NameP, NameLen,
FuncNameLen, ArgsP: NativeInt; out JSResult: JSValue): TJOBResult; Invoke, ArgsP: NativeInt; out JSResult: JSValue): TJOBResult;
var var
View: TJSDataView; View: TJSDataView;
aBytes: TJSUint8Array; aBytes: TJSUint8Array;
FuncName: String; PropName: String;
Args: TJSValueDynArray; Args: TJSValueDynArray;
Obj: TJSObject; Obj: TJSObject;
fn: JSValue; fn: JSValue;
begin begin
//writeln('TJOBBridge.Invoke_JSResult ObjId=',ObjId,' FuncNameP=',FuncNameP,' FuncNameLen=',FuncNameLen,' ArgsP=',ArgsP); writeln('TJOBBridge.Invoke_JSResult ObjId=',ObjId,' FuncNameP=',NameP,' FuncNameLen=',NameLen,' ArgsP=',ArgsP,' Invoke=',Invoke);
Obj:=FindObject(ObjId); Obj:=FindObject(ObjId);
if Obj=nil then if Obj=nil then
exit(JOBResult_UnknownObjId); exit(JOBResult_UnknownObjId);
View:=getModuleMemoryDataView(); View:=getModuleMemoryDataView();
aBytes:=TJSUint8Array.New(View.buffer, FuncNameP, FuncNameLen); aBytes:=TJSUint8Array.New(View.buffer, NameP, NameLen);
//writeln('TJOBBridge.Invoke_JSResult aBytes=',aBytes); //writeln('TJOBBridge.Invoke_JSResult aBytes=',aBytes);
FuncName:=TypedArrayToString(aBytes); PropName:=TypedArrayToString(aBytes);
//writeln('TJOBBridge.Invoke_JSResult FuncName="',FuncName,'"'); writeln('TJOBBridge.Invoke_JSResult PropName="',PropName,'"');
fn:=Obj[FuncName]; case Invoke of
JOBInvokeCall:
begin
fn:=Obj[PropName];
if jstypeof(fn)<>'function' then if jstypeof(fn)<>'function' then
exit(JOBResult_NotAFunction); exit(JOBResult_NotAFunction);
@ -125,27 +128,47 @@ begin
Args:=GetInvokeArguments(View,ArgsP); Args:=GetInvokeArguments(View,ArgsP);
JSResult:=TJSFunction(fn).apply(Obj,Args); JSResult:=TJSFunction(fn).apply(Obj,Args);
end; end;
end;
JOBInvokeGetter:
begin
if ArgsP>0 then
exit(JOBResult_WrongArgs);
JSResult:=Obj[PropName];
end;
JOBInvokeSetter:
begin
JSResult:=Undefined;
if ArgsP=0 then
exit(JOBResult_WrongArgs);
Args:=GetInvokeArguments(View,ArgsP);
if length(Args)<>1 then
exit(JOBResult_WrongArgs);
Obj[PropName]:=Args[0];
end
else
exit(JOBResult_NotAFunction);
end;
Result:=JOBResult_Success; Result:=JOBResult_Success;
end; end;
function TJOBBridge.Invoke_NoResult(ObjId: TJOBObjectID; FuncNameP, function TJOBBridge.Invoke_NoResult(ObjId: TJOBObjectID; NameP, NameLen,
FuncNameLen, ArgsP, Dummy: NativeInt): TJOBResult; Invoke, ArgsP: NativeInt): TJOBResult;
var var
JSResult: JSValue; JSResult: JSValue;
begin begin
// invoke // invoke
Result:=Invoke_JSResult(ObjId,FuncNameP,FuncNameLen,ArgsP,JSResult); Result:=Invoke_JSResult(ObjId,NameP,NameLen,Invoke,ArgsP,JSResult);
end; end;
function TJOBBridge.Invoke_BooleanResult(ObjId: TJOBObjectID; FuncNameP, function TJOBBridge.Invoke_BooleanResult(ObjId: TJOBObjectID; NameP, NameLen,
FuncNameLen, ArgsP, ResultP: NativeInt): TJOBResult; Invoke, ArgsP, ResultP: NativeInt): TJOBResult;
var var
JSResult: JSValue; JSResult: JSValue;
b: byte; b: byte;
begin begin
// invoke // invoke
Result:=Invoke_JSResult(ObjId,FuncNameP,FuncNameLen,ArgsP,JSResult); Result:=Invoke_JSResult(ObjId,NameP,NameLen,Invoke,ArgsP,JSResult);
if Result<>JOBResult_Success then if Result<>JOBResult_Success then
exit; exit;
// check result type // check result type
@ -160,13 +183,13 @@ begin
Result:=JOBResult_Boolean; Result:=JOBResult_Boolean;
end; end;
function TJOBBridge.Invoke_DoubleResult(ObjId: TJOBObjectID; FuncNameP, function TJOBBridge.Invoke_DoubleResult(ObjId: TJOBObjectID; NameP, NameLen,
FuncNameLen, ArgsP, ResultP: NativeInt): TJOBResult; Invoke, ArgsP, ResultP: NativeInt): TJOBResult;
var var
JSResult: JSValue; JSResult: JSValue;
begin begin
// invoke // invoke
Result:=Invoke_JSResult(ObjId,FuncNameP,FuncNameLen,ArgsP,JSResult); Result:=Invoke_JSResult(ObjId,NameP,NameLen,Invoke,ArgsP,JSResult);
if Result<>JOBResult_Success then if Result<>JOBResult_Success then
exit; exit;
// check result type // check result type
@ -177,13 +200,13 @@ begin
Result:=JOBResult_Double; Result:=JOBResult_Double;
end; end;
function TJOBBridge.Invoke_StringResult(ObjId: TJOBObjectID; FuncNameP, function TJOBBridge.Invoke_StringResult(ObjId: TJOBObjectID; NameP, NameLen,
FuncNameLen, ArgsP, ResultP: NativeInt): TJOBResult; Invoke, ArgsP, ResultP: NativeInt): TJOBResult;
var var
JSResult: JSValue; JSResult: JSValue;
begin begin
// invoke // invoke
Result:=Invoke_JSResult(ObjId,FuncNameP,FuncNameLen,ArgsP,JSResult); Result:=Invoke_JSResult(ObjId,NameP,NameLen,Invoke,ArgsP,JSResult);
if Result<>JOBResult_Success then if Result<>JOBResult_Success then
exit; exit;
// check result type // check result type
@ -196,14 +219,15 @@ begin
getModuleMemoryDataView().setInt32(ResultP, length(FStringResult), env.IsLittleEndian); getModuleMemoryDataView().setInt32(ResultP, length(FStringResult), env.IsLittleEndian);
end; end;
function TJOBBridge.Invoke_ObjectResult(ObjId: TJOBObjectID; FuncNameP, function TJOBBridge.Invoke_ObjectResult(ObjId: TJOBObjectID; NameP, NameLen,
FuncNameLen, ArgsP, ResultP: NativeInt): TJOBResult; Invoke, ArgsP, ResultP: NativeInt): TJOBResult;
var var
t: String; t: String;
JSResult, NewId: JSValue; JSResult, NewId: JSValue;
begin begin
// invoke // invoke
Result:=Invoke_JSResult(ObjId,FuncNameP,FuncNameLen,ArgsP,JSResult); Result:=Invoke_JSResult(ObjId,NameP,NameLen,Invoke,ArgsP,JSResult);
writeln('BBB1 TJOBBridge.Invoke_ObjectResult ',Result,' JSResult=',JSResult);
if Result<>JOBResult_Success then if Result<>JOBResult_Success then
exit; exit;
// check result type // check result type

28
demo/wasienv/dom/job_shared.pp
View File

@ -18,24 +18,26 @@ const
JOBResult_Success = 1; JOBResult_Success = 1;
JOBResult_UnknownObjId = 2; JOBResult_UnknownObjId = 2;
JOBResult_NotAFunction = 3; JOBResult_NotAFunction = 3;
JOBResult_Undefined = 4; JOBResult_WrongArgs = 4;
JOBResult_Null = 5; JOBResult_Undefined = 5;
JOBResult_Boolean = 6; JOBResult_Null = 6;
JOBResult_Number = 7; JOBResult_Boolean = 7;
JOBResult_Double = 8; JOBResult_Number = 8;
JOBResult_String = 9; JOBResult_Double = 9;
JOBResult_Function = 10; JOBResult_String = 10;
JOBResult_Object = 11; JOBResult_Function = 11;
JOBResult_BigInt = 12; JOBResult_Object = 12;
JOBResult_Symbol = 13; JOBResult_BigInt = 13;
JOBResult_Symbol = 14;
JOBResultLast = 13; JOBResultLast = 14;
JOBResult_Names: array[0..JOBResultLast] of string = ( JOBResult_Names: array[0..JOBResultLast] of string = (
'None', 'None',
'Success', 'Success',
'UnknownObjId', 'UnknownObjId',
'NotAFunction', 'NotAFunction',
'WrongArgs',
'Undefined', 'Undefined',
'Null', 'Null',
'Boolean', 'Boolean',
@ -68,6 +70,10 @@ const
JOBArgUnicodeString = 7; // followed by length and pointer JOBArgUnicodeString = 7; // followed by length and pointer
JOBArgPointer = 8; JOBArgPointer = 8;
JOBInvokeCall = 0;
JOBInvokeGetter = 1;
JOBInvokeSetter = 2;
JOBObjIdDocument = -1; JOBObjIdDocument = -1;
JOBObjIdWindow = -2; JOBObjIdWindow = -2;
JOBObjIdConsole = -3; JOBObjIdConsole = -3;

223
demo/wasienv/dom/job_wasm.pas
View File

@ -31,12 +31,22 @@ Type
PJOBObjectID = ^TJOBObjectID; PJOBObjectID = ^TJOBObjectID;
TJOBInvokeOneResultFunc = function( TJOBInvokeOneResultFunc = function(
ObjID: TJOBObjectID; ObjID: TJOBObjectID;
FuncNameP: PChar; NameP: PChar;
FuncNameLen: longint; NameLen: longint;
Invoke: longint;
ArgP: PByte; ArgP: PByte;
ResultP: PByte ResultP: PByte
): TJOBResult; ): TJOBResult;
TJOBInvokeGetType = (
jigCall, // call function
jigGetter // read property
);
TJOBInvokeSetType = (
jisCall, // call function
jisSetter // write property
);
TJSObject = class; TJSObject = class;
TJSObjectClass = class of TJSObject; TJSObjectClass = class of TJSObject;
@ -47,23 +57,36 @@ Type
FObjectID: TJOBObjectID; FObjectID: TJOBObjectID;
protected protected
function InvokeJSOneResult(const aName: string; Const Args: Array of const; function InvokeJSOneResult(const aName: string; Const Args: Array of const;
const InvokeFunc: TJOBInvokeOneResultFunc; ResultP: PByte): TJOBResult; const InvokeFunc: TJOBInvokeOneResultFunc; ResultP: PByte; Invoke: TJOBInvokeGetType): TJOBResult;
procedure InvokeRaise(const aName, Msg: string); virtual; procedure InvokeJS_Raise(const aName, Msg: string); virtual;
procedure InvokeRaiseResultMismatch(const aName: string; Expected, Actual: TJOBResult); virtual; procedure InvokeJS_RaiseResultMismatch(const aName: string; Expected, Actual: TJOBResult); virtual;
procedure InvokeRaiseResultMismatchStr(const aName: string; const Expected, Actual: string); virtual; procedure InvokeJS_RaiseResultMismatchStr(const aName: string; const Expected, Actual: string); virtual;
function CreateInvokeJSArgs(const Args: array of const): PByte; virtual; function CreateInvokeJSArgs(const Args: array of const): PByte; virtual;
public public
constructor CreateFromID(aID: TJOBObjectID); virtual; constructor CreateFromID(aID: TJOBObjectID); virtual;
destructor Destroy; override; destructor Destroy; override;
property ObjectID: TJOBObjectID read FObjectID; property ObjectID: TJOBObjectID read FObjectID;
procedure InvokeJSNoResult(const aName: string; Const Args: Array of const); virtual; procedure InvokeJSNoResult(const aName: string; Const Args: Array of const; Invoke: TJOBInvokeSetType = jisCall); virtual;
function InvokeJSBooleanResult(const aName: string; Const Args: Array of const): Boolean; virtual; function InvokeJSBooleanResult(const aName: string; Const Args: Array of const; Invoke: TJOBInvokeGetType = jigCall): Boolean; virtual;
function InvokeJSDoubleResult(const aName: string; Const Args: Array of const): Double; virtual; function InvokeJSDoubleResult(const aName: string; Const Args: Array of const; Invoke: TJOBInvokeGetType = jigCall): Double; virtual;
function InvokeJSUnicodeStringResult(const aName: string; Const Args: Array of const): UnicodeString; virtual; function InvokeJSUnicodeStringResult(const aName: string; Const Args: Array of const; Invoke: TJOBInvokeGetType = jigCall): UnicodeString; virtual;
function InvokeJSObjResult(const aName: string; aResultClass: TJSObjectClass; Const Args: Array of const): TJSObject; virtual; function InvokeJSObjResult(const aName: string; Const Args: Array of const; aResultClass: TJSObjectClass; Invoke: TJOBInvokeGetType = jigCall): TJSObject; virtual;
// ToDo: InvokeJSVarRecResult // ToDo: InvokeJSValueResult
function InvokeJSUtf8StringResult(const aName: string; Const args: Array of const): String; virtual; function InvokeJSUtf8StringResult(const aName: string; Const args: Array of const; Invoke: TJOBInvokeGetType = jigCall): String; virtual;
function InvokeJSLongIntResult(const aName: string; Const args: Array of const): LongInt; virtual; function InvokeJSLongIntResult(const aName: string; Const args: Array of const; Invoke: TJOBInvokeGetType = jigCall): LongInt; virtual;
function ReadJSPropertyBoolean(const aName: string): boolean; virtual;
function ReadJSPropertyDouble(const aName: string): double; virtual;
function ReadJSPropertyUnicodeString(const aName: string): UnicodeString; virtual;
function ReadJSPropertyObject(const aName: string; aResultClass: TJSObjectClass): TJSObject; virtual;
function ReadJSPropertyUtf8String(const aName: string): string; virtual;
function ReadJSPropertyLongInt(const aName: string): LongInt; virtual;
// ToDo: get JSValue property
procedure WriteJSPropertyBoolean(const aName: string; Value: Boolean); virtual;
procedure WriteJSPropertyDouble(const aName: string; Value: Double); virtual;
procedure WriteJSPropertyUnicodeString(const aName: string; const Value: UnicodeString); virtual;
procedure WriteJSPropertyUtf8String(const aName: string; const Value: String); virtual;
// ToDo: procedure WriteJSPropertyObject(const aName: string; AnObjectID: TJOBObjectID); virtual;
procedure WriteJSPropertyLongInt(const aName: string; Value: LongInt); virtual;
end; end;
var var
@ -71,32 +94,35 @@ var
function __job_invoke_noresult( function __job_invoke_noresult(
ObjID: TJOBObjectID; ObjID: TJOBObjectID;
FuncNameP: PChar; NameP: PChar;
FuncNameLen: longint; NameLen: longint;
ArgP: PByte; Invoke: longint;
Dummy: PByte ArgP: PByte
): TJOBResult; external JOBExportName name JOBFn_InvokeNoResult; ): TJOBResult; external JOBExportName name JOBFn_InvokeNoResult;
function __job_invoke_boolresult( function __job_invoke_boolresult(
ObjID: TJOBObjectID; ObjID: TJOBObjectID;
FuncNameP: PChar; NameP: PChar;
FuncNameLen: longint; NameLen: longint;
Invoke: longint;
ArgP: PByte; ArgP: PByte;
ResultP: PByte // bytebool ResultP: PByte // bytebool
): TJOBResult; external JOBExportName name JOBFn_InvokeBooleanResult; ): TJOBResult; external JOBExportName name JOBFn_InvokeBooleanResult;
function __job_invoke_doubleresult( function __job_invoke_doubleresult(
ObjID: TJOBObjectID; ObjID: TJOBObjectID;
FuncNameP: PChar; NameP: PChar;
FuncNameLen: longint; NameLen: longint;
Invoke: longint;
ArgP: PByte; ArgP: PByte;
ResultP: PByte // double ResultP: PByte // double
): TJOBResult; external JOBExportName name JOBFn_InvokeDoubleResult; ): TJOBResult; external JOBExportName name JOBFn_InvokeDoubleResult;
function __job_invoke_stringresult( function __job_invoke_stringresult(
ObjID: TJOBObjectID; ObjID: TJOBObjectID;
FuncNameP: PChar; NameP: PChar;
FuncNameLen: longint; NameLen: longint;
Invoke: longint;
ArgP: PByte; ArgP: PByte;
ResultLenP: PByte // length ResultLenP: PByte // length
): TJOBResult; external JOBExportName name JOBFn_InvokeStringResult; ): TJOBResult; external JOBExportName name JOBFn_InvokeStringResult;
@ -110,8 +136,9 @@ function __job_releasestringresult(
function __job_invoke_objectresult( function __job_invoke_objectresult(
ObjID: TJOBObjectID; ObjID: TJOBObjectID;
FuncNameP: PChar; NameP: PChar;
FuncNameLen: longint; NameLen: longint;
Invoke: longint;
ArgP: PByte; ArgP: PByte;
ResultP: PByte // nativeint ResultP: PByte // nativeint
): TJOBResult; external JOBExportName name JOBFn_InvokeObjectResult; ): TJOBResult; external JOBExportName name JOBFn_InvokeObjectResult;
@ -122,6 +149,16 @@ function __job_release_object(
implementation implementation
const
InvokeGetToInt: array[TJOBInvokeGetType] of integer = (
JOBInvokeCall,
JOBInvokeGetter
);
InvokeSetToInt: array[TJOBInvokeSetType] of integer = (
JOBInvokeCall,
JOBInvokeSetter
);
{$IFDEF VerboseJOB} {$IFDEF VerboseJOB}
function GetVarRecName(vt: word): string; function GetVarRecName(vt: word): string;
begin begin
@ -155,17 +192,18 @@ end;
{ TJSObject } { TJSObject }
function TJSObject.InvokeJSOneResult(const aName: string; const Args: array of const; function TJSObject.InvokeJSOneResult(const aName: string;
const InvokeFunc: TJOBInvokeOneResultFunc; ResultP: PByte): TJOBResult; const Args: array of const; const InvokeFunc: TJOBInvokeOneResultFunc;
ResultP: PByte; Invoke: TJOBInvokeGetType): TJOBResult;
var var
InvokeArgs: PByte; InvokeArgs: PByte;
begin begin
if length(Args)=0 then if length(Args)=0 then
Result:=InvokeFunc(ObjectID,PChar(aName),length(aName),nil,ResultP) Result:=InvokeFunc(ObjectID,PChar(aName),length(aName),InvokeGetToInt[Invoke],nil,ResultP)
else begin else begin
InvokeArgs:=CreateInvokeJSArgs(Args); InvokeArgs:=CreateInvokeJSArgs(Args);
try try
Result:=InvokeFunc(ObjectID,PChar(aName),length(aName),InvokeArgs,ResultP); Result:=InvokeFunc(ObjectID,PChar(aName),length(aName),InvokeGetToInt[Invoke],InvokeArgs,ResultP);
finally finally
if InvokeArgs<>nil then if InvokeArgs<>nil then
FreeMem(InvokeArgs); FreeMem(InvokeArgs);
@ -173,7 +211,7 @@ begin
end; end;
end; end;
procedure TJSObject.InvokeRaise(const aName, Msg: string); procedure TJSObject.InvokeJS_Raise(const aName, Msg: string);
var var
E: EJSInvoke; E: EJSInvoke;
begin begin
@ -183,21 +221,21 @@ begin
raise E; raise E;
end; end;
procedure TJSObject.InvokeRaiseResultMismatch(const aName: string; procedure TJSObject.InvokeJS_RaiseResultMismatch(const aName: string;
Expected, Actual: TJOBResult); Expected, Actual: TJOBResult);
begin begin
case Actual of case Actual of
JOBResult_UnknownObjId: InvokeRaise(aName,'unknown object id '+IntToStr(ObjectID)); JOBResult_UnknownObjId: InvokeJS_Raise(aName,'unknown object id '+IntToStr(ObjectID));
JOBResult_NotAFunction: InvokeRaise(aName,'object '+IntToStr(ObjectID)+' does not have a function "'+aName+'"'); JOBResult_NotAFunction: InvokeJS_Raise(aName,'object '+IntToStr(ObjectID)+' does not have a function "'+aName+'"');
else else
InvokeRaiseResultMismatchStr(aName,JOBResult_Names[Expected],JOBResult_Names[Actual]); InvokeJS_RaiseResultMismatchStr(aName,JOBResult_Names[Expected],JOBResult_Names[Actual]);
end; end;
end; end;
procedure TJSObject.InvokeRaiseResultMismatchStr(const aName: string; procedure TJSObject.InvokeJS_RaiseResultMismatchStr(const aName: string;
const Expected, Actual: string); const Expected, Actual: string);
begin begin
InvokeRaise(aName,'expected '+Expected+', but got '+Actual+' from object '+IntToStr(ObjectID)+' function "'+aName+'"'); InvokeJS_Raise(aName,'expected '+Expected+', but got '+Actual+' from object '+IntToStr(ObjectID)+' function "'+aName+'"');
end; end;
function TJSObject.CreateInvokeJSArgs(const Args: array of const): PByte; function TJSObject.CreateInvokeJSArgs(const Args: array of const): PByte;
@ -249,7 +287,10 @@ begin
strlen(Args[i].VPChar); strlen(Args[i].VPChar);
inc(Len,1+SizeOf(NativeInt)+SizeOf(PByte)); inc(Len,1+SizeOf(NativeInt)+SizeOf(PByte));
end; end;
vtObject : RaiseNotSupported('object'); vtObject :
begin
RaiseNotSupported('object');
end;
vtClass : RaiseNotSupported('class'); vtClass : RaiseNotSupported('class');
vtPWideChar : RaiseNotSupported('pwidechar'); vtPWideChar : RaiseNotSupported('pwidechar');
vtAnsiString : inc(Len,1+SizeOf(NativeInt)+SizeOf(PByte)); vtAnsiString : inc(Len,1+SizeOf(NativeInt)+SizeOf(PByte));
@ -458,60 +499,60 @@ begin
end; end;
procedure TJSObject.InvokeJSNoResult(const aName: string; procedure TJSObject.InvokeJSNoResult(const aName: string;
const Args: array of const); const Args: array of const; Invoke: TJOBInvokeSetType);
var var
aError: TJOBResult; aError: TJOBResult;
InvokeArgs: PByte; InvokeArgs: PByte;
begin begin
if length(Args)=0 then if length(Args)=0 then
aError:=__job_invoke_noresult(ObjectID,PChar(aName),length(aName),nil,nil) aError:=__job_invoke_noresult(ObjectID,PChar(aName),length(aName),InvokeSetToInt[Invoke],nil)
else begin else begin
InvokeArgs:=CreateInvokeJSArgs(Args); InvokeArgs:=CreateInvokeJSArgs(Args);
try try
aError:=__job_invoke_noresult(ObjectID,PChar(aName),length(aName),InvokeArgs,nil); aError:=__job_invoke_noresult(ObjectID,PChar(aName),length(aName),InvokeSetToInt[Invoke],InvokeArgs);
finally finally
if InvokeArgs<>nil then if InvokeArgs<>nil then
FreeMem(InvokeArgs); FreeMem(InvokeArgs);
end; end;
end; end;
if aError<>JOBResult_Success then if aError<>JOBResult_Success then
InvokeRaiseResultMismatch(aName,JOBResult_Success,aError); InvokeJS_RaiseResultMismatch(aName,JOBResult_Success,aError);
end; end;
function TJSObject.InvokeJSBooleanResult(const aName: string; function TJSObject.InvokeJSBooleanResult(const aName: string;
const Args: array of const): Boolean; const Args: array of const; Invoke: TJOBInvokeGetType): Boolean;
var var
aError: TJOBResult; aError: TJOBResult;
b: bytebool; b: bytebool;
begin begin
b:=false; b:=false;
aError:=InvokeJSOneResult(aName,Args,@__job_invoke_boolresult,@b); aError:=InvokeJSOneResult(aName,Args,@__job_invoke_boolresult,@b,Invoke);
if aError<>JOBResult_Boolean then if aError<>JOBResult_Boolean then
InvokeRaiseResultMismatch(aName,JOBResult_Boolean,aError); InvokeJS_RaiseResultMismatch(aName,JOBResult_Boolean,aError);
Result:=b; Result:=b;
end; end;
function TJSObject.InvokeJSDoubleResult(const aName: string; function TJSObject.InvokeJSDoubleResult(const aName: string;
const Args: array of const): Double; const Args: array of const; Invoke: TJOBInvokeGetType): Double;
var var
aError: TJOBResult; aError: TJOBResult;
begin begin
Result:=NaN; Result:=NaN;
aError:=InvokeJSOneResult(aName,Args,@__job_invoke_doubleresult,@Result); aError:=InvokeJSOneResult(aName,Args,@__job_invoke_doubleresult,@Result,Invoke);
if aError<>JOBResult_Double then if aError<>JOBResult_Double then
InvokeRaiseResultMismatch(aName,JOBResult_Double,aError); InvokeJS_RaiseResultMismatch(aName,JOBResult_Double,aError);
end; end;
function TJSObject.InvokeJSUnicodeStringResult(const aName: string; function TJSObject.InvokeJSUnicodeStringResult(const aName: string;
const Args: array of const): UnicodeString; const Args: array of const; Invoke: TJOBInvokeGetType): UnicodeString;
var var
ResultLen: NativeInt; ResultLen: NativeInt;
aError: TJOBResult; aError: TJOBResult;
begin begin
ResultLen:=0; ResultLen:=0;
aError:=InvokeJSOneResult(aName,Args,@__job_invoke_stringresult,@ResultLen); aError:=InvokeJSOneResult(aName,Args,@__job_invoke_stringresult,@ResultLen,Invoke);
if aError<>JOBResult_String then if aError<>JOBResult_String then
InvokeRaiseResultMismatch(aName,JOBResult_String,aError); InvokeJS_RaiseResultMismatch(aName,JOBResult_String,aError);
if ResultLen=0 then if ResultLen=0 then
exit(''); exit('');
try try
@ -526,42 +567,100 @@ begin
end; end;
function TJSObject.InvokeJSObjResult(const aName: string; function TJSObject.InvokeJSObjResult(const aName: string;
aResultClass: TJSObjectClass; const Args: array of const): TJSObject; const Args: array of const; aResultClass: TJSObjectClass;
Invoke: TJOBInvokeGetType): TJSObject;
var var
aError: TJOBResult; aError: TJOBResult;
NewObjId: TJOBObjectID; NewObjId: TJOBObjectID;
begin begin
Result:=nil; Result:=nil;
NewObjId:=-1; NewObjId:=-1;
aError:=InvokeJSOneResult(aName,Args,@__job_invoke_objectresult,@NewObjId); aError:=InvokeJSOneResult(aName,Args,@__job_invoke_objectresult,@NewObjId,Invoke);
if aError=JOBResult_Null then if aError=JOBResult_Null then
exit; exit;
if aError<>JOBResult_Object then if aError<>JOBResult_Object then
InvokeRaiseResultMismatch(aName,JOBResult_Object,aError); InvokeJS_RaiseResultMismatch(aName,JOBResult_Object,aError);
Result:=aResultClass.CreateFromID(NewObjId); Result:=aResultClass.CreateFromID(NewObjId);
end; end;
function TJSObject.InvokeJSUtf8StringResult(const aName: string; function TJSObject.InvokeJSUtf8StringResult(const aName: string;
const args: array of const): String; const args: array of const; Invoke: TJOBInvokeGetType): String;
begin begin
Result:=String(InvokeJSUnicodeStringResult(aName,Args)); Result:=String(InvokeJSUnicodeStringResult(aName,Args,Invoke));
end; end;
function TJSObject.InvokeJSLongIntResult(const aName: string; function TJSObject.InvokeJSLongIntResult(const aName: string;
const args: array of const): LongInt; const args: array of const; Invoke: TJOBInvokeGetType): LongInt;
var var
d: Double; d: Double;
begin begin
d:=InvokeJSDoubleResult(aName,Args); d:=InvokeJSDoubleResult(aName,Args,Invoke);
if Frac(d)<>0 then if (Frac(d)<>0) or (d<low(longint)) or (d>high(longint)) then
InvokeRaiseResultMismatchStr(aName,'longint','double') InvokeJS_RaiseResultMismatchStr(aName,'longint','double')
else if (d<low(longint)) or (d>high(longint)) then
InvokeRaiseResultMismatchStr(aName,'longint','double')
else else
Result:=Trunc(d); Result:=Trunc(d);
end; end;
function TJSObject.ReadJSPropertyBoolean(const aName: string): boolean;
begin
Result:=InvokeJSBooleanResult(aName,[],jigGetter);
end;
function TJSObject.ReadJSPropertyDouble(const aName: string): double;
begin
Result:=InvokeJSDoubleResult(aName,[],jigGetter);
end;
function TJSObject.ReadJSPropertyUnicodeString(const aName: string
): UnicodeString;
begin
Result:=InvokeJSUnicodeStringResult(aName,[],jigGetter);
end;
function TJSObject.ReadJSPropertyObject(const aName: string;
aResultClass: TJSObjectClass): TJSObject;
begin
Result:=InvokeJSObjResult(aName,[],aResultClass,jigGetter);
end;
function TJSObject.ReadJSPropertyUtf8String(const aName: string): string;
begin
Result:=InvokeJSUtf8StringResult(aName,[],jigGetter);
end;
function TJSObject.ReadJSPropertyLongInt(const aName: string): LongInt;
begin
Result:=InvokeJSLongIntResult(aName,[],jigGetter);
end;
procedure TJSObject.WriteJSPropertyBoolean(const aName: string; Value: Boolean);
begin
InvokeJSNoResult(aName,[Value],jisSetter);
end;
procedure TJSObject.WriteJSPropertyDouble(const aName: string; Value: Double);
begin
InvokeJSNoResult(aName,[Value],jisSetter);
end;
procedure TJSObject.WriteJSPropertyUnicodeString(const aName: string;
const Value: UnicodeString);
begin
InvokeJSNoResult(aName,[Value],jisSetter);
end;
procedure TJSObject.WriteJSPropertyUtf8String(const aName: string;
const Value: String);
begin
InvokeJSNoResult(aName,[Value],jisSetter);
end;
procedure TJSObject.WriteJSPropertyLongInt(const aName: string; Value: LongInt);
begin
InvokeJSNoResult(aName,[Value],jisSetter);
end;
initialization initialization
JSDocument:=TJSObject.CreateFromID(JOBObjIdDocument); JSDocument:=TJSObject.CreateFromID(JOBObjIdDocument);