Delphi 10.1 和 CEF3 关于 cookie 的问题
Delphi 10.1 and CEF3 troubles with cookies
我有这个代码:
function VisitCookie(const name, value, domain, path: ustring;
secure, httponly, hasExpires: Boolean; const creation, lastAccess,
expires: TdateTime; Count, total: integer; out deleteCookie: Boolean)
: Boolean;
begin
RichEdit1.Lines.Add('cookie ' + inttostr(Count) + '/' + inttostr(total));
RichEdit1.Lines.Add('name ' + name);
RichEdit1.Lines.Add('value ' + value);
RichEdit1.Lines.Add('domain ' + domain);
RichEdit1.Lines.Add('path ' + path);
RichEdit1.Lines.Add('secure ' + BoolToStr(secure));
RichEdit1.Lines.Add('httponly ' + BoolToStr(httponly));
RichEdit1.Lines.Add('hasExpires ' + BoolToStr(hasExpires));
RichEdit1.Lines.Add('creation ' + DateToStr(creation));
RichEdit1.Lines.Add('lastAccess ' + DateToStr(lastAccess));
RichEdit1.Lines.Add('expires ' + DateToStr(expires));
RichEdit1.Lines.Add('------------------------');
Result := true;
end;
function GetCookies: Boolean;
begin
CookieManager := TCefCookieManagerRef.Global(nil);
CookieManager.VisitAllCookiesProc(VisitCookie);
end;
如果我在我的函数中设置 Result := false
VisitCookie
- 我只得到第一个 cookie 的值,仅此而已。 IE。通过 cookies 不会发生。但是如果我设置 Result := true
- 我遇到了访问冲突,但它工作正常,直到我在 Chromium 中没有那么多 cookie 记录,例如 5-10 条记录。我不知道为什么会这样。
问题是 VisitAllCookies method is executed in the context of a CEF worker thread, not in a context of the main thread hence you cannot access VCL controls from there. The VisitAllCookies 方法的访问者回调函数 returns 立即从 CEF worker 线程异步调用回调函数.
实现这种合作的方式有很多种。但这不是特定于 CEF 的。它是关于如何从工作线程回调传递(或收集)某些数据并将其传递回主线程。还可以选择 以同步方式控制 回调(中断 运行 枚举)。
这是一个未经测试的例子(可能太复杂了)。原理依旧,如何从主线程的不受控线程回调函数中采集数据(或者同步控制):
type
TCookie = record
Name: string;
Value: string;
Expires: TDateTime;
end;
TProcessCookieEvent = procedure(Sender: TObject; const Cookie: TCookie;
const IsLast: Boolean; var Delete: Boolean; var Cancel: Boolean) of object;
TCookieManager = class
private
FWndHandle: HWND;
FOnProcessCookie: TProcessCookieEvent;
protected
procedure WndProc(var Msg: TMessage); virtual;
public
constructor Create;
destructor Destroy; override;
procedure ProcessCookies(Timeout: UINT = 5000);
property OnProcessCookie: TProcessCookieEvent read FOnProcessCookie write FOnProcessCookie;
end;
implementation
const
PA_CANCEL = 1;
PA_DELETE = 2;
CM_PROCESSCOOKIE = WM_USER + 100;
type
PCookie = ^TCookie;
constructor TCookieManager.Create;
begin
inherited;
FWndHandle := AllocateHWnd(WndProc);
end;
destructor TCookieManager.Destroy;
begin
DeallocateHWnd(FWndHandle);
inherited;
end;
procedure TCookieManager.WndProc(var Msg: TMessage);
var
Delete: Boolean;
Cancel: Boolean;
IsLast: Boolean;
begin
if Msg.Msg = CM_PROCESSCOOKIE then
begin
Msg.Result := 0;
if Assigned(FOnProcessCookie) then
try
Delete := False;
Cancel := False;
IsLast := Boolean(Msg.wParam);
FOnProcessCookie(Self, PCookie(Msg.lParam)^, IsLast, Delete, Cancel);
if Delete then
Msg.Result := Msg.Result or PA_DELETE;
if Cancel then
Msg.Result := Msg.Result or PA_CANCEL;
except
Application.HandleException(Self);
end;
end
else
Msg.Result := DefWindowProc(FWndHandle, Msg.Msg, Msg.wParam, Msg.lParam);
end;
procedure TCookieManager.ProcessCookies(Timeout: UINT = 5000);
var
CookieManager: ICefCookieManager;
begin
CookieManager := TCefCookieManagerRef.Global(nil);
CookieManager.VisitAllCookiesProc(
{ this function will be called asynchronously from a CEF worker thread }
function(const Name, Value, Domain, Path: UString; Secure, HTTPOnly,
HasExpires: Boolean; const Creation, LastAccess, Expires: TDateTime;
Count, Total: Integer; out DeleteCookie: Boolean): Boolean
var
MsgRet: DWORD;
Cookie: TCookie;
IsLast: Boolean;
begin
{ initialize cancel of enumeration and no cookie deletion }
Result := False;
DeleteCookie := False;
{ fill the cookie structure }
Cookie.Name := string(Name);
Cookie.Value := string(Value);
Cookie.Expires := Expires;
{ determine if it's the last enumerated cookie }
IsLast := Count = Total-1;
{ yes, I'm doing what many would not do, but let me explain, this is not
SendMessage, that could get stuck forever when the message pump of the
receiver got stucked so I've let this thread responsive (SMTO_NORMAL),
let this call fail when the receiver is "hung" (SMTO_ABORTIFHUNG) and
let the function fail if the receiver is destroyed (SMTO_ERRORONEXIT)
and there is the timeout, in which the receiver needs to process this
message (if the message is not processed for some reason, enumerating
stops) }
if SendMessageTimeout(FWndHandle, CM_PROCESSCOOKIE, WPARAM(IsLast),
LPARAM(@Cookie), SMTO_NORMAL or SMTO_ABORTIFHUNG or SMTO_ERRORONEXIT,
Timeout, MsgRet) <> 0 then
begin
Result := MsgRet and PA_CANCEL <> PA_CANCEL;
DeleteCookie := MsgRet and PA_DELETE = PA_DELETE;
end;
{ else GetLastError and try to signal error by posting another message }
end;
);
end;
以及可能的用法:
type
TForm1 = class(TForm)
Button1: TButton;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
FCookieList: TList<TCookie>;
FCookieManager: TCookieManager;
procedure DoProcessCookie(Sender: TObject; const Cookie: TCookie;
const IsLast: Boolean; var Delete: Boolean; var Cancel: Boolean);
end;
implementation
procedure TForm1.FormCreate(Sender: TObject);
begin
FCookieList := TList<TCookie>.Create;
FCookieManager := TCookieManager.Create;
FCookieManager.OnProcessCookie := DoProcessCookie;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
FCookieManager.Free;
FCookieList.Free;
end;
procedure TForm1.DoProcessCookie(Sender: TObject; const Cookie: TCookie;
const IsLast: Boolean; var Delete: Boolean; var Cancel: Boolean);
begin
{ IsLast signals last enumerated cookie, Delete output parameter can delete
the currently enumerated cookie, and Cancel output parameter can stop the
enumeration }
FCookieList.Add(Cookie);
if IsLast then
ShowMessage('All cookies has been enumerated!');
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
FCookieList.Clear;
FCookieManager.ProcessCookies;
end;
我有这个代码:
function VisitCookie(const name, value, domain, path: ustring;
secure, httponly, hasExpires: Boolean; const creation, lastAccess,
expires: TdateTime; Count, total: integer; out deleteCookie: Boolean)
: Boolean;
begin
RichEdit1.Lines.Add('cookie ' + inttostr(Count) + '/' + inttostr(total));
RichEdit1.Lines.Add('name ' + name);
RichEdit1.Lines.Add('value ' + value);
RichEdit1.Lines.Add('domain ' + domain);
RichEdit1.Lines.Add('path ' + path);
RichEdit1.Lines.Add('secure ' + BoolToStr(secure));
RichEdit1.Lines.Add('httponly ' + BoolToStr(httponly));
RichEdit1.Lines.Add('hasExpires ' + BoolToStr(hasExpires));
RichEdit1.Lines.Add('creation ' + DateToStr(creation));
RichEdit1.Lines.Add('lastAccess ' + DateToStr(lastAccess));
RichEdit1.Lines.Add('expires ' + DateToStr(expires));
RichEdit1.Lines.Add('------------------------');
Result := true;
end;
function GetCookies: Boolean;
begin
CookieManager := TCefCookieManagerRef.Global(nil);
CookieManager.VisitAllCookiesProc(VisitCookie);
end;
如果我在我的函数中设置 Result := false
VisitCookie
- 我只得到第一个 cookie 的值,仅此而已。 IE。通过 cookies 不会发生。但是如果我设置 Result := true
- 我遇到了访问冲突,但它工作正常,直到我在 Chromium 中没有那么多 cookie 记录,例如 5-10 条记录。我不知道为什么会这样。
问题是 VisitAllCookies method is executed in the context of a CEF worker thread, not in a context of the main thread hence you cannot access VCL controls from there. The VisitAllCookies 方法的访问者回调函数 returns 立即从 CEF worker 线程异步调用回调函数.
实现这种合作的方式有很多种。但这不是特定于 CEF 的。它是关于如何从工作线程回调传递(或收集)某些数据并将其传递回主线程。还可以选择 以同步方式控制 回调(中断 运行 枚举)。
这是一个未经测试的例子(可能太复杂了)。原理依旧,如何从主线程的不受控线程回调函数中采集数据(或者同步控制):
type
TCookie = record
Name: string;
Value: string;
Expires: TDateTime;
end;
TProcessCookieEvent = procedure(Sender: TObject; const Cookie: TCookie;
const IsLast: Boolean; var Delete: Boolean; var Cancel: Boolean) of object;
TCookieManager = class
private
FWndHandle: HWND;
FOnProcessCookie: TProcessCookieEvent;
protected
procedure WndProc(var Msg: TMessage); virtual;
public
constructor Create;
destructor Destroy; override;
procedure ProcessCookies(Timeout: UINT = 5000);
property OnProcessCookie: TProcessCookieEvent read FOnProcessCookie write FOnProcessCookie;
end;
implementation
const
PA_CANCEL = 1;
PA_DELETE = 2;
CM_PROCESSCOOKIE = WM_USER + 100;
type
PCookie = ^TCookie;
constructor TCookieManager.Create;
begin
inherited;
FWndHandle := AllocateHWnd(WndProc);
end;
destructor TCookieManager.Destroy;
begin
DeallocateHWnd(FWndHandle);
inherited;
end;
procedure TCookieManager.WndProc(var Msg: TMessage);
var
Delete: Boolean;
Cancel: Boolean;
IsLast: Boolean;
begin
if Msg.Msg = CM_PROCESSCOOKIE then
begin
Msg.Result := 0;
if Assigned(FOnProcessCookie) then
try
Delete := False;
Cancel := False;
IsLast := Boolean(Msg.wParam);
FOnProcessCookie(Self, PCookie(Msg.lParam)^, IsLast, Delete, Cancel);
if Delete then
Msg.Result := Msg.Result or PA_DELETE;
if Cancel then
Msg.Result := Msg.Result or PA_CANCEL;
except
Application.HandleException(Self);
end;
end
else
Msg.Result := DefWindowProc(FWndHandle, Msg.Msg, Msg.wParam, Msg.lParam);
end;
procedure TCookieManager.ProcessCookies(Timeout: UINT = 5000);
var
CookieManager: ICefCookieManager;
begin
CookieManager := TCefCookieManagerRef.Global(nil);
CookieManager.VisitAllCookiesProc(
{ this function will be called asynchronously from a CEF worker thread }
function(const Name, Value, Domain, Path: UString; Secure, HTTPOnly,
HasExpires: Boolean; const Creation, LastAccess, Expires: TDateTime;
Count, Total: Integer; out DeleteCookie: Boolean): Boolean
var
MsgRet: DWORD;
Cookie: TCookie;
IsLast: Boolean;
begin
{ initialize cancel of enumeration and no cookie deletion }
Result := False;
DeleteCookie := False;
{ fill the cookie structure }
Cookie.Name := string(Name);
Cookie.Value := string(Value);
Cookie.Expires := Expires;
{ determine if it's the last enumerated cookie }
IsLast := Count = Total-1;
{ yes, I'm doing what many would not do, but let me explain, this is not
SendMessage, that could get stuck forever when the message pump of the
receiver got stucked so I've let this thread responsive (SMTO_NORMAL),
let this call fail when the receiver is "hung" (SMTO_ABORTIFHUNG) and
let the function fail if the receiver is destroyed (SMTO_ERRORONEXIT)
and there is the timeout, in which the receiver needs to process this
message (if the message is not processed for some reason, enumerating
stops) }
if SendMessageTimeout(FWndHandle, CM_PROCESSCOOKIE, WPARAM(IsLast),
LPARAM(@Cookie), SMTO_NORMAL or SMTO_ABORTIFHUNG or SMTO_ERRORONEXIT,
Timeout, MsgRet) <> 0 then
begin
Result := MsgRet and PA_CANCEL <> PA_CANCEL;
DeleteCookie := MsgRet and PA_DELETE = PA_DELETE;
end;
{ else GetLastError and try to signal error by posting another message }
end;
);
end;
以及可能的用法:
type
TForm1 = class(TForm)
Button1: TButton;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
FCookieList: TList<TCookie>;
FCookieManager: TCookieManager;
procedure DoProcessCookie(Sender: TObject; const Cookie: TCookie;
const IsLast: Boolean; var Delete: Boolean; var Cancel: Boolean);
end;
implementation
procedure TForm1.FormCreate(Sender: TObject);
begin
FCookieList := TList<TCookie>.Create;
FCookieManager := TCookieManager.Create;
FCookieManager.OnProcessCookie := DoProcessCookie;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
FCookieManager.Free;
FCookieList.Free;
end;
procedure TForm1.DoProcessCookie(Sender: TObject; const Cookie: TCookie;
const IsLast: Boolean; var Delete: Boolean; var Cancel: Boolean);
begin
{ IsLast signals last enumerated cookie, Delete output parameter can delete
the currently enumerated cookie, and Cancel output parameter can stop the
enumeration }
FCookieList.Add(Cookie);
if IsLast then
ShowMessage('All cookies has been enumerated!');
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
FCookieList.Clear;
FCookieManager.ProcessCookies;
end;