reorganization of folders

source/uCEFv8Handler.pas

@@ -0,0 +1,896 @@
+// ************************************************************************
+// ***************************** 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 � 2017 Salvador D�az Fau. All rights reserved.
+//
+// ************************************************************************
+// ************ 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;
+
+{$IFNDEF CPUX64}
+  {$ALIGN ON}
+  {$MINENUMSIZE 4}
+{$ENDIF}
+
+interface
+
+uses
+  System.Rtti, System.TypInfo, System.Variants, System.SysUtils,
+  System.Classes, System.Math, System.SyncObjs, WinApi.Windows,
+  uCEFBase, uCEFInterfaces, uCEFTypes;
+
+type
+  TCefv8HandlerRef = class(TCefBaseRef, ICefv8Handler)
+    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(TCefBaseOwn, ICefv8Handler)
+    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;
+
+  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: string; const value: TValue; SyncMainThread: Boolean = False);
+  end;
+
+implementation
+
+uses
+  uCEFMiscFunctions, uCEFLibFunctions, uCEFv8Value;
+
+function cef_v8_handler_execute(self: PCefv8Handler;
+  const name: PCefString; obj: PCefv8Value; argumentsCount: NativeUInt;
+  const arguments: PPCefV8Value; var retval: PCefV8Value;
+  var exception: TCefString): Integer; stdcall;
+var
+  args: TCefv8ValueArray;
+  i: NativeInt;
+  ret: ICefv8Value;
+  exc: ustring;
+begin
+  SetLength(args, argumentsCount);
+  for i := 0 to argumentsCount - 1 do
+    args[i] := TCefv8ValueRef.UnWrap(arguments[i]);
+
+  Result := -Ord(TCefv8HandlerOwn(CefGetObject(self)).Execute(
+    CefString(name), TCefv8ValueRef.UnWrap(obj), args, ret, exc));
+  retval := CefGetData(ret);
+  ret := nil;
+  exception := CefString(exc);
+end;
+
+function TCefv8HandlerRef.Execute(const name: ustring; const obj: ICefv8Value;
+  const arguments: TCefv8ValueArray; var retval: ICefv8Value;
+  var exception: ustring): Boolean;
+var
+  args: array of PCefV8Value;
+  i: Integer;
+  ret: PCefV8Value;
+  exc: TCefString;
+  n: TCefString;
+begin
+  SetLength(args, Length(arguments));
+  for i := 0 to Length(arguments) - 1 do
+    args[i] := CefGetData(arguments[i]);
+  ret := nil;
+  FillChar(exc, SizeOf(exc), 0);
+  n := CefString(name);
+  Result := PCefv8Handler(FData)^.execute(PCefv8Handler(FData), @n,
+    CefGetData(obj), Length(arguments), @args, ret, exc) <> 0;
+  retval := TCefv8ValueRef.UnWrap(ret);
+  exception := CefStringClearAndGet(exc);
+end;
+
+class function TCefv8HandlerRef.UnWrap(data: Pointer): ICefv8Handler;
+begin
+  if data <> nil then
+    Result := Create(data) as ICefv8Handler else
+    Result := nil;
+end;
+
+// TCefv8HandlerOwn
+
+constructor TCefv8HandlerOwn.Create;
+begin
+  inherited CreateData(SizeOf(TCefv8Handler));
+
+  with PCefv8Handler(FData)^ do execute := cef_v8_handler_execute;
+end;
+
+function TCefv8HandlerOwn.Execute(const name: ustring; const obj: ICefv8Value; const arguments: TCefv8ValueArray; var retval: ICefv8Value; var exception: ustring): Boolean;
+begin
+  Result := False;
+end;
+
+// TCefRTTIExtension
+
+constructor TCefRTTIExtension.Create(const value: TValue; SyncMainThread: Boolean);
+begin
+  inherited Create;
+  FCtx := TRttiContext.Create;
+  FSyncMainThread := SyncMainThread;
+  FValue := value;
+end;
+
+destructor TCefRTTIExtension.Destroy;
+begin
+  FCtx.Free;
+  inherited;
+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
+    vr: Variant;
+    i: Integer;
+    vl: TValue;
+  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
+        vr := VarArrayCreate([0, v.GetArrayLength], varVariant);
+        for i := 0 to v.GetArrayLength - 1 do
+        begin
+          if not GetValue(pi, v.GetValueByIndex(i), vl) then Exit(False);
+          VarArrayPut(vr, vl.AsVariant, i);
+        end;
+      end else
+      Exit(False);
+    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);
+      rec := TValueData(ret).FValueData.GetReferenceToRawData;
+      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);
+
+    rec := TValueData(v).FValueData.GetReferenceToRawData;
+
+    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, []);
+        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,  []);
+      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, []);
+      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, []);
+        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, []);
+        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: string; const value: TValue; SyncMainThread: Boolean);
+begin
+  CefRegisterExtension(name,
+    format('__defineSetter__(''%s'', function(v){native function $s();$s(v)});__defineGetter__(''%0:s'', function(){native function $g();return $g()});', [name]),
+    TCefRTTIExtension.Create(value, SyncMainThread) as ICefv8Handler);
+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;
+
+end.