1
0
mirror of https://github.com/salvadordf/CEF4Delphi.git synced 2024-12-04 09:26:52 +02:00
CEF4Delphi/source/uCEFv8Handler.pas

960 lines
27 KiB
ObjectPascal
Raw Normal View History

2017-01-27 17:37:51 +02:00
// ************************************************************************
// ***************************** CEF4Delphi *******************************
// ************************************************************************
//
// CEF4Delphi is based on DCEF3 which uses CEF3 to embed a chromium-based
// browser in Delphi applications.
//
// The original license of DCEF3 still applies to CEF4Delphi.
//
// For more information about CEF4Delphi visit :
// https://www.briskbard.com/index.php?lang=en&pageid=cef
//
// Copyright � 2018 Salvador Diaz Fau. All rights reserved.
2017-01-27 17:37:51 +02:00
//
// ************************************************************************
// ************ vvvv Original license and comments below vvvv *************
// ************************************************************************
(*
* Delphi Chromium Embedded 3
*
* Usage allowed under the restrictions of the Lesser GNU General Public License
* or alternatively the restrictions of the Mozilla Public License 1.1
*
* Software distributed under the License is distributed on an "AS IS" basis,
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
* the specific language governing rights and limitations under the License.
*
* Unit owner : Henri Gourvest <hgourvest@gmail.com>
* Web site : http://www.progdigy.com
* Repository : http://code.google.com/p/delphichromiumembedded/
* Group : http://groups.google.com/group/delphichromiumembedded
*
* Embarcadero Technologies, Inc is not permitted to use or redistribute
* this source code without explicit permission.
*
*)
unit uCEFv8Handler;
{$IFDEF FPC}
{$MODE OBJFPC}{$H+}
{$ENDIF}
2017-01-27 17:37:51 +02:00
{$IFNDEF CPUX64}
{$ALIGN ON}
{$MINENUMSIZE 4}
{$ENDIF}
2017-02-05 21:56:46 +02:00
{$I cef.inc}
2017-01-27 17:37:51 +02:00
interface
uses
2017-02-05 21:56:46 +02:00
{$IFDEF DELPHI16_UP}
{$IFDEF MSWINDOWS}WinApi.Windows,{$ENDIF} System.Rtti, System.TypInfo, System.Variants,
System.SysUtils, System.Classes, System.Math, System.SyncObjs,
2017-02-05 21:56:46 +02:00
{$ELSE}
{$IFDEF DELPHI14_UP}Rtti,{$ENDIF} TypInfo, Variants, SysUtils, Classes, Math, SyncObjs, Windows,
2017-02-05 21:56:46 +02:00
{$ENDIF}
uCEFBaseRefCounted, uCEFInterfaces, uCEFTypes;
2017-01-27 17:37:51 +02:00
type
TCefv8HandlerRef = class(TCefBaseRefCountedRef, ICefv8Handler)
2017-01-27 17:37:51 +02:00
protected
function Execute(const name: ustring; const obj: ICefv8Value; const arguments: TCefv8ValueArray; var retval: ICefv8Value; var exception: ustring): Boolean;
public
class function UnWrap(data: Pointer): ICefv8Handler;
end;
TCefv8HandlerOwn = class(TCefBaseRefCountedOwn, ICefv8Handler)
2017-01-27 17:37:51 +02:00
protected
function Execute(const name: ustring; const obj: ICefv8Value; const arguments: TCefv8ValueArray; var retval: ICefv8Value; var exception: ustring): Boolean; virtual;
public
constructor Create; virtual;
end;
{$IFDEF DELPHI14_UP}
2017-01-27 17:37:51 +02:00
TCefRTTIExtension = class(TCefv8HandlerOwn)
protected
FValue: TValue;
FCtx: TRttiContext;
FSyncMainThread: Boolean;
function GetValue(pi: PTypeInfo; const v: ICefv8Value; var ret: TValue): Boolean;
function SetValue(const v: TValue; var ret: ICefv8Value): Boolean;
{$IFDEF CPUX64}
class function StrToPtr(const str: ustring): Pointer;
class function PtrToStr(p: Pointer): ustring;
{$ENDIF}
function Execute(const name: ustring; const obj: ICefv8Value; const arguments: TCefv8ValueArray; var retval: ICefv8Value; var exception: ustring): Boolean; override;
public
constructor Create(const value: TValue; SyncMainThread: Boolean = False); reintroduce;
destructor Destroy; override;
class procedure Register(const name: ustring; const value: TValue; SyncMainThread: Boolean = False);
2017-01-27 17:37:51 +02:00
end;
{$ENDIF}
2017-01-27 17:37:51 +02:00
implementation
uses
uCEFMiscFunctions, uCEFLibFunctions, uCEFv8Value, uCEFConstants;
2017-01-27 17:37:51 +02:00
2018-03-29 20:02:04 +02:00
function cef_v8_handler_execute( self : PCefv8Handler;
2018-02-26 19:40:51 +02:00
const name : PCefString;
obj : PCefv8Value;
argumentsCount : NativeUInt;
const arguments : PPCefV8Value;
var retval : PCefV8Value;
var exception : TCefString): Integer; stdcall;
2017-01-27 17:37:51 +02:00
var
2018-02-26 19:40:51 +02:00
args : TCefv8ValueArray;
i, j : NativeInt;
ret : ICefv8Value;
exc : ustring;
2018-03-29 20:02:04 +02:00
TempObject : TObject;
2017-01-27 17:37:51 +02:00
begin
2018-03-29 20:02:04 +02:00
Result := -Ord(False);
TempObject := CefGetObject(self);
2018-02-26 19:40:51 +02:00
2018-03-29 20:02:04 +02:00
if (TempObject <> nil) and (TempObject is TCefv8HandlerOwn) then
2018-02-26 19:40:51 +02:00
begin
2018-03-29 20:02:04 +02:00
i := 0;
j := argumentsCount;
2018-02-26 19:40:51 +02:00
2018-03-29 20:02:04 +02:00
SetLength(args, j);
while (i < j) do
begin
args[i] := TCefv8ValueRef.UnWrap(arguments^[i]);
2018-03-29 20:02:04 +02:00
inc(i);
end;
Result := -Ord(TCefv8HandlerOwn(TempObject).Execute(CefString(name), TCefv8ValueRef.UnWrap(obj), args, ret, exc));
retval := CefGetData(ret);
ret := nil;
exception := CefString(exc);
end;
2017-01-27 17:37:51 +02:00
end;
2018-02-26 19:40:51 +02:00
function TCefv8HandlerRef.Execute(const name : ustring;
const obj : ICefv8Value;
const arguments : TCefv8ValueArray;
var retval : ICefv8Value;
var exception : ustring): Boolean;
2017-01-27 17:37:51 +02:00
var
2018-02-26 19:40:51 +02:00
args : array of PCefV8Value;
i, j : Integer;
ret : PCefV8Value;
exc : TCefString;
n : TCefString;
2017-01-27 17:37:51 +02:00
begin
2018-02-26 19:40:51 +02:00
i := 0;
j := Length(arguments);
SetLength(args, j);
while (i < j) do
begin
args[i] := CefGetData(arguments[i]);
inc(i);
end;
2017-01-27 17:37:51 +02:00
FillChar(exc, SizeOf(exc), 0);
2018-02-26 19:40:51 +02:00
ret := nil;
n := CefString(name);
Result := PCefv8Handler(FData)^.execute(PCefv8Handler(FData), @n, CefGetData(obj), Length(arguments), @args, ret, exc) <> 0;
2018-02-26 19:40:51 +02:00
retval := TCefv8ValueRef.UnWrap(ret);
2017-01-27 17:37:51 +02:00
exception := CefStringClearAndGet(exc);
end;
class function TCefv8HandlerRef.UnWrap(data: Pointer): ICefv8Handler;
begin
2018-03-29 20:02:04 +02:00
if (data <> nil) then
Result := Create(data) as ICefv8Handler
else
2017-01-27 17:37:51 +02:00
Result := nil;
end;
// TCefv8HandlerOwn
constructor TCefv8HandlerOwn.Create;
begin
inherited CreateData(SizeOf(TCefv8Handler));
PCefv8Handler(FData)^.execute := {$IFDEF FPC}@{$ENDIF}cef_v8_handler_execute;
2017-01-27 17:37:51 +02:00
end;
function TCefv8HandlerOwn.Execute(const name: ustring; const obj: ICefv8Value; const arguments: TCefv8ValueArray; var retval: ICefv8Value; var exception: ustring): Boolean;
begin
Result := False;
end;
{$IFDEF DELPHI14_UP}
2017-01-27 17:37:51 +02:00
// TCefRTTIExtension
constructor TCefRTTIExtension.Create(const value: TValue; SyncMainThread: Boolean);
begin
inherited Create;
FCtx := TRttiContext.Create;
2017-01-27 17:37:51 +02:00
FSyncMainThread := SyncMainThread;
FValue := value;
2017-01-27 17:37:51 +02:00
end;
destructor TCefRTTIExtension.Destroy;
begin
FCtx.Free;
inherited Destroy;
2017-01-27 17:37:51 +02:00
end;
function TCefRTTIExtension.GetValue(pi: PTypeInfo; const v: ICefv8Value; var ret: TValue): Boolean;
function ProcessInt: Boolean;
var
sv: record
case byte of
0: (ub: Byte);
1: (sb: ShortInt);
2: (uw: Word);
3: (sw: SmallInt);
4: (si: Integer);
5: (ui: Cardinal);
end;
pd: PTypeData;
begin
pd := GetTypeData(pi);
if (v.IsInt or v.IsBool) and (v.GetIntValue >= pd.MinValue) and (v.GetIntValue <= pd.MaxValue) then
begin
case pd.OrdType of
otSByte: sv.sb := v.GetIntValue;
otUByte: sv.ub := v.GetIntValue;
otSWord: sv.sw := v.GetIntValue;
otUWord: sv.uw := v.GetIntValue;
otSLong: sv.si := v.GetIntValue;
otULong: sv.ui := v.GetIntValue;
end;
TValue.Make(@sv, pi, ret);
end else
Exit(False);
Result := True;
end;
function ProcessInt64: Boolean;
var
i: Int64;
begin
i := StrToInt64(v.GetStringValue); // hack
TValue.Make(@i, pi, ret);
Result := True;
end;
function ProcessUString: Boolean;
var
vus: string;
begin
if v.IsString then
begin
vus := v.GetStringValue;
TValue.Make(@vus, pi, ret);
end else
Exit(False);
Result := True;
end;
function ProcessLString: Boolean;
var
vas: AnsiString;
begin
if v.IsString then
begin
vas := AnsiString(v.GetStringValue);
TValue.Make(@vas, pi, ret);
end else
Exit(False);
Result := True;
end;
function ProcessWString: Boolean;
var
vws: WideString;
begin
if v.IsString then
begin
vws := v.GetStringValue;
TValue.Make(@vws, pi, ret);
end else
Exit(False);
Result := True;
end;
function ProcessFloat: Boolean;
var
sv: record
case byte of
0: (fs: Single);
1: (fd: Double);
2: (fe: Extended);
3: (fc: Comp);
4: (fcu: Currency);
end;
begin
if v.IsDouble or v.IsInt then
begin
case GetTypeData(pi).FloatType of
ftSingle: sv.fs := v.GetDoubleValue;
ftDouble: sv.fd := v.GetDoubleValue;
ftExtended: sv.fe := v.GetDoubleValue;
ftComp: sv.fc := v.GetDoubleValue;
ftCurr: sv.fcu := v.GetDoubleValue;
end;
TValue.Make(@sv, pi, ret);
end else
if v.IsDate then
begin
sv.fd := v.GetDateValue;
TValue.Make(@sv, pi, ret);
end else
Exit(False);
Result := True;
end;
function ProcessSet: Boolean;
var
sv: record
case byte of
0: (ub: Byte);
1: (sb: ShortInt);
2: (uw: Word);
3: (sw: SmallInt);
4: (si: Integer);
5: (ui: Cardinal);
end;
begin
if v.IsInt then
begin
case GetTypeData(pi).OrdType of
otSByte: sv.sb := v.GetIntValue;
otUByte: sv.ub := v.GetIntValue;
otSWord: sv.sw := v.GetIntValue;
otUWord: sv.uw := v.GetIntValue;
otSLong: sv.si := v.GetIntValue;
otULong: sv.ui := v.GetIntValue;
end;
TValue.Make(@sv, pi, ret);
end else
Exit(False);
Result := True;
end;
function ProcessVariant: Boolean;
var
2018-02-26 19:40:51 +02:00
vr : Variant;
i, j : Integer;
vl : TValue;
2017-01-27 17:37:51 +02:00
begin
VarClear(vr);
if v.IsString then vr := v.GetStringValue else
if v.IsBool then vr := v.GetBoolValue else
if v.IsInt then vr := v.GetIntValue else
if v.IsDouble then vr := v.GetDoubleValue else
if v.IsUndefined then TVarData(vr).VType := varEmpty else
if v.IsNull then TVarData(vr).VType := varNull else
if v.IsArray then
begin
2018-02-26 19:40:51 +02:00
i := 0;
j := v.GetArrayLength;
vr := VarArrayCreate([0, j], varVariant);
while (i < j) do
begin
if not GetValue(pi, v.GetValueByIndex(i), vl) then Exit(False);
VarArrayPut(vr, vl.AsVariant, i);
inc(i);
end;
2017-01-27 17:37:51 +02:00
end else
Exit(False);
2018-02-26 19:40:51 +02:00
2017-01-27 17:37:51 +02:00
TValue.Make(@vr, pi, ret);
Result := True;
end;
function ProcessObject: Boolean;
var
ud: ICefv8Value;
i: Pointer;
td: PTypeData;
rt: TRttiType;
begin
if v.IsObject then
begin
ud := v.GetUserData;
if (ud = nil) then Exit(False);
{$IFDEF CPUX64}
rt := StrToPtr(ud.GetValueByIndex(0).GetStringValue);
{$ELSE}
rt := TRttiType(ud.GetValueByIndex(0).GetIntValue);
{$ENDIF}
td := GetTypeData(rt.Handle);
if (rt.TypeKind = tkClass) and td.ClassType.InheritsFrom(GetTypeData(pi).ClassType) then
begin
{$IFDEF CPUX64}
i := StrToPtr(ud.GetValueByIndex(1).GetStringValue);
{$ELSE}
i := Pointer(ud.GetValueByIndex(1).GetIntValue);
{$ENDIF}
TValue.Make(@i, pi, ret);
end else
Exit(False);
end else
Exit(False);
Result := True;
end;
function ProcessClass: Boolean;
var
ud: ICefv8Value;
i: Pointer;
rt: TRttiType;
begin
if v.IsObject then
begin
ud := v.GetUserData;
if (ud = nil) then Exit(False);
{$IFDEF CPUX64}
rt := StrToPtr(ud.GetValueByIndex(0).GetStringValue);
{$ELSE}
rt := TRttiType(ud.GetValueByIndex(0).GetIntValue);
{$ENDIF}
if (rt.TypeKind = tkClassRef) then
begin
{$IFDEF CPUX64}
i := StrToPtr(ud.GetValueByIndex(1).GetStringValue);
{$ELSE}
i := Pointer(ud.GetValueByIndex(1).GetIntValue);
{$ENDIF}
TValue.Make(@i, pi, ret);
end else
Exit(False);
end else
Exit(False);
Result := True;
end;
function ProcessRecord: Boolean;
var
r: TRttiField;
f: TValue;
rec: Pointer;
begin
if v.IsObject then
begin
TValue.Make(nil, pi, ret);
2017-02-05 21:56:46 +02:00
{$IFDEF DELPHI15_UP}
2017-01-27 17:37:51 +02:00
rec := TValueData(ret).FValueData.GetReferenceToRawData;
2017-02-05 21:56:46 +02:00
{$ELSE}
rec := IValueData(TValueData(ret).FHeapData).GetReferenceToRawData;
{$ENDIF}
2017-01-27 17:37:51 +02:00
for r in FCtx.GetType(pi).GetFields do
begin
if not GetValue(r.FieldType.Handle, v.GetValueByKey(r.Name), f) then
Exit(False);
r.SetValue(rec, f);
end;
Result := True;
end else
Result := False;
end;
function ProcessInterface: Boolean;
begin
if pi = TypeInfo(ICefV8Value) then
begin
TValue.Make(@v, pi, ret);
Result := True;
end else
Result := False; // todo
end;
begin
case pi.Kind of
tkInteger, tkEnumeration: Result := ProcessInt;
tkInt64: Result := ProcessInt64;
tkUString: Result := ProcessUString;
tkLString: Result := ProcessLString;
tkWString: Result := ProcessWString;
tkFloat: Result := ProcessFloat;
tkSet: Result := ProcessSet;
tkVariant: Result := ProcessVariant;
tkClass: Result := ProcessObject;
tkClassRef: Result := ProcessClass;
tkRecord: Result := ProcessRecord;
tkInterface: Result := ProcessInterface;
else
Result := False;
end;
end;
function TCefRTTIExtension.SetValue(const v: TValue; var ret: ICefv8Value): Boolean;
function ProcessRecord: Boolean;
var
rf: TRttiField;
vl: TValue;
ud, v8: ICefv8Value;
rec: Pointer;
rt: TRttiType;
begin
ud := TCefv8ValueRef.NewArray(1);
rt := FCtx.GetType(v.TypeInfo);
{$IFDEF CPUX64}
ud.SetValueByIndex(0, TCefv8ValueRef.NewString(PtrToStr(rt)));
{$ELSE}
ud.SetValueByIndex(0, TCefv8ValueRef.NewInt(Integer(rt)));
{$ENDIF}
ret := TCefv8ValueRef.NewObject(nil, nil);
ret.SetUserData(ud);
2017-02-05 21:56:46 +02:00
{$IFDEF DELPHI15_UP}
2017-01-27 17:37:51 +02:00
rec := TValueData(v).FValueData.GetReferenceToRawData;
2017-02-05 21:56:46 +02:00
{$ELSE}
rec := IValueData(TValueData(v).FHeapData).GetReferenceToRawData;
{$ENDIF}
2017-01-27 17:37:51 +02:00
if FSyncMainThread then
begin
v8 := ret;
TThread.Synchronize(nil, procedure
var
rf: TRttiField;
o: ICefv8Value;
begin
for rf in rt.GetFields do
begin
vl := rf.GetValue(rec);
SetValue(vl, o);
v8.SetValueByKey(rf.Name, o, V8_PROPERTY_ATTRIBUTE_NONE);
2017-01-27 17:37:51 +02:00
end;
end)
end else
for rf in FCtx.GetType(v.TypeInfo).GetFields do
begin
vl := rf.GetValue(rec);
if not SetValue(vl, v8) then
Exit(False);
ret.SetValueByKey(rf.Name, v8, V8_PROPERTY_ATTRIBUTE_NONE);
2017-01-27 17:37:51 +02:00
end;
Result := True;
end;
function ProcessObject: Boolean;
var
m: TRttiMethod;
p: TRttiProperty;
fl: TRttiField;
f: ICefv8Value;
_r, _g, _s, ud: ICefv8Value;
_a: TCefv8ValueArray;
rt: TRttiType;
begin
rt := FCtx.GetType(v.TypeInfo);
ud := TCefv8ValueRef.NewArray(2);
{$IFDEF CPUX64}
ud.SetValueByIndex(0, TCefv8ValueRef.NewString(PtrToStr(rt)));
ud.SetValueByIndex(1, TCefv8ValueRef.NewString(PtrToStr(v.AsObject)));
{$ELSE}
ud.SetValueByIndex(0, TCefv8ValueRef.NewInt(Integer(rt)));
ud.SetValueByIndex(1, TCefv8ValueRef.NewInt(Integer(v.AsObject)));
{$ENDIF}
ret := TCefv8ValueRef.NewObject(nil, nil); // todo
ret.SetUserData(ud);
for m in rt.GetMethods do
if m.Visibility > mvProtected then
begin
f := TCefv8ValueRef.NewFunction(m.Name, Self);
ret.SetValueByKey(m.Name, f, V8_PROPERTY_ATTRIBUTE_NONE);
2017-01-27 17:37:51 +02:00
end;
for p in rt.GetProperties do
if (p.Visibility > mvProtected) then
begin
if _g = nil then _g := ret.GetValueByKey('__defineGetter__');
if _s = nil then _s := ret.GetValueByKey('__defineSetter__');
SetLength(_a, 2);
_a[0] := TCefv8ValueRef.NewString(p.Name);
if p.IsReadable then
begin
_a[1] := TCefv8ValueRef.NewFunction('$pg' + p.Name, Self);
_r := _g.ExecuteFunction(ret, _a);
end;
if p.IsWritable then
begin
_a[1] := TCefv8ValueRef.NewFunction('$ps' + p.Name, Self);
_r := _s.ExecuteFunction(ret, _a);
end;
end;
for fl in rt.GetFields do
if (fl.Visibility > mvProtected) then
begin
if _g = nil then _g := ret.GetValueByKey('__defineGetter__');
if _s = nil then _s := ret.GetValueByKey('__defineSetter__');
SetLength(_a, 2);
_a[0] := TCefv8ValueRef.NewString(fl.Name);
_a[1] := TCefv8ValueRef.NewFunction('$vg' + fl.Name, Self);
_r := _g.ExecuteFunction(ret, _a);
_a[1] := TCefv8ValueRef.NewFunction('$vs' + fl.Name, Self);
_r := _s.ExecuteFunction(ret, _a);
end;
Result := True;
end;
function ProcessClass: Boolean;
var
m: TRttiMethod;
f, ud: ICefv8Value;
c: TClass;
rt: TRttiType;
begin
c := v.AsClass;
rt := FCtx.GetType(c);
ud := TCefv8ValueRef.NewArray(2);
{$IFDEF CPUX64}
ud.SetValueByIndex(0, TCefv8ValueRef.NewString(PtrToStr(rt)));
ud.SetValueByIndex(1, TCefv8ValueRef.NewString(PtrToStr(c)));
{$ELSE}
ud.SetValueByIndex(0, TCefv8ValueRef.NewInt(Integer(rt)));
ud.SetValueByIndex(1, TCefv8ValueRef.NewInt(Integer(c)));
{$ENDIF}
ret := TCefv8ValueRef.NewObject(nil, nil); // todo
ret.SetUserData(ud);
if c <> nil then
begin
for m in rt.GetMethods do
if (m.Visibility > mvProtected) and (m.MethodKind in [mkClassProcedure, mkClassFunction]) then
begin
f := TCefv8ValueRef.NewFunction(m.Name, Self);
ret.SetValueByKey(m.Name, f, V8_PROPERTY_ATTRIBUTE_NONE);
2017-01-27 17:37:51 +02:00
end;
end;
Result := True;
end;
function ProcessVariant: Boolean;
var
vr: Variant;
begin
vr := v.AsVariant;
case TVarData(vr).VType of
varSmallint, varInteger, varShortInt:
ret := TCefv8ValueRef.NewInt(vr);
varByte, varWord, varLongWord:
ret := TCefv8ValueRef.NewUInt(vr);
varUString, varOleStr, varString:
ret := TCefv8ValueRef.NewString(vr);
varSingle, varDouble, varCurrency, varUInt64, varInt64:
ret := TCefv8ValueRef.NewDouble(vr);
varBoolean:
ret := TCefv8ValueRef.NewBool(vr);
varNull:
ret := TCefv8ValueRef.NewNull;
varEmpty:
ret := TCefv8ValueRef.NewUndefined;
else
ret := nil;
Exit(False)
end;
Result := True;
end;
function ProcessInterface: Boolean;
var
m: TRttiMethod;
f: ICefv8Value;
ud: ICefv8Value;
rt: TRttiType;
begin
if TypeInfo(ICefV8Value) = v.TypeInfo then
begin
ret := ICefV8Value(v.AsInterface);
Result := True;
end else
begin
rt := FCtx.GetType(v.TypeInfo);
ud := TCefv8ValueRef.NewArray(2);
{$IFDEF CPUX64}
ud.SetValueByIndex(0, TCefv8ValueRef.NewString(PtrToStr(rt)));
ud.SetValueByIndex(1, TCefv8ValueRef.NewString(PtrToStr(Pointer(v.AsInterface))));
{$ELSE}
ud.SetValueByIndex(0, TCefv8ValueRef.NewInt(Integer(rt)));
ud.SetValueByIndex(1, TCefv8ValueRef.NewInt(Integer(v.AsInterface)));
{$ENDIF}
ret := TCefv8ValueRef.NewObject(nil, nil);
ret.SetUserData(ud);
for m in rt.GetMethods do
if m.Visibility > mvProtected then
begin
f := TCefv8ValueRef.NewFunction(m.Name, Self);
ret.SetValueByKey(m.Name, f, V8_PROPERTY_ATTRIBUTE_NONE);
2017-01-27 17:37:51 +02:00
end;
Result := True;
end;
end;
function ProcessFloat: Boolean;
begin
if v.TypeInfo = TypeInfo(TDateTime) then
ret := TCefv8ValueRef.NewDate(TValueData(v).FAsDouble) else
ret := TCefv8ValueRef.NewDouble(v.AsExtended);
Result := True;
end;
begin
case v.TypeInfo.Kind of
tkUString, tkLString, tkWString, tkChar, tkWChar:
ret := TCefv8ValueRef.NewString(v.AsString);
tkInteger: ret := TCefv8ValueRef.NewInt(v.AsInteger);
tkEnumeration:
if v.TypeInfo = TypeInfo(Boolean) then
ret := TCefv8ValueRef.NewBool(v.AsBoolean) else
ret := TCefv8ValueRef.NewInt(TValueData(v).FAsSLong);
tkFloat: if not ProcessFloat then Exit(False);
tkInt64: ret := TCefv8ValueRef.NewDouble(v.AsInt64);
tkClass: if not ProcessObject then Exit(False);
tkClassRef: if not ProcessClass then Exit(False);
tkRecord: if not ProcessRecord then Exit(False);
tkVariant: if not ProcessVariant then Exit(False);
tkInterface: if not ProcessInterface then Exit(False);
else
Exit(False)
end;
Result := True;
end;
class procedure TCefRTTIExtension.Register(const name: ustring; const value: TValue; SyncMainThread: Boolean);
var
TempCode : ustring;
TempHandler : ICefv8Handler;
2017-01-27 17:37:51 +02:00
begin
TempHandler := TCefRTTIExtension.Create(value, SyncMainThread);
TempCode := format('this.__defineSetter__(''%s'', function(v){native function $s();$s(v)});' +
'this.__defineGetter__(''%0:s'', function(){native function $g();return $g()});',
[name]);
CefRegisterExtension(name, TempCode, TempHandler);
2017-01-27 17:37:51 +02:00
end;
{$IFDEF CPUX64}
class function TCefRTTIExtension.StrToPtr(const str: ustring): Pointer;
begin
HexToBin(PWideChar(str), @Result, SizeOf(Result));
end;
class function TCefRTTIExtension.PtrToStr(p: Pointer): ustring;
begin
SetLength(Result, SizeOf(p)*2);
BinToHex(@p, PWideChar(Result), SizeOf(p));
end;
{$ENDIF}
function TCefRTTIExtension.Execute(const name: ustring; const obj: ICefv8Value;
const arguments: TCefv8ValueArray; var retval: ICefv8Value;
var exception: ustring): Boolean;
var
p: PChar;
ud: ICefv8Value;
rt: TRttiType;
val: TObject;
cls: TClass;
m: TRttiMethod;
pr: TRttiProperty;
vl: TRttiField;
args: array of TValue;
prm: TArray<TRttiParameter>;
i: Integer;
ret: TValue;
begin
Result := True;
p := PChar(name);
m := nil;
if obj <> nil then
begin
ud := obj.GetUserData;
if ud <> nil then
begin
{$IFDEF CPUX64}
rt := StrToPtr(ud.GetValueByIndex(0).GetStringValue);
{$ELSE}
rt := TRttiType(ud.GetValueByIndex(0).GetIntValue);
{$ENDIF}
case rt.TypeKind of
tkClass:
begin
{$IFDEF CPUX64}
val := StrToPtr(ud.GetValueByIndex(1).GetStringValue);
{$ELSE}
val := TObject(ud.GetValueByIndex(1).GetIntValue);
{$ENDIF}
cls := GetTypeData(rt.Handle).ClassType;
if p^ = '$' then
begin
inc(p);
case p^ of
'p':
begin
inc(p);
case p^ of
'g':
begin
inc(p);
pr := rt.GetProperty(p);
if FSyncMainThread then
begin
TThread.Synchronize(nil, procedure begin
ret := pr.GetValue(val);
end);
Exit(SetValue(ret, retval));
end else
Exit(SetValue(pr.GetValue(val), retval));
end;
's':
begin
inc(p);
pr := rt.GetProperty(p);
if GetValue(pr.PropertyType.Handle, arguments[0], ret) then
begin
if FSyncMainThread then
TThread.Synchronize(nil, procedure begin
pr.SetValue(val, ret) end) else
pr.SetValue(val, ret);
Exit(True);
end else
Exit(False);
end;
end;
end;
'v':
begin
inc(p);
case p^ of
'g':
begin
inc(p);
vl := rt.GetField(p);
if FSyncMainThread then
begin
TThread.Synchronize(nil, procedure begin
ret := vl.GetValue(val);
end);
Exit(SetValue(ret, retval));
end else
Exit(SetValue(vl.GetValue(val), retval));
end;
's':
begin
inc(p);
vl := rt.GetField(p);
if GetValue(vl.FieldType.Handle, arguments[0], ret) then
begin
if FSyncMainThread then
TThread.Synchronize(nil, procedure begin
vl.SetValue(val, ret) end) else
vl.SetValue(val, ret);
Exit(True);
end else
Exit(False);
end;
end;
end;
end;
end else
m := rt.GetMethod(name);
end;
tkClassRef:
begin
val := nil;
{$IFDEF CPUX64}
cls := StrToPtr(ud.GetValueByIndex(1).GetStringValue);
{$ELSE}
cls := TClass(ud.GetValueByIndex(1).GetIntValue);
{$ENDIF}
m := FCtx.GetType(cls).GetMethod(name);
end;
else
m := nil;
cls := nil;
val := nil;
end;
prm := m.GetParameters;
i := Length(prm);
if i = Length(arguments) then
begin
SetLength(args, i);
for i := 0 to i - 1 do
if not GetValue(prm[i].ParamType.Handle, arguments[i], args[i]) then
Exit(False);
case m.MethodKind of
mkClassProcedure, mkClassFunction:
if FSyncMainThread then
TThread.Synchronize(nil, procedure begin
ret := m.Invoke(cls, args) end) else
ret := m.Invoke(cls, args);
mkProcedure, mkFunction:
if (val <> nil) then
begin
if FSyncMainThread then
TThread.Synchronize(nil, procedure begin
ret := m.Invoke(val, args) end) else
ret := m.Invoke(val, args);
end else
Exit(False)
else
Exit(False);
end;
if m.MethodKind in [mkClassFunction, mkFunction] then
if not SetValue(ret, retval) then
Exit(False);
end else
Exit(False);
end else
if p^ = '$' then
begin
inc(p);
case p^ of
'g': SetValue(FValue, retval);
's': GetValue(FValue.TypeInfo, arguments[0], FValue);
else
Exit(False);
end;
end else
Exit(False);
end else
Exit(False);
end;
{$ENDIF}
2017-01-27 17:37:51 +02:00
end.