DCEF3 调用 js

http://www.cnblogs.com/Delphi-Farmer/p/4103708.html

interface

uses
  ceflib;//其它

type
//这里建议用class  不建议用class(TThread)  不然有些地方要报错
TMyExtension = class(TThread) // or just class, (extension code execute in thread)
  public
  class function _geta:string;
end;

TCustomRenderProcessHandler = class(TCefRenderProcessHandlerOwn)
protected
    procedure OnWebKitInitialized; override;
end;

implementation

class function TMyExtension._geta: string;
begin
  Result:='调用成功';
end;

procedure TCustomRenderProcessHandler.OnWebKitInitialized;
begin
  TCefRTTIExtension.Register('JS_DELPHI', TMyExtension);
end;

initialization
  CefRenderProcessHandler := TCustomRenderProcessHandler.Create;

end.

JS调用实例:

<script> alert( JS_DELPHI._geta() ); <script>

这种方式调用时要写注册的类名:JS_DELPHI

在CEF1中是不需要写类名的,这点要注意

Dcef 与 js 交互

type
  TCustomRenderProcessHandler = class(TCefRenderProcessHandlerOwn)
  protected
    procedure OnWebKitInitialized; override;
  end;  

  TDcefb_Extension = class
    class procedure DoTest(Msg: string);
  end;  

class procedure TDcefb_Extension.DoTest(Msg: string);
begin
  ShowMessage(Msg);
end;  

procedure TCustomRenderProcessHandler.OnWebKitInitialized;
begin
  TCefRTTIExtension.Register('Dcefb_Test', TDcefb_Extension);
end;  

工程文件内添加

 CefRenderProcessHandler := TCustomRenderProcessHandler.Create;
  if not CefLoadLibDefault then
    Exit;
测试代码
    DcefBrowser1.ExecuteJavaScript('Dcefb_Test.DoTest("TestStr");');

2. 关于 Tchrome 中加载 JS 与 delphi 交互问题

http://www.cnblogs.com/Delphi-Farmer/archive/2013/05/17/3083794.html

我这里直接给他代码,是转载的大神的,具体地址忘了。

(*
 *                               NeuglsWorkStudio
 *                     HTML Interface Javascript Extendtion
 *  This unit implmented TNCJsExtented which used for extend the capablity of
 *  javascript.
 *
 *  Author     : Neugls
 *  Create time: 4/27/2011
 *
 *  Thanks for : Henri Gourvest
 *
 *
 *
 *
 *
 *)
unit VCL.JSExtented;

interface

uses
  SysUtils, Classes,ceflib,Rtti,cefvcl;

const
  csErrorParameters            ='Error Parameters';
  csHaveNoThisMember           ='Have no member';
  csChromiumCouldNotBeNil      ='Chromium could not be nil, please first set the Chromium property';

type
  {}
  TVCLJsExtended = class(TComponent)
    type
      TANameType=(ntMethod,ntField,ntProperty);
      {Inner class}
      TNCJSHandle=class(TCefv8HandlerOwn)
        private
           FContainer:TVCLJsExtended;
        protected
          function Execute(const name: ustring; const obj: ICefv8Value;
            const arguments: TCefv8ValueArray; var retval: ICefv8Value;
            var exception: ustring): Boolean; override;

          procedure JsCallMethod(Method:TRttiMethod;out ReturnVal:ICefv8Value; const Param:TCefv8ValueArray);overload;
          procedure JsCallMethod(Method:TRttiMethod;out ReturnVal:ICefv8Value);overload;
          function MethodParamLength(Mn:string):Integer;
        public
          constructor Create(Container:TVCLJsExtended);
      end;

  private
    FProcessObject:TObject;
    FJsHandle:TNCJSHandle;
    FTypeInfo:Pointer;
    FCustomChromium:TChromium;
    FFrame:ICefFrame;
  public
    Frame:ICefFrame{  read FFrame write FFrame};
    property ProcessObject:TObject read FProcessObject;
    property ATypeInfo:Pointer read FTypeInfo;
    procedure SetProcessObject(value:TObject;ATypeInfo:Pointer);
    Procedure ExecuteJavaScript(const jsCode, scriptUrl: string; startLine: Integer);overload;
    Procedure ExecuteJavaScript(const jsCode:string);overload;
    constructor create(AOwner:TComponent);override;

    property Chromium:TChromium read FCustomChromium write FCustomChromium;
  end;

  TVCLNcJsExtended = class(TVCLJsExtended)
  published
    property Chromium;
  end;
  TNCWebBrowser=class(TChromium)

  end;

procedure Register;

implementation
uses TypInfo;
procedure Register;
begin
  RegisterComponents('NwControls', [TVCLNcJsExtended]);
  RegisterComponents('NwControls', [TChromium]);
end;

{ TVCLJsExtended }

constructor TVCLJsExtended.create(AOwner:TComponent);
begin
  inherited create(AOwner);
  FProcessObject:=nil;
  FJsHandle:=TNCJSHandle.Create(Self);
end;

procedure TVCLJsExtended.ExecuteJavaScript(const jsCode, scriptUrl: string;
  startLine: Integer);
begin
  if not Assigned(FCustomChromium) then
  begin
    raise Exception.Create(csChromiumCouldNotBeNil);
    Exit;
  end;
  FCustomChromium.Browser.MainFrame.ExecuteJavaScript(jsCode,scriptUrl,startLine);
end;

procedure TVCLJsExtended.ExecuteJavaScript(const jsCode:string);
begin
  ExecuteJavaScript(jsCode,);
end;

procedure TVCLJsExtended.SetProcessObject(value: TObject;ATypeInfo:Pointer);
var
   RttiContext:TRttiContext;
   RttiType:TRttiType;
   RM:TRttiMethod;
   RP:TRttiProperty;
   RF:TRttiField;

   JsStr,name:String;
   I:Integer;
begin
  {
    根据object所提供的方法属性生成js字符串,希望注册.
  }
  FProcessObject:=value;
  FTypeInfo:=ATypeInfo;
  RttiType:=RttiContext.GetType(FTypeInfo);

  name:=RttiType.Name;
  JsStr:=Format('var %s;',[name]);
  JsStr:=Format('%s if(!%s) %s={};',[JsStr,name,name]);

  {Process method}
  for RM in RttiType.GetMethods  do
  begin
    JsStr:=JsStr+Format(#$A#$D' native function %s(',[RM.Name]);
     then
      JsStr:=Format('%s);',[JsStr])
    else
    begin
        do
        JsStr:=Format('%s %s,',[JsStr,chr(ord('A')+I)]);
      I:=Length(RM.GetParameters)-;
      JsStr:=Format('%s %s);',[JsStr,chr(ord('A')+I)]);
    end;
  end;

  {Process Field}
  for RF in RttiType.GetFields  do
  begin
    JsStr:=Format('%s'#$A#$D' var %s;',[JsStr,RF.Name]);
    case RF.FieldType.TypeKind of
      tkUnknown: ;
      tkInteger: JsStr:=Format('%s'#$A#$D' %s=%d;',[JsStr,RF.Name,RF.GetValue(FProcessObject).AsInteger]);
      tkChar: JsStr:=Format('%s'#$A#$D' %s="%s";',[JsStr,RF.Name,RF.GetValue(FProcessObject).AsString]);
      tkEnumeration: JsStr:=Format('%s'#$A#$D' %s=%d;',[JsStr,RF.Name,RF.GetValue(FProcessObject).AsInteger]);
      tkFloat: JsStr:=Format('%s'#$A#$D' %s=%f;',[JsStr,RF.Name,RF.GetValue(FProcessObject).AsExtended]);
      tkString: JsStr:=Format('%s'#$A#$D' %s="%s";',[JsStr,RF.Name,RF.GetValue(FProcessObject).AsString]);
      tkSet: JsStr:=Format('%s'#$A#$D' %s=%d;',[JsStr,RF.Name,RF.GetValue(FProcessObject).AsInteger]);
      tkClass:{support later} JsStr:=Format('%s'#$A#$D' %s={};',[JsStr,RF.Name]);
      tkMethod: ;
      tkWChar: JsStr:=Format('%s'#$A#$D' %s="%s";',[JsStr,RF.Name,RF.GetValue(FProcessObject).AsString]);
      tkLString: JsStr:=Format('%s'#$A#$D' %s="%s";',[JsStr,RF.Name,RF.GetValue(FProcessObject).AsString]);
      tkWString: JsStr:=Format('%s'#$A#$D' %s="%s";',[JsStr,RF.Name,RF.GetValue(FProcessObject).AsString]);
      tkVariant: ;
      tkArray: ;
      tkRecord: ;
      tkInterface: ;
      tkInt64: JsStr:=Format('%s'#$A#$D' %s=%d;',[JsStr,RF.Name,RF.GetValue(FProcessObject).AsInteger]);
      tkDynArray: ;
      tkUString: JsStr:=Format('%s'#$A#$D' %s="%s";',[JsStr,RF.Name,RF.GetValue(FProcessObject).AsString]);
      tkClassRef: ;
      tkPointer: ;
      tkProcedure: ;
    end;
  end;

  {Process property}
  for RP in RttiType.GetProperties  do
  begin
    JsStr:=Format('%s'#$A#$D' var %s;',[JsStr,RP.Name]);
    case RF.FieldType.TypeKind of
      tkUnknown: ;
      tkInteger: JsStr:=Format('%s'#$A#$D' %s=%d;',[JsStr,RP.Name,RP.GetValue(FProcessObject).AsInteger]);
      tkChar: JsStr:=Format('%s'#$A#$D' %s="%s";',[JsStr,RP.Name,RP.GetValue(FProcessObject).AsString]);
      tkEnumeration: JsStr:=Format('%s'#$A#$D' %s=%d;',[JsStr,RP.Name,RP.GetValue(FProcessObject).AsInteger]);
      tkFloat: JsStr:=Format('%s'#$A#$D' %s=%f;',[JsStr,RP.Name,RP.GetValue(FProcessObject).AsExtended]);
      tkString: JsStr:=Format('%s'#$A#$D' %s="%s";',[JsStr,RP.Name,RP.GetValue(FProcessObject).AsString]);
      tkSet: JsStr:=Format('%s'#$A#$D' %s=%d;',[JsStr,RP.Name,RP.GetValue(FProcessObject).AsInteger]);
      tkClass:{support later} JsStr:=Format('%s'#$A#$D' %s={};',[JsStr,RP.Name]);
      tkMethod: ;
      tkWChar: JsStr:=Format('%s'#$A#$D' %s="%s";',[JsStr,RP.Name,RP.GetValue(FProcessObject).AsString]);
      tkLString: JsStr:=Format('%s'#$A#$D' %s="%s";',[JsStr,RP.Name,RP.GetValue(FProcessObject).AsString]);
      tkWString: JsStr:=Format('%s'#$A#$D' %s="%s";',[JsStr,RP.Name,RP.GetValue(FProcessObject).AsString]);
      tkVariant: ;
      tkArray: ;
      tkRecord: ;
      tkInterface: ;
      tkInt64: JsStr:=Format('%s'#$A#$D' %s=%d;',[JsStr,RP.Name,RP.GetValue(FProcessObject).AsInteger]);
      tkDynArray: ;
      tkUString: if not RP.GetValue(FProcessObject).IsObject then  JsStr:=Format('%s'#$A#$D' %s="%s";',[JsStr,RP.Name,RP.GetValue(FProcessObject).AsString]);
      tkClassRef: ;
      tkPointer: ;
      tkProcedure: ;
    end;
  end;

  if not CefRegisterExtension(RttiType.Name,JsStr,FJsHandle) then
    Raise Exception.Create('Register JavaScript Extension Error');
end;

{ TVCLJsExtended.TNCJSHandle }

constructor TVCLJsExtended.TNCJSHandle.Create(
  Container: TVCLJsExtended);
begin
  inherited Create;
  FContainer:=Container;
end;

function TVCLJsExtended.TNCJSHandle.Execute(const name: ustring;
  const obj: ICefv8Value; const arguments: TCefv8ValueArray;
  var retval: ICefv8Value; var exception: ustring): Boolean;
var
   RttiContext:TRttiContext;
   rm:TRttiMember;
   M:TRttiMethod;
   F:TRttiField;
   P:TRttiProperty;
   A:TRttiArrayType;
   nameType:TANameTYpe;
   o:TObject;
   n:string;

  function ObjectHaveName(const AObject:TObject; const name:String;out isMethod:TANameTYpe; out mb:TRttiMember):Boolean;
  var
     RttiType:TRttiType;
     RM:TRttiMethod;
     RP:TRttiProperty;
     RF:TRttiField;
  begin
     Result:=false;
     RttiType:=RttiContext.GetType(FContainer.FTypeInfo);
     for RM in RttiType.GetMethods do
     begin
        then
       begin
         isMethod:=ntMethod;
         mb:=RM;
         Exit(True);
       end;
     end;

     for RP in RttiType.GetProperties do
     begin
        then
       begin
         isMethod:=ntProperty;
         mb:=RP;
         Exit(True);
       end;
     end;

     for RF in RttiType.GetFields do
     begin
        then
       begin
         isMethod:=ntField;
         mb:=RF;
         Exit(True);
       end;
     end;
  end;
begin
  Result:=true;
  O:=FContainer.ProcessObject;
  n:=name;
  if not ObjectHaveName(O,name,nameType,rm) then
  begin
     exception:=csHaveNoThisMember;
     Exit(False);
  end;

  case nameType of
    ntMethod:
    begin
       M:=rm as TRttiMethod;

       //Assert(M.MethodKind<>mkFunction);
        then
       begin
         ) and (Length(arguments)=Length(M.GetParameters)) then
         begin
           JsCallMethod(M,retval,arguments);

         end
         else
         begin
           exception:=csErrorParameters;
           Exit(False);
         end;
       end
       else
       begin
         JsCallMethod(M,retval);
       end;

    end;
    ntField:
    begin
       F:=rm as TRttiField;
       case F.FieldType.TypeKind of
         tkUnknown: ;
         tkInteger: retval:=TCefv8ValueRef.CreateInt(F.GetValue(FContainer.ProcessObject).AsInteger);
         tkChar: retval:=TCefv8ValueRef.CreateString(F.GetValue(FContainer.ProcessObject).AsString);
         tkEnumeration: retval:=TCefv8ValueRef.CreateInt(F.GetValue(FContainer.ProcessObject).AsInteger);
         tkFloat: retval:=TCefv8ValueRef.CreateDouble(F.GetValue(FContainer.ProcessObject).AsExtended);
         tkString: retval:=TCefv8ValueRef.CreateString(F.GetValue(FContainer.ProcessObject).AsString);
         tkSet: retval:=TCefv8ValueRef.CreateInt(F.GetValue(FContainer.ProcessObject).AsInteger);
         tkClass: ;//retval:=TCefv8ValueRef.CreateObject(F.GetValue(FContainer.ProcessObject).AsObject);
         tkMethod: ;
         tkWChar: retval:=TCefv8ValueRef.CreateString(F.GetValue(FContainer.ProcessObject).AsString);
         tkLString: retval:=TCefv8ValueRef.CreateString(F.GetValue(FContainer.ProcessObject).AsString);
         tkWString: retval:=TCefv8ValueRef.CreateString(F.GetValue(FContainer.ProcessObject).AsString);
         tkVariant: ;
         tkArray:
         begin
                   {
                    retval:=TCefv8ValueRef.CreateArray;
                    A:=F.FieldType as TRttiArrayType;
                    //support only one demision array
                    if A.DimensionCount=1 then
                     for I := 0 to A.TotalElementCount do
                     begin
                       case A.ElementType.TypeKind of
                         tkUnknown: retval.SetValueByIndex(I,TCefv8ValueRef.create());
                         tkInteger: ;
                         tkChar: ;
                         tkEnumeration: ;
                         tkFloat: ;
                         tkString: ;
                         tkSet: ;
                         tkClass: ;
                         tkMethod: ;
                         tkWChar: ;
                         tkLString: ;
                         tkWString: ;
                         tkVariant: ;
                         tkArray: ;
                         tkRecord: ;
                         tkInterface: ;
                         tkInt64: ;
                         tkDynArray: ;
                         tkUString: ;
                         tkClassRef: ;
                         tkPointer: ;
                         tkProcedure: ;
                       end;
                       retval.SetValueByIndex(I,TCefv8ValueRef.create)
                     end;

                    retval.SetValueByIndex()
                  end;;
           tkRecord: ;
           tkInterface: ;
           tkInt64: retval:=TCefv8ValueRef.CreateInt(F.GetValue(FContainer.ProcessObject).AsInteger);
           tkDynArray: ;
           tkUString: retval:=TCefv8ValueRef.CreateString(F.GetValue(FContainer.ProcessObject).AsString);
           tkClassRef: ;
           tkPointer: retval:=TCefv8ValueRef.CreateInt(F.GetValue(FContainer.ProcessObject).AsInteger);
           tkProcedure: ;  }
         end;
       end;
    end;
    ntProperty:
     begin
       P:=rm as TRttiProperty;
       case P.PropertyType.TypeKind of
         tkUnknown: ;
         tkInteger: retval:=TCefv8ValueRef.CreateInt(p.GetValue(FContainer.ProcessObject).AsInteger);
         tkChar: retval:=TCefv8ValueRef.CreateString(p.GetValue(FContainer.ProcessObject).AsString);
         tkEnumeration: retval:=TCefv8ValueRef.CreateInt(p.GetValue(FContainer.ProcessObject).AsInteger);
         tkFloat: retval:=TCefv8ValueRef.CreateDouble(p.GetValue(FContainer.ProcessObject).AsExtended);
         tkString: retval:=TCefv8ValueRef.CreateString(p.GetValue(FContainer.ProcessObject).AsString);
         tkSet: retval:=TCefv8ValueRef.CreateInt(p.GetValue(FContainer.ProcessObject).AsInteger);
         tkClass: ;//retval:=TCefv8ValueRef.CreateObject(p.GetValue(FContainer.ProcessObject).AsObject);
         tkMethod: ;
         tkWChar: retval:=TCefv8ValueRef.CreateString(p.GetValue(FContainer.ProcessObject).AsString);
         tkLString: retval:=TCefv8ValueRef.CreateString(p.GetValue(FContainer.ProcessObject).AsString);
         tkWString: retval:=TCefv8ValueRef.CreateString(p.GetValue(FContainer.ProcessObject).AsString);
         tkVariant: ;
         tkArray:;
       end;
     end;
  end;

end;

procedure TVCLJsExtended.TNCJSHandle.JsCallMethod(Method: TRttiMethod;
  out ReturnVal: ICefv8Value; const Param: TCefv8ValueArray);
var
   VA:array of TValue;
   I:Integer;
   rva:TValue;
   AInstance:TObject;
begin
  if Param<>nil then
  begin
    SetLength(VA,Length(Param));
      do
    begin
      if Param[I].IsBool then
         VA[I]:=TValue.From<Boolean>(Param[I].GetBoolValue);

      if Param[I].IsInt then
      begin
         VA[I]:=TValue.From<Integer>(Param[I].GetIntValue);
         Continue;
      end;

      if Param[I].IsDouble then
      begin
         VA[I]:=TValue.From<Double>(Param[I].GetDoubleValue);
         Continue;
      end;

      if Param[I].IsString then
         VA[I]:=TValue.From<String>(Param[I].GetStringValue);

      if Param[I].IsObject then
         {VA[I].AsObject:=Param[I].get};
      //if Param[I].is then

    end;
  end
  else
      ;//VA:=nil;
  AInstance:=FContainer.ProcessObject;
  Rva:=Method.Invoke(AInstance,VA);
  case rva.Kind of
    tkUnknown: ;
    tkInteger: ReturnVal:=TCefv8ValueRef.CreateInt(rva.AsInteger);
    tkChar: ReturnVal:=TCefv8ValueRef.CreateString(rva.AsString);
    tkEnumeration: ReturnVal:=TCefv8ValueRef.CreateInt(rva.AsOrdinal);
    tkFloat: ReturnVal:=TCefv8ValueRef.CreateDouble(rva.AsExtended);
    tkString: ReturnVal:=TCefv8ValueRef.CreateString(rva.AsString);
    tkSet: ReturnVal:=TCefv8ValueRef.CreateInt(rva.AsInteger);
    tkClass: ;//ReturnVal:=TCefv8ValueRef.CreateObject(rva.AsObject);
    tkMethod: ;
    tkWChar: ReturnVal:=TCefv8ValueRef.CreateString(rva.AsString);
    tkLString: ReturnVal:=TCefv8ValueRef.CreateString(rva.AsString);
    tkWString: ReturnVal:=TCefv8ValueRef.CreateString(rva.AsString);
    tkVariant: ;
    tkArray:;
    tkRecord: ;
    tkInterface: ;
    tkInt64: ReturnVal:=TCefv8ValueRef.CreateInt(rva.AsInteger);
    tkDynArray: ;
    tkUString: ReturnVal:=TCefv8ValueRef.CreateString(rva.AsString);
    tkClassRef: ;
    tkPointer: ;
    tkProcedure: ;
  end;
end;

procedure TVCLJsExtended.TNCJSHandle.JsCallMethod(Method: TRttiMethod;
  out ReturnVal: ICefv8Value);
begin
  JsCallMethod(Method,ReturnVal,nil);
end;

function TVCLJsExtended.TNCJSHandle.MethodParamLength(Mn: string): Integer;
var
   Rtx:TRttiContext;
   M:TRttiMethod;
   RT:TRttiType;
begin
   RT:=Rtx.GetType(FContainer.FTypeInfo);
   M:=Rt.GetMethod(Mn);
   Result:=Length(M.GetParameters);
end;

end.
 这是一个控件,他的功能是把delphi函数预注册到程序环境中,这样,在本程序内的所有chrome控件,都可以通过js调用到delphi函数,不过请注意,最好不要用到boolean类型的变量,这样会导致js调用不到delphi。

具体的用法可以在网上搜索下,我就里就不详细写了,毕竟是转载的。

黑屏问题

因为部分集成显卡版本太老或是不支持,导致webkit渲染失败,手动添加参数,关闭硬件渲染

procedure OnbeforeCmdLine(const processType: ustring;
const commandLine: ICefCommandLine);
begin
  commandLine.AppendSwitch('disable-gpu');
end;  

CefOnBeforeCommandLineProcessing := OnbeforeCmdLine;

让 DCEF 支持摄像头

当前版本需要手动添加参数,可能以后dcef3会提供接口甚至回调事件

procedure OnbeforeCmdLine(const processType: ustring;
const commandLine: ICefCommandLine);
begin
  commandLine.AppendSwitch('enable-media-stream');
end;  

CefOnBeforeCommandLineProcessing := OnbeforeCmdLine; 

支持 Flash

需要用到pepperflash插件,由于git上不能上传这类文件,还有版权问题,就未添加到TDcefBrowser里

if not CefLoadLibDefault then
  Exit;  

CefAddWebPluginPath(ExtractFilePath(Paramstr()) +
  'PepperFlash\pepflashplayer.dll');
CefRefreshWebPlugins();  

解决语言环境问题

单纯的设置CefLocale := 'zh-CN'有时并不能解决问题,JS获取的navigator.language的确为zh-CN,但很多网页通过HTTPACCEPTLANGUAGE来判断语言,例如QQ邮箱,因此我们需要在OnBeforeResourceLoad事件中做相应的设置

procedure TMainForm.DcefBrowserBeforeResourceLoad(const PageIndex: Integer;
  const browser: ICefBrowser; const frame: ICefFrame;
  const request: ICefRequest; var CancelLoad: Boolean);
var
  hm: ICefStringMultimap;
begin
  if Not request.IsReadOnly then
  begin
    hm := TCefStringMultimapOwn.Create;
    request.GetHeaderMap(hm);
    hm.Append('Accept-Language', 'zh-CN');
    request.SetHeaderMap(hm);
  end;
end;

CefSharp 实现 javascript 回调 c# 方法

http://www.cnblogs.com/worgeling/p/3421648.html

在构建完WebView webView = new WebView(url)后,即可调用RegisterJsObject方法来注册一个js对象,从而前端的javascript就可以访问这个对象,调用定义的方法。

public class CallbackObjectForJs{
    public void showMessage(string msg){
        MessageBox.Show(msg);
    }
}

WebView webView = new WebView("http://localhost:8080");
webView.RegisterJsObject("callbackObj", new CallbackObjectForJs());

前端页面javascript代码即可访问对象 callbackObj。

<script type="text/javascript">
    callbackObj.showMessage('message from js');
</script >

 注意:CallbackObjectForJs的showMessage方法首字母不能使大写,不然javascript回调的时候找不到对应的方法。原因还在分析中。。。

 PS:cefsharp是一个用于C#的浏览器控件(开源),C#自带的控件在IE内核适配的问题上处理起来有点麻烦,同时如果网页是重度使用javascript,那你可以考虑基于cef的各种浏览器控件,执行效率飙升。cefsharp的github:https://github.com/cefsharp/CefSharp

Use this code to delete Cookies from Chromium Version CEF3:

Use c_WB_ClearCookies for deleating all Cookies

Use c_WB_Clear_url_Cookies for deleating all Cookies only from one speceally Url like this -> c_WB_Clear_url_Cookies('http://google.com','cookie_name');

type
  CefTask = class(TCefTaskOwn)
    procedure Execute; override;

    public
    var url,cookieName: ustring;
    constructor create; virtual;
  end;

constructor CefTask.create;
begin
  inherited create;
  url := '';
  cookieName := '';
end;

procedure CefTask.Execute;
var CookieManager: ICefCookieManager;
begin
  CookieManager := TCefCookieManagerRef.Global;
  CookieManager.DeleteCookies(url,cookieName);
end;

procedure c_WB_ClearCookies;
var Task: CefTask;
begin
  Task := CefTask.Create;
  CefPostTask(TID_IO, Task);
end;

// c_WB_Clear_url_Cookies('http://google.com','cookie_name');
procedure c_WB_Clear_url_Cookies(c_url,c_cookieName: ustring);
var Task: CefTask;
begin
  Task := CefTask.Create;
  Task.url := c_url;
  Task.cookieName := c_cookieName;
  CefPostTask(TID_IO, Task);
end;

For list all Cookies to get the cookieName use Procedure list_all_cookies

procedure pausek;
var M: TMsg;
begin
  , , , pm_Remove) do
    begin
      TranslateMessage(M);
      DispatchMessage(M);
    end;
end;

procedure pause(i:longint);
var j : nativeint;
begin
   to i do
    begin
      pausek;
      sleep();
    end;
end;

procedure list_all_cookies;
var CookieManager: ICefCookieManager;
    cookie_list : string;
) + chr();
begin

  cookie_list := '';

  CookieManager := TCefCookieManagerRef.Global;

  CookieManager.VisitAllCookiesProc(

    function(const name, value, domain, path: ustring; secure, httponly,

      hasExpires: Boolean; const creation, lastAccess, expires: TDateTime;

      count, total: Integer; out deleteCookie: Boolean): Boolean

    begin

      cookie_list := cookie_list + inttostr(count) + ': ' +  domain + ' - ' + name + ' - ' + value + ' - ' + path + lf;

     if (count<total) then result := true;

    end

  );

  pause();

  ShowMessage(cookie_list);
end;

Create and get a cookie

http://stackoverflow.com/questions/16086160/delphi-chromium-embedded-create-and-get-a-cookie/23723741#23723741

Uses
  ceflib;

const
DefaultCookiesDir = 'Cookies/';

implementation
{$R *.dfm}

procedure TForm1.Button2Click(Sender: TObject);
var
  CookieManager: ICefCookieManager;
  CookiesPath : String;
begin
  CookiesPath := ExtractFilePath(Application.ExeName) + DefaultCookiesDir + 'User1';
  CookieManager := TCefCookieManagerRef.GetGlobalManager;
  CookieManager.SetStoragePath(CookiesPath);
  Chromium1.Load('www.vk.com');
end;

A guy form the official's DCEF3 forum provided the solution below, tested and approved !

CookieManager: ICefCookieManager;

FormCreate:
begin
   CookiesPath := ExtractFilePath(Application.ExeName) + 'cookies';
   CookieManager := TCefCookieManagerRef.Global(nil);
   CookieManager.SetStoragePath(CookiesPath, True, nil);
end;

FormClose:
begin
  CookieManager.FlushStore(nil);
end

为按钮添加单击事件 Sample

{$I cef.inc}

type
  TCustomRenderProcessHandler = class(TCefRenderProcessHandlerOwn)
  protected
    procedure OnWebKitInitialized; override;
    function OnProcessMessageReceived(const browser: ICefBrowser; sourceProcess: TCefProcessId;
      const message: ICefProcessMessage): Boolean; override;
  end;

  TTestExtension = class
    class function hello: string;
  end;

procedure TMainForm.Button2Click(Sender: TObject);
begin
  Chromium.browser.SendProcessMessage(PID_RENDERER,
    TCefProcessMessageRef.New('visitdom'));//操作DOM
end;

procedure ButtonClickProc(const Event: ICefDomEvent);
begin
  ShowMessage('Click The Button');
end;

procedure VisitDomProc(const Doc: ICefDomDocument);
var
  ButtonNode: ICefDomNode;
begin
  ButtonNode := Doc.GetElementById('su1');
  if Assigned(ButtonNode) then
    ButtonNode.AddEventListenerProc('click', True, ButtonClickProc);
end;

{ TCustomRenderProcessHandler }

function TCustomRenderProcessHandler.OnProcessMessageReceived(
  const browser: ICefBrowser; sourceProcess: TCefProcessId;
  const message: ICefProcessMessage): Boolean;
begin
{$IFDEF DELPHI14_UP}
  if (message.Name = 'visitdom') then
    begin
      browser.MainFrame.VisitDomProc( VisitDomProc);
        Result := True;
    end
  else
{$ENDIF}
    Result := False;
end;

procedure TCustomRenderProcessHandler.OnWebKitInitialized;
begin
{$IFDEF DELPHI14_UP}
  TCefRTTIExtension.Register('app', TTestExtension);
{$ENDIF}
end;

{ TTestExtension }

class function TTestExtension.hello: string;
begin
   Result := 'Hello from Delphi';
end;

initialization
  CefRenderProcessHandler := TCustomRenderProcessHandler.Create;
  CefBrowserProcessHandler := TCefBrowserProcessHandlerOwn.Create;
end.

DCEF3 相关资料的更多相关文章

  1. 全文检索解决方案(lucene工具类以及sphinx相关资料)

    介绍两种全文检索的技术. 1.  lucene+ 中文分词(IK) 关于lucene的原理,在这里可以得到很好的学习. http://www.blogjava.net/zhyiwww/archive/ ...

  2. React Test相关资料

    karma 前端测试驱动器,生产测试报告,多个浏览器 mocha js的测试框架,相当于junit chai,单元测试的断言库,提供expect shudl assert enzyme sinon.j ...

  3. iOS10以及xCode8相关资料收集

    兼容iOS 10 资料整理笔记 源文:http://www.jianshu.com/p/0cc7aad638d9 1.Notification(通知) 自从Notification被引入之后,苹果就不 ...

  4. Nao 类人机器人 相关资料

    Nao 类人机器人 相关资料: 1.兄妹 PEPPER :在山东烟台生产,http://www.robot-china.com/news/201510/30/26564.html 2.国内机器人领先公 ...

  5. GBrowse配置相关资料

    GBrowse配置相关资料(形状.颜色.配置.gff3) http://gmod.org/wiki/Glyphs_and_Glyph_Optionshttp://gmod.org/wiki/GBrow ...

  6. AssetBundle机制相关资料收集

    原地址:http://www.cnblogs.com/realtimepixels/p/3652075.html AssetBundle机制相关资料收集 最近网友通过网站搜索Unity3D在手机及其他 ...

  7. 转:基于IOS上MDM技术相关资料整理及汇总

    一.MDM相关知识: MDM (Mobile Device Management ),即移动设备管理.在21世纪的今天,数据是企业宝贵的资产,安全问题更是重中之重,在移动互联网时代,员工个人的设备接入 ...

  8. smb相关资料

    smb相关资料 看资料就上维基 https://en.wikipedia.org/wiki/Server_Message_Block#Implementation http://www.bing.co ...

  9. Linux命令学习总结之rmdir命令的相关资料可以参考下

    这篇文章主要介绍了Linux命令学习总结之rmdir命令的相关资料,需要的朋友可以参考下(http://www.nanke0834.com) 命令简介: rmdir命令用用来删除空目录,如果目录非空, ...

随机推荐

  1. sqlite3使用简介(内含解决sqlite内存的方法)

    一.使用流程 要使用sqlite,需要从sqlite官网下载到三个文件,分别为sqlite3.lib,sqlite3.dll,sqlite3.h,然后再在自己的工程中配置好头文件和库文件,同时将dll ...

  2. Nginx工作原理和优化、漏洞

    1.  Nginx的模块与工作原理 第三方模块:HTTP Upstream Request Hash模块.Notice模块和HTTP Access Key模块. 图1-1展示了Nginx模块常规的HT ...

  3. php 高效分页

    mysql.php 获取数据库中的记录,完全个人经验总结,仅供参考!<?php/***PHP+MYSQL数据库基本功能*http://blog.csdn.net/yown*/########## ...

  4. [LeetCode] Missing Number (A New Questions Added Today)

    Given an array containing n distinct numbers taken from 0, 1, 2, ..., n, find the one that is missin ...

  5. tcpdump dns包(linux高性能编程读书笔记2)

      tcpdump -i eth0 -nt -s 500 port domain host -t A www.baidu.com www.baidu.com is an alias for www.a ...

  6. Ios下解决libzbar.a不支持armv7s的方法

    解决 libzbar.a' for architecture armv7 的问题 下载最新的zbar源码 http://sourceforge.net/p/zbar/code/ci/default/t ...

  7. cocos2dx移植android平台-我的血泪史

    版权声明:本文由( 小塔 )原创,转载请保留文章出处! 本文链接:http://www.zaojiahua.com/android-platform.html 本人这几天一直都没有跟新自己的网站内容, ...

  8. windows下揪出java程序占用cpu很高的线程 并找到问题代码 死循环线程代码

    我的一个java程序偶尔会出现cpu占用很高的情况 一直不知道什么原因 今天终于抽时间解决了 系统是win2003 jvisualvm 和 jconsole貌似都只能看到总共占用的cpu 看不到每个线 ...

  9. Advanced Scene Processing

    [How a Scene Processes Frames of Animation] In the traditional view system, the contents of a view a ...

  10. test是否被执行?

    procedure TForm2.Button1Click(Sender: TObject);  function test(value:boolean):boolean;  begin    res ...