DCEF3 相关资料
转自:https://www.cnblogs.com/xiefang2008/p/5969610.html
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,'',0);
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]);
if Length(RM.GetParameters)=0 then
JsStr:=Format('%s);',[JsStr])
else
begin
for I := 0 to Length(RM.GetParameters)-2 do
JsStr:=Format('%s %s,',[JsStr,chr(ord('A')+I)]);
I:=Length(RM.GetParameters)-1;
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
if CompareText(RM.Name,name)=0 then
begin
isMethod:=ntMethod;
mb:=RM;
Exit(True);
end;
end;
for RP in RttiType.GetProperties do
begin
if CompareText(RP.Name,name)=0 then
begin
isMethod:=ntProperty;
mb:=RP;
Exit(True);
end;
end;
for RF in RttiType.GetFields do
begin
if CompareText(RF.Name,name)=0 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);
if Length(M.GetParameters)>0 then
begin
if (Length(arguments)>0) 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));
for I := 0 to Length(Method.GetParameters)-1 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(0)) +
'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
while PeekMessage(M, 0, 0, 0, pm_Remove) do
begin
TranslateMessage(M);
DispatchMessage(M);
end;
end;
procedure pause(i:longint);
var j : nativeint;
begin
for j := 1 to i do
begin
pausek;
sleep(100);
end;
end;
procedure list_all_cookies;
var CookieManager: ICefCookieManager;
cookie_list : string;
const lf = chr(13) + chr(10);
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(10);
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.