pascal/CEF4Delphi
1
0
Fork 0
mirror of https://github.com/salvadordf/CEF4Delphi.git synced 2025-08-04 21:32:54 +02:00
Code Issues Actions Releases Activity

Update to CEF 93.1.11

Browse Source 
Fixed issue #378  in the VCL demos
This commit is contained in:
Salvador Díaz Fau
2021-09-05 10:49:20 +02:00
parent b3f388709a
commit 83a75c985a
26 changed files with 396 additions and 624 deletions
Download Patch File Download Diff File Expand all files Collapse all files

59
demos/Delphi_VCL/CookieVisitor/uCookieVisitor.pas
View File

@ -34,9 +34,13 @@
* this source code without explicit permission.
*
*)
unit uCookieVisitor;
{$I cef.inc}
interface
uses
{$IFDEF DELPHI16_UP}
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
@ -48,6 +52,7 @@ uses
uCEFChromium, uCEFWindowParent, uCEFInterfaces, uCEFApplication, uCEFTypes, uCEFConstants,
uCEFCookieManager, uCEFCookieVisitor, uCEFWinControl, uCEFSentinel,
uCEFChromiumCore;
const
MINIBROWSER_SHOWCOOKIES = WM_APP + $101;
MINIBROWSER_COOKIESDELETED = WM_APP + $102;
@ -57,6 +62,7 @@ const
MINIBROWSER_CONTEXTMENU_SETCOOKIE = MENU_ID_USER_FIRST + 3;
MINIBROWSER_CONTEXTMENU_GETGOOGLECOOKIES = MENU_ID_USER_FIRST + 4;
MINIBROWSER_CONTEXTMENU_DELETECACHE = MENU_ID_USER_FIRST + 5;
type
TCookieVisitorFrm = class(TForm)
AddressBarPnl: TPanel;
@ -65,6 +71,7 @@ type
CEFWindowParent1: TCEFWindowParent;
Chromium1: TChromium;
Timer1: TTimer;
procedure Chromium1AfterCreated(Sender: TObject; const browser: ICefBrowser);
procedure Chromium1BeforeContextMenu(Sender: TObject; const browser: ICefBrowser; const frame: ICefFrame; const params: ICefContextMenuParams; const model: ICefMenuModel);
procedure Chromium1ContextMenuCommand(Sender: TObject; const browser: ICefBrowser; const frame: ICefFrame; const params: ICefContextMenuParams; commandId: Integer; eventFlags: Cardinal; out Result: Boolean);
@ -80,6 +87,7 @@ type
procedure FormShow(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
private
procedure WMMove(var aMessage : TWMMove); message WM_MOVE;
procedure WMMoving(var aMessage : TMessage); message WM_MOVING;
@ -90,21 +98,29 @@ type
procedure ShowCookiesMsg(var aMessage : TMessage); message MINIBROWSER_SHOWCOOKIES;
procedure CookiesDeletedMsg(var aMessage : TMessage); message MINIBROWSER_COOKIESDELETED;
procedure CookieSetMsg(var aMessage : TMessage); message MINIBROWSER_COOKIESET;
protected
FText : string;
// Variables to control when can we destroy the form safely
FCanClose : boolean; // Set to True in TChromium.OnBeforeClose
FClosing : boolean; // Set to True in the CloseQuery event.
public
procedure AddCookieInfo(const aCookie : TCookie);
end;
var
CookieVisitorFrm: TCookieVisitorFrm;
procedure CreateGlobalCEFApp;
implementation
{$R *.dfm}
uses
uSimpleTextViewer, uCEFTask, uCEFMiscFunctions, uCEFDictionaryValue;
// This demo has a context menu to test several TChromium functions related to cookies like TChromium.VisitAllCookies,
// TChromium.SetCookie, TChromium.DeleteCookies, etc.
// TChromium.VisitAllCookies and TChromium.VisitURLCookies trigger the TChromium.OnCookiesVisited event for each
@ -117,6 +133,7 @@ uses
// 1. FormCloseQuery sets CanClose to FALSE calls TChromium.CloseBrowser which triggers the TChromium.OnClose event.
// 2. TChromium.OnClose sends a CEFBROWSER_DESTROY message to destroy CEFWindowParent1 in the main thread, which triggers the TChromium.OnBeforeClose event.
// 3. TChromium.OnBeforeClose sets FCanClose := True and sends WM_CLOSE to the form.
procedure CreateGlobalCEFApp;
begin
GlobalCEFApp := TCefApplication.Create;
@ -124,56 +141,69 @@ begin
//GlobalCEFApp.LogFile := 'cef.log';
//GlobalCEFApp.LogSeverity := LOGSEVERITY_VERBOSE;
end;
procedure TCookieVisitorFrm.AddCookieInfo(const aCookie : TCookie);
begin
// This should be protected by a mutex.
FText := FText + aCookie.name + ' : ' + aCookie.value + ' (' + aCookie.domain + ')' + #13 + #10;
end;
procedure TCookieVisitorFrm.BrowserCreatedMsg(var aMessage : TMessage);
begin
CEFWindowParent1.UpdateSize;
AddressBarPnl.Enabled := True;
end;
procedure TCookieVisitorFrm.BrowserDestroyMsg(var aMessage : TMessage);
begin
CEFWindowParent1.Free;
end;
procedure TCookieVisitorFrm.ShowCookiesMsg(var aMessage : TMessage);
begin
SimpleTextViewerFrm.Memo1.Lines.Text := FText; // This should be protected by a mutex.
SimpleTextViewerFrm.ShowModal;
end;
procedure TCookieVisitorFrm.CookiesDeletedMsg(var aMessage : TMessage);
begin
showmessage('Deleted cookies : ' + inttostr(aMessage.lParam));
end;
procedure TCookieVisitorFrm.CookieSetMsg(var aMessage : TMessage);
begin
Chromium1.FlushCookieStore;
if (aMessage.wParam <> 0) then
showmessage('Cookie set successfully !')
else
showmessage('There was a problem setting the cookie');
end;
procedure TCookieVisitorFrm.Timer1Timer(Sender: TObject);
begin
Timer1.Enabled := False;
if not(Chromium1.CreateBrowser(CEFWindowParent1, '')) and not(Chromium1.Initialized) then
Timer1.Enabled := True;
end;
procedure TCookieVisitorFrm.GoBtnClick(Sender: TObject);
begin
Chromium1.LoadURL(Edit1.Text);
end;
procedure TCookieVisitorFrm.Chromium1AfterCreated(Sender: TObject; const browser: ICefBrowser);
begin
PostMessage(Handle, CEF_AFTERCREATED, 0, 0);
end;
procedure TCookieVisitorFrm.Chromium1BeforeClose(Sender: TObject; const browser: ICefBrowser);
begin
FCanClose := True;
PostMessage(Handle, WM_CLOSE, 0, 0);
end;
procedure TCookieVisitorFrm.Chromium1BeforeContextMenu(Sender: TObject;
const browser: ICefBrowser; const frame: ICefFrame;
const params: ICefContextMenuParams; const model: ICefMenuModel);
@ -186,6 +216,7 @@ begin
model.AddItem(MINIBROWSER_CONTEXTMENU_SETCOOKIE, 'Set cookie');
model.AddItem(MINIBROWSER_CONTEXTMENU_DELETECACHE, 'Delete cache');
end;
procedure TCookieVisitorFrm.Chromium1BeforePopup(Sender: TObject;
const browser: ICefBrowser; const frame: ICefFrame; const targetUrl,
targetFrameName: ustring; targetDisposition: TCefWindowOpenDisposition;
@ -199,12 +230,14 @@ begin
// For simplicity, this demo blocks all popup windows and new tabs
Result := (targetDisposition in [WOD_NEW_FOREGROUND_TAB, WOD_NEW_BACKGROUND_TAB, WOD_NEW_POPUP, WOD_NEW_WINDOW]);
end;
procedure TCookieVisitorFrm.Chromium1Close(Sender: TObject;
const browser: ICefBrowser; var aAction : TCefCloseBrowserAction);
begin
PostMessage(Handle, CEF_DESTROY, 0, 0);
aAction := cbaDelay;
end;
procedure TCookieVisitorFrm.Chromium1ContextMenuCommand(Sender: TObject;
const browser: ICefBrowser; const frame: ICefFrame;
const params: ICefContextMenuParams; commandId: Integer;
@ -213,18 +246,21 @@ begin
Result := False;
case commandId of
MINIBROWSER_CONTEXTMENU_DELETECOOKIES : Chromium1.DeleteCookies;
MINIBROWSER_CONTEXTMENU_GETCOOKIES :
begin
// This should be protected by a mutex
FText := '';
Chromium1.VisitAllCookies;
end;
MINIBROWSER_CONTEXTMENU_GETGOOGLECOOKIES :
begin
// This should be protected by a mutex
FText := '';
Chromium1.VisitURLCookies('https://www.google.com');
end;
MINIBROWSER_CONTEXTMENU_SETCOOKIE :
Chromium1.SetCookie('https://www.example.com',
'example_cookie_name',
@ -240,19 +276,23 @@ begin
CEF_COOKIE_SAME_SITE_UNSPECIFIED,
CEF_COOKIE_PRIORITY_MEDIUM,
False);
MINIBROWSER_CONTEXTMENU_DELETECACHE :
Chromium1.ExecuteDevToolsMethod(0, 'Network.clearBrowserCache', nil);
end;
end;
procedure TCookieVisitorFrm.Chromium1CookiesDeleted(Sender: TObject; numDeleted: Integer);
begin
PostMessage(Handle, MINIBROWSER_COOKIESDELETED, 0, numDeleted);
end;
procedure TCookieVisitorFrm.Chromium1CookieSet(Sender: TObject;
aSuccess: Boolean; aID: Integer);
begin
PostMessage(Handle, MINIBROWSER_COOKIESET, WPARAM(aSuccess), aID);
end;
procedure TCookieVisitorFrm.Chromium1CookiesVisited(Sender: TObject;
const name_, value, domain, path: ustring; secure, httponly,
hasExpires: Boolean; const creation, lastAccess, expires: TDateTime; count,
@ -262,6 +302,7 @@ var
TempCookie : TCookie;
begin
aDeleteCookie := False;
TempCookie.name := name_;
TempCookie.value := value;
TempCookie.domain := domain;
@ -274,53 +315,71 @@ begin
TempCookie.expires := expires;
TempCookie.same_site := same_site;
TempCookie.priority := priority;
AddCookieInfo(TempCookie);
aResult := (count <> pred(total));
end;
procedure TCookieVisitorFrm.Chromium1CookieVisitorDestroyed(Sender: TObject; aID: Integer);
begin
PostMessage(Handle, MINIBROWSER_SHOWCOOKIES, 0, 0);
end;
procedure TCookieVisitorFrm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
CanClose := FCanClose;
if not(FClosing) then
begin
FClosing := True;
Visible := False;
Chromium1.CloseBrowser(True);
end;
end;
procedure TCookieVisitorFrm.FormCreate(Sender: TObject);
begin
FCanClose := False;
FClosing := False;
Chromium1.DefaultURL := Edit1.Text;
end;
procedure TCookieVisitorFrm.FormShow(Sender: TObject);
begin
// GlobalCEFApp.GlobalContextInitialized has to be TRUE before creating any browser
// If it's not initialized yet, we use a simple timer to create the browser later.
if not(Chromium1.CreateBrowser(CEFWindowParent1, '')) then Timer1.Enabled := True;
end;
procedure TCookieVisitorFrm.WMMove(var aMessage : TWMMove);
begin
inherited;
if (Chromium1 <> nil) then Chromium1.NotifyMoveOrResizeStarted;
end;
procedure TCookieVisitorFrm.WMMoving(var aMessage : TMessage);
begin
inherited;
if (Chromium1 <> nil) then Chromium1.NotifyMoveOrResizeStarted;
end;
procedure TCookieVisitorFrm.WMEnterMenuLoop(var aMessage: TMessage);
begin
inherited;
if (aMessage.wParam = 0) and (GlobalCEFApp <> nil) then GlobalCEFApp.OsmodalLoop := True;
end;
procedure TCookieVisitorFrm.WMExitMenuLoop(var aMessage: TMessage);
begin
inherited;
if (aMessage.wParam = 0) and (GlobalCEFApp <> nil) then GlobalCEFApp.OsmodalLoop := False;
end;
end.