Delphi 10.1和CEF3的Cookie出现问题

Question

I have this code:

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;

If I set Result := false in my function VisitCookie - I only get the value of the first cookie, that's all. Ie pass through the cookies does not happen. But if I set Result := true - I got an access violation, but it works fine, until I have not so much cookies records in Chromium, for example 5-10 records. I have no idea why this happens.

Answer 1

The problem is that the visitor callback function of the 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 method returns immediately and the callback function is then called asynchronously from the CEF worker thread.

There are many ways how to implement such cooperation. But it's not CEF specific. It's about how to pass (or collect) certain data from a worker thread callback and pass it back to the main thread. Optionally also about taking the callback under control in a synchronous way (to interrupt running enumeration).

Here is one untested example (maybe too overcomplicated). The principle remains, how to collect data from an uncontrolled thread callback function for the main thread (or take it under control in a synchronous way):

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;

And a possible usage:

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;