pascal/CEF4Delphi
1
0
Fork 0
mirror of https://github.com/salvadordf/CEF4Delphi.git synced 2025-02-02 10:25:26 +02:00
Code Issues Actions Releases Activity

Added functions and events to flush the cookies easily.

Browse Source 
- Added  TChromium.FlushCookieStore and TFMXChromium.FlushCookieStore functions.
- Added TChromium.OnCookiesFlushed and TFMXChromium.OnCookiesFlushed events
- Added a menu option in the MiniBrowser demo to test the new functions to flush the cookies.
This commit is contained in:
Salvador Díaz Fau 2019-09-16 11:28:48 +02:00
parent 8b948745ef
commit c7b91264cb
11 changed files with 353 additions and 41 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
demos/Delphi_VCL/MiniBrowser/uMiniBrowser.dfm
View File

@ -268,6 +268,7 @@ object MiniBrowserFrm: TMiniBrowserFrm
OnResolvedHostAvailable = Chromium1ResolvedHostAvailable
OnNavigationVisitorResultAvailable = Chromium1NavigationVisitorResultAvailable
OnDownloadImageFinished = Chromium1DownloadImageFinished
OnCookiesFlushed = Chromium1CookiesFlushed
OnRenderCompMsg = Chromium1RenderCompMsg
OnLoadEnd = Chromium1LoadEnd
OnLoadError = Chromium1LoadError
@ -359,6 +360,10 @@ object MiniBrowserFrm: TMiniBrowserFrm
Caption = 'Simulate keyboard presses'
OnClick = Simulatekeyboardpresses1Click
end
object Flushcookies1: TMenuItem
Caption = 'Flush cookies'
OnClick = Flushcookies1Click
end
object N5: TMenuItem
Caption = '-'
end

22
demos/Delphi_VCL/MiniBrowser/uMiniBrowser.pas
View File

@ -64,6 +64,7 @@ const
MINIBROWSER_COPYALLTEXT = WM_APP + $108;
MINIBROWSER_TAKESNAPSHOT = WM_APP + $109;
MINIBROWSER_SHOWNAVIGATION = WM_APP + $10A;
MINIBROWSER_COOKIESFLUSHED = WM_APP + $10B;
MINIBROWSER_HOMEPAGE = 'https://www.google.com';
@ -124,6 +125,7 @@ type
Memoryinfo1: TMenuItem;
Downloadimage1: TMenuItem;
Simulatekeyboardpresses1: TMenuItem;
Flushcookies1: TMenuItem;
procedure FormShow(Sender: TObject);
procedure BackBtnClick(Sender: TObject);
procedure ForwardBtnClick(Sender: TObject);
@ -222,6 +224,8 @@ type
const imageUrl: ustring; httpStatusCode: Integer;
const image: ICefImage);
procedure Simulatekeyboardpresses1Click(Sender: TObject);
procedure Flushcookies1Click(Sender: TObject);
procedure Chromium1CookiesFlushed(Sender: TObject);
protected
FResponse : TStringList;
@ -255,6 +259,7 @@ type
procedure ShowNavigationMsg(var aMessage : TMessage); message MINIBROWSER_SHOWNAVIGATION;
procedure SavePreferencesMsg(var aMessage : TMessage); message MINIBROWSER_SAVEPREFERENCES;
procedure TakeSnapshotMsg(var aMessage : TMessage); message MINIBROWSER_TAKESNAPSHOT;
procedure CookiesFlushedMsg(var aMessage : TMessage); message MINIBROWSER_COOKIESFLUSHED;
procedure WMMove(var aMessage : TWMMove); message WM_MOVE;
procedure WMMoving(var aMessage : TMessage); message WM_MOVING;
procedure WMEnterMenuLoop(var aMessage: TMessage); message WM_ENTERMENULOOP;
@ -289,6 +294,7 @@ begin
GlobalCEFApp.DisableFeatures := 'NetworkService,OutOfBlinkCors';
GlobalCEFApp.LogFile := 'debug.log';
GlobalCEFApp.LogSeverity := LOGSEVERITY_INFO;
GlobalCEFApp.cache := 'cache';
//GlobalCEFApp.RemoteDebuggingPort := 19999;
end;
@ -535,6 +541,16 @@ begin
end;
end;
procedure TMiniBrowserFrm.Chromium1CookiesFlushed(Sender: TObject);
begin
PostMessage(Handle, MINIBROWSER_COOKIESFLUSHED, 0, 0);
end;
procedure TMiniBrowserFrm.CookiesFlushedMsg(var aMessage : TMessage);
begin
showmessage('The cookies were flushed successfully');
end;
procedure TMiniBrowserFrm.Chromium1DownloadUpdated(Sender: TObject;
const browser: ICefBrowser; const downloadItem: ICefDownloadItem;
const callback: ICefDownloadItemCallback);
@ -920,6 +936,12 @@ begin
caption := 'MiniBrowser';
end;
procedure TMiniBrowserFrm.Flushcookies1Click(Sender: TObject);
begin
if not(Chromium1.FlushCookieStore(False)) then
showmessage('There was a problem flushing the cookies.');
end;
procedure TMiniBrowserFrm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
CanClose := FCanClose;

81
demos/Lazarus/MiniBrowser/MiniBrowser.lps
View File

@ -20,10 +20,15 @@
<ComponentName Value="MiniBrowserFrm"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<IsVisibleTab Value="True"/>
<EditorIndex Value="1"/>
<TopLine Value="1031"/>
<CursorPos X="93" Y="1044"/>
<TopLine Value="276"/>
<CursorPos X="45" Y="294"/>
<UsageCount Value="20"/>
<Bookmarks Count="2">
<Item0 X="3" Y="985" ID="1"/>
<Item1 X="66" Y="989" ID="2"/>
</Bookmarks>
<Loaded Value="True"/>
<LoadedDesigner Value="True"/>
<DefaultSyntaxHighlighter Value="Delphi"/>
@ -34,7 +39,6 @@
<ComponentName Value="PreferencesFrm"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<IsVisibleTab Value="True"/>
<EditorIndex Value="2"/>
<TopLine Value="69"/>
<CursorPos X="17" Y="92"/>
@ -76,114 +80,127 @@
<UsageCount Value="10"/>
</Unit6>
</Units>
<JumpHistory Count="27" HistoryIndex="26">
<JumpHistory Count="30" HistoryIndex="29">
<Position1>
<Filename Value="uMiniBrowser.pas"/>
<Caret Line="576" Column="79" TopLine="51"/>
</Position1>
<Position2>
<Filename Value="uMiniBrowser.pas"/>
<Caret Line="51" Column="83" TopLine="51"/>
<Caret Line="310" Column="64" TopLine="305"/>
</Position2>
<Position3>
<Filename Value="uMiniBrowser.pas"/>
<Caret Line="51" Column="83" TopLine="33"/>
<Caret Line="310" Column="64" TopLine="305"/>
</Position3>
<Position4>
<Filename Value="uMiniBrowser.pas"/>
<Caret Line="266" Column="8" TopLine="237"/>
<Caret Line="182" Column="15" TopLine="160"/>
</Position4>
<Position5>
<Filename Value="uMiniBrowser.pas"/>
<Caret Line="252" Column="76" TopLine="81"/>
<Caret Line="763" Column="26" TopLine="756"/>
</Position5>
<Position6>
<Filename Value="uMiniBrowser.pas"/>
<Caret Line="251" Column="76" TopLine="229"/>
<Caret Line="768" Column="69" TopLine="749"/>
</Position6>
<Position7>
<Filename Value="uMiniBrowser.pas"/>
<Caret Line="659" Column="10" TopLine="627"/>
<Caret Line="769" Column="69" TopLine="750"/>
</Position7>
<Position8>
<Filename Value="uMiniBrowser.pas"/>
<Caret Line="674" Column="20" TopLine="637"/>
<Caret Line="768" Column="69" TopLine="749"/>
</Position8>
<Position9>
<Filename Value="uMiniBrowser.pas"/>
<Caret Line="701" Column="32" TopLine="676"/>
<Caret Line="162" Column="61" TopLine="143"/>
</Position9>
<Position10>
<Filename Value="uMiniBrowser.pas"/>
<Caret Line="755" Column="28" TopLine="726"/>
<Caret Line="601" Column="52" TopLine="573"/>
</Position10>
<Position11>
<Filename Value="uMiniBrowser.pas"/>
<Caret Line="844" Column="42" TopLine="807"/>
<Caret Line="590" Column="20" TopLine="573"/>
</Position11>
<Position12>
<Filename Value="uMiniBrowser.pas"/>
<Caret Line="564" TopLine="553"/>
<Filename Value="MiniBrowser.lpr"/>
<Caret Line="54" TopLine="46"/>
</Position12>
<Position13>
<Filename Value="uMiniBrowser.pas"/>
<Caret Line="576" Column="79" TopLine="51"/>
<Caret Line="261" Column="11" TopLine="245"/>
</Position13>
<Position14>
<Filename Value="uMiniBrowser.pas"/>
<Caret Line="310" Column="64" TopLine="305"/>
<Caret Line="290" Column="76" TopLine="277"/>
</Position14>
<Position15>
<Filename Value="uMiniBrowser.pas"/>
<Caret Line="310" Column="64" TopLine="305"/>
<Caret Line="1032" Column="50" TopLine="1015"/>
</Position15>
<Position16>
<Filename Value="uMiniBrowser.pas"/>
<Caret Line="182" Column="15" TopLine="160"/>
<Caret Line="1044" Column="93" TopLine="1031"/>
</Position16>
<Position17>
<Filename Value="uMiniBrowser.pas"/>
<Caret Line="763" Column="26" TopLine="756"/>
<Caret Line="1045" Column="93" TopLine="1032"/>
</Position17>
<Position18>
<Filename Value="uMiniBrowser.pas"/>
<Caret Line="768" Column="69" TopLine="749"/>
<Caret Line="1046" Column="93" TopLine="1033"/>
</Position18>
<Position19>
<Filename Value="uMiniBrowser.pas"/>
<Caret Line="769" Column="69" TopLine="750"/>
<Caret Line="1053" Column="93" TopLine="1040"/>
</Position19>
<Position20>
<Filename Value="uMiniBrowser.pas"/>
<Caret Line="768" Column="69" TopLine="749"/>
<Caret Line="307" Column="55" TopLine="299"/>
</Position20>
<Position21>
<Filename Value="uMiniBrowser.pas"/>
<Caret Line="162" Column="61" TopLine="143"/>
<Caret Line="342" Column="9" TopLine="314"/>
</Position21>
<Position22>
<Filename Value="uMiniBrowser.pas"/>
<Caret Line="601" Column="52" TopLine="573"/>
<Caret Line="350" TopLine="345"/>
</Position22>
<Position23>
<Filename Value="uMiniBrowser.pas"/>
<Caret Line="590" Column="20" TopLine="573"/>
<Caret Line="982" Column="56" TopLine="980"/>
</Position23>
<Position24>
<Filename Value="MiniBrowser.lpr"/>
<Caret Line="54" TopLine="46"/>
<Filename Value="uMiniBrowser.pas"/>
<Caret Line="1015" Column="66" TopLine="994"/>
</Position24>
<Position25>
<Filename Value="uMiniBrowser.pas"/>
<Caret Line="261" Column="11" TopLine="245"/>
<Caret Line="258" Column="5" TopLine="251"/>
</Position25>
<Position26>
<Filename Value="uMiniBrowser.pas"/>
<Caret Line="290" Column="76" TopLine="277"/>
<Caret Line="988" Column="62" TopLine="980"/>
</Position26>
<Position27>
<Filename Value="uMiniBrowser.pas"/>
<Caret Line="1032" Column="50" TopLine="1015"/>
<Caret Line="246" Column="77" TopLine="245"/>
</Position27>
<Position28>
<Filename Value="uMiniBrowser.pas"/>
<Caret Line="388" Column="5" TopLine="364"/>
</Position28>
<Position29>
<Filename Value="uMiniBrowser.pas"/>
<Caret Line="988" Column="26" TopLine="969"/>
</Position29>
<Position30>
<Filename Value="uMiniBrowser.pas"/>
<Caret Line="258" Column="93" TopLine="245"/>
</Position30>
</JumpHistory>
<RunParams>
<FormatVersion Value="2"/>

14
demos/Lazarus/MiniBrowser/uMiniBrowser.lfm
View File

@ -241,6 +241,8 @@ object MiniBrowserFrm: TMiniBrowserFrm
OnPrefsAvailable = Chromium1PrefsAvailable
OnResolvedHostAvailable = Chromium1ResolvedHostAvailable
OnNavigationVisitorResultAvailable = Chromium1NavigationVisitorResultAvailable
OnDownloadImageFinished = Chromium1DownloadImageFinished
OnCookiesFlushed = Chromium1CookiesFlushed
OnLoadEnd = Chromium1LoadEnd
OnLoadError = Chromium1LoadError
OnLoadingStateChange = Chromium1LoadingStateChange
@ -323,6 +325,18 @@ object MiniBrowserFrm: TMiniBrowserFrm
Caption = 'Resolve host...'
OnClick = Resolvehost1Click
end
object MenuItem1: TMenuItem
Caption = 'Download image...'
OnClick = MenuItem1Click
end
object MenuItem2: TMenuItem
Caption = 'Simulate keyboard presses'
OnClick = MenuItem2Click
end
object MenuItem3: TMenuItem
Caption = 'Flush cookies'
OnClick = MenuItem3Click
end
object N5: TMenuItem
Caption = '-'
end

140
demos/Lazarus/MiniBrowser/uMiniBrowser.pas
View File

@ -45,7 +45,7 @@ uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Menus,
Controls, Forms, Dialogs, StdCtrls, ExtCtrls, Types, ComCtrls, ClipBrd, ActiveX, ShlObj,
uCEFChromium, uCEFWindowParent, uCEFInterfaces, uCEFApplication, uCEFTypes, uCEFConstants,
uCEFWinControl;
uCEFWinControl, uCEFChromiumEvents;
const
MINIBROWSER_SHOWDEVTOOLS = WM_APP + $101;
@ -57,7 +57,8 @@ const
MINIBROWSER_SAVEPREFERENCES = WM_APP + $107;
MINIBROWSER_COPYALLTEXT = WM_APP + $108;
MINIBROWSER_TAKESNAPSHOT = WM_APP + $109;
MINIBROWSER_SHOWNAVIGATION = WM_APP + $10A;
MINIBROWSER_SHOWNAVIGATION = WM_APP + $10A;
MINIBROWSER_COOKIESFLUSHED = WM_APP + $10B;
MINIBROWSER_HOMEPAGE = 'https://www.google.com';
@ -81,6 +82,9 @@ type
{ TMiniBrowserFrm }
TMiniBrowserFrm = class(TForm)
MenuItem1: TMenuItem;
MenuItem2: TMenuItem;
MenuItem3: TMenuItem;
NavControlPnl: TPanel;
NavButtonPnl: TPanel;
StatusPnl: TPanel;
@ -119,9 +123,15 @@ type
OpenfilewithaDAT1: TMenuItem;
N5: TMenuItem;
Memoryinfo1: TMenuItem;
procedure Chromium1CookiesFlushed(Sender: TObject);
procedure Chromium1DownloadImageFinished(Sender: TObject;
const imageUrl: ustring; httpStatusCode: Integer; const image: ICefImage);
procedure FormShow(Sender: TObject);
procedure BackBtnClick(Sender: TObject);
procedure ForwardBtnClick(Sender: TObject);
procedure MenuItem1Click(Sender: TObject);
procedure MenuItem2Click(Sender: TObject);
procedure MenuItem3Click(Sender: TObject);
procedure ReloadBtnClick(Sender: TObject);
procedure Chromium1AfterCreated(Sender: TObject;
const browser: ICefBrowser);
@ -245,6 +255,7 @@ type
procedure ShowNavigationMsg(var aMessage : TMessage); message MINIBROWSER_SHOWNAVIGATION;
procedure SavePreferencesMsg(var aMessage : TMessage); message MINIBROWSER_SAVEPREFERENCES;
procedure TakeSnapshotMsg(var aMessage : TMessage); message MINIBROWSER_TAKESNAPSHOT;
procedure CookiesFlushedMsg(var aMessage : TMessage); message MINIBROWSER_COOKIESFLUSHED;
procedure WMMove(var aMessage : TWMMove); message WM_MOVE;
procedure WMMoving(var aMessage : TMessage); message WM_MOVING;
procedure WMEnterMenuLoop(var aMessage: TMessage); message WM_ENTERMENULOOP;
@ -280,6 +291,7 @@ begin
GlobalCEFApp.LogFile := 'debug.log';
GlobalCEFApp.LogSeverity := LOGSEVERITY_INFO;
GlobalCEFApp.DisableFeatures := 'NetworkService,OutOfBlinkCors';
GlobalCEFApp.cache := 'cache';
end;
procedure TMiniBrowserFrm.BackBtnClick(Sender: TObject);
@ -292,6 +304,56 @@ begin
Chromium1.GoForward;
end;
procedure TMiniBrowserFrm.MenuItem1Click(Sender: TObject);
var
TempURL : string;
begin
TempURL := InputBox('Download Image', 'URL:', 'https://www.briskbard.com/images/logo.png');
if (length(TempURL) > 0) then
Chromium1.DownloadImage(TempURL, False, 0, False);
end;
procedure TMiniBrowserFrm.MenuItem2Click(Sender: TObject);
const
SIMULATED_KEY_PRESSES = 'QWERTY';
var
i : integer;
TempKeyEvent : TCefKeyEvent;
begin
// This procedure is extremely simplified.
// Use the SimpleOSRBrowser demo to log the real TCefKeyEvent values
// if you use anything different than uppercase letters.
for i := 1 to length(SIMULATED_KEY_PRESSES) do
begin
// WM_KEYDOWN
TempKeyEvent.kind := KEYEVENT_RAWKEYDOWN;
TempKeyEvent.modifiers := 0;
TempKeyEvent.windows_key_code := ord(SIMULATED_KEY_PRESSES[i]);
TempKeyEvent.native_key_code := 0;
TempKeyEvent.is_system_key := ord(False);
TempKeyEvent.character := #0;
TempKeyEvent.unmodified_character := #0;
TempKeyEvent.focus_on_editable_field := ord(False);
Chromium1.SendKeyEvent(@TempKeyEvent);
// WM_CHAR
TempKeyEvent.kind := KEYEVENT_CHAR;
Chromium1.SendKeyEvent(@TempKeyEvent);
// WM_KEYUP
TempKeyEvent.kind := KEYEVENT_KEYUP;
Chromium1.SendKeyEvent(@TempKeyEvent);
end;
end;
procedure TMiniBrowserFrm.MenuItem3Click(Sender: TObject);
begin
if not(Chromium1.FlushCookieStore(False)) then
showmessage('There was a problem flushing the cookies.');
end;
procedure TMiniBrowserFrm.GoBtnClick(Sender: TObject);
begin
Chromium1.LoadURL(URLCbx.Text);
@ -918,6 +980,80 @@ begin
if not(Chromium1.CreateBrowser(CEFWindowParent1, '')) then Timer1.Enabled := True;
end;
procedure TMiniBrowserFrm.Chromium1CookiesFlushed(Sender: TObject);
begin
PostMessage(Handle, MINIBROWSER_COOKIESFLUSHED, 0, 0);
end;
procedure TMiniBrowserFrm.CookiesFlushedMsg(var aMessage : TMessage);
begin
showmessage('The cookies were flushed successfully');
end;
procedure TMiniBrowserFrm.Chromium1DownloadImageFinished(Sender: TObject;
const imageUrl: ustring; httpStatusCode: Integer; const image: ICefImage);
var
TempBinValue : ICefBinaryValue;
TempWidth : integer;
TempHeight : integer;
TempBuffer : TBytes;
TempPointer : pointer;
TempSize : NativeUInt;
TempStream : TFileStream;
TempParts : TUrlParts;
i : integer;
begin
TempStream := nil;
try
try
if (httpStatusCode = 200) and (image <> nil) and not(image.IsEmpty) then
begin
TempBinValue := image.GetAsPng(1, True, TempWidth, TempHeight);
if (TempBinValue <> nil) and
TempBinValue.IsValid then
begin
TempSize := TempBinValue.Size;
SaveDialog1.DefaultExt := 'png';
SaveDialog1.Filter := 'PNG files (*.png)|*.PNG';
CefParseUrl(imageUrl, TempParts);
i := LastDelimiter('/', TempParts.path);
// TODO : The file name should be sanitized.
if (i > 0) then
SaveDialog1.FileName := copy(TempParts.path, succ(i), length(TempParts.path))
else
SaveDialog1.FileName := TempParts.path;
if (TempSize > 0) and
SaveDialog1.Execute and
(length(SaveDialog1.FileName) > 0) then
begin
SetLength(TempBuffer, TempSize);
TempPointer := @TempBuffer[0];
TempSize := TempBinValue.GetData(TempPointer, TempSize, 0);
if (TempSize > 0) then
begin
TempStream := TFileStream.Create(SaveDialog1.FileName, fmCreate);
TempStream.Write(TempBuffer, TempSize);
end;
end;
end;
end;
except
on e : exception do
if CustomExceptionHandler('Chromium1DownloadImageFinishedEvent', e) then raise;
end;
finally
if (TempStream <> nil) then FreeAndNil(TempStream);
SetLength(TempBuffer, 0);
end;
end;
procedure TMiniBrowserFrm.Timer1Timer(Sender: TObject);
begin
Timer1.Enabled := False;

37
source/uCEFChromium.pas
View File

@ -247,6 +247,7 @@ type
FOnResolvedHostAvailable : TOnResolvedIPsAvailableEvent;
FOnNavigationVisitorResultAvailable : TOnNavigationVisitorResultAvailableEvent;
FOnDownloadImageFinished : TOnDownloadImageFinishedEvent;
FOnCookiesFlushed : TNotifyEvent;
{$IFNDEF FPC}
FOnBrowserCompMsg : TOnCompMsgEvent;
FOnWidgetCompMsg : TOnCompMsgEvent;
@ -488,6 +489,7 @@ type
procedure doResolvedHostAvailable(result: TCefErrorCode; const resolvedIps: TStrings); virtual;
function doNavigationVisitorResultAvailable(const entry: ICefNavigationEntry; current: Boolean; index, total: Integer) : boolean; virtual;
procedure doDownloadImageFinished(const imageUrl: ustring; httpStatusCode: Integer; const image: ICefImage); virtual;
procedure doOnCookiesStoreFlushed; virtual;
function MustCreateLoadHandler : boolean; virtual;
function MustCreateFocusHandler : boolean; virtual;
function MustCreateContextMenuHandler : boolean; virtual;
@ -536,6 +538,7 @@ type
procedure SimulateMouseWheel(aDeltaX, aDeltaY : integer);
function DeleteCookies(const url : ustring = ''; const cookieName : ustring = '') : boolean;
function FlushCookieStore(aFlushImmediately : boolean = True) : boolean;
procedure RetrieveHTML(const aFrameName : ustring = ''); overload;
procedure RetrieveHTML(const aFrame : ICefFrame); overload;
procedure RetrieveHTML(const aFrameIdentifier : int64); overload;
@ -693,6 +696,7 @@ type
property OnResolvedHostAvailable : TOnResolvedIPsAvailableEvent read FOnResolvedHostAvailable write FOnResolvedHostAvailable;
property OnNavigationVisitorResultAvailable : TOnNavigationVisitorResultAvailableEvent read FOnNavigationVisitorResultAvailable write FOnNavigationVisitorResultAvailable;
property OnDownloadImageFinished : TOnDownloadImageFinishedEvent read FOnDownloadImageFinished write FOnDownloadImageFinished;
property OnCookiesFlushed : TNotifyEvent read FOnCookiesFlushed write FOnCookiesFlushed;
{$IFNDEF FPC}
property OnBrowserCompMsg : TOnCompMsgEvent read FOnBrowserCompMsg write FOnBrowserCompMsg;
property OnWidgetCompMsg : TOnCompMsgEvent read FOnWidgetCompMsg write FOnWidgetCompMsg;
@ -825,7 +829,7 @@ uses
uCEFBrowser, uCEFValue, uCEFDictionaryValue, uCEFStringMultimap, uCEFFrame,
uCEFApplication, uCEFProcessMessage, uCEFRequestContext, {$IFNDEF FPC}uCEFOLEDragAndDrop,{$ENDIF}
uCEFPDFPrintCallback, uCEFResolveCallback, uCEFDeleteCookiesCallback, uCEFStringVisitor,
uCEFListValue, uCEFNavigationEntryVisitor, uCEFDownloadImageCallBack;
uCEFListValue, uCEFNavigationEntryVisitor, uCEFDownloadImageCallBack, uCEFCookieManager;
constructor TChromium.Create(AOwner: TComponent);
begin
@ -1171,6 +1175,7 @@ begin
FOnResolvedHostAvailable := nil;
FOnNavigationVisitorResultAvailable := nil;
FOnDownloadImageFinished := nil;
FOnCookiesFlushed := nil;
{$IFNDEF FPC}
FOnBrowserCompMsg := nil;
FOnWidgetCompMsg := nil;
@ -2215,6 +2220,31 @@ begin
end;
end;
function TChromium.FlushCookieStore(aFlushImmediately : boolean = True) : boolean;
var
TempManager : ICefCookieManager;
TempCallback : ICefCompletionCallback;
begin
Result := False;
if Initialized and (FBrowser.Host <> nil) and (FBrowser.Host.RequestContext <> nil) then
begin
TempManager := FBrowser.Host.RequestContext.GetCookieManager(nil);
if (TempManager <> nil) then
try
if aFlushImmediately then
TempCallback := nil
else
TempCallback := TCefFlushStoreCompletionCallback.Create(self);
Result := TempManager.FlushStore(TempCallback);
finally
TempCallback := nil;
end;
end;
end;
// Leave aFrameName empty to get the HTML source from the main frame
procedure TChromium.RetrieveHTML(const aFrameName : ustring);
var
@ -3026,6 +3056,11 @@ begin
FOnDownloadImageFinished(self, imageUrl, httpStatusCode, image);
end;
procedure TChromium.doOnCookiesStoreFlushed;
begin
if assigned(FOnCookiesFlushed) then FOnCookiesFlushed(self);
end;
function TChromium.MustCreateLoadHandler : boolean;
begin
Result := assigned(FOnLoadStart) or

25
source/uCEFCompletionCallback.pas
View File

@ -81,6 +81,15 @@ type
destructor Destroy; override;
end;
TCefCustomCompletionCallback = class(TCefCompletionCallbackOwn)
protected
FEvents : Pointer;
public
constructor Create(const aEvents : IChromiumEvents); reintroduce;
destructor Destroy; override;
end;
implementation
uses
@ -148,4 +157,20 @@ begin
end;
// TCefCustomCompletionCallback
constructor TCefCustomCompletionCallback.Create(const aEvents : IChromiumEvents);
begin
inherited Create;
FEvents := aEvents;
end;
destructor TCefCustomCompletionCallback.Destroy;
begin
FEvents := nil;
inherited Destroy;
end;
end.

26
source/uCEFCookieManager.pas
View File

@ -54,7 +54,7 @@ uses
{$ELSE}
Classes, SysUtils,
{$ENDIF}
uCEFBaseRefCounted, uCEFInterfaces, uCEFTypes;
uCEFBaseRefCounted, uCEFInterfaces, uCEFTypes, uCEFCompletionCallback;
type
TCefCookieManagerRef = class(TCefBaseRefCountedRef, ICefCookieManager)
@ -78,10 +78,15 @@ type
class function GlobalProc(const callback: TCefCompletionCallbackProc): ICefCookieManager;
end;
TCefFlushStoreCompletionCallback = class(TCefCustomCompletionCallback)
protected
procedure OnComplete; override;
end;
implementation
uses
uCEFMiscFunctions, uCEFLibFunctions, uCEFCompletionCallback, uCEFDeleteCookiesCallback,
uCEFMiscFunctions, uCEFLibFunctions, uCEFDeleteCookiesCallback,
uCEFSetCookieCallback, uCEFCookieVisitor, uCEFStringList;
@ -218,4 +223,21 @@ begin
Result := VisitUrlCookies(url, includeHttpOnly, TCefFastCookieVisitor.Create(visitor) as ICefCookieVisitor);
end;
// TCefFlushStoreCompletionCallback
procedure TCefFlushStoreCompletionCallback.OnComplete;
begin
try
try
if (FEvents <> nil) then IChromiumEvents(FEvents).doOnCookiesStoreFlushed;
except
on e : exception do
if CustomExceptionHandler('TCefFlushStoreCompletionCallback.OnComplete', e) then raise;
end;
finally
FEvents := nil;
end;
end;
end.

41
source/uCEFFMXChromium.pas
View File

@ -230,6 +230,7 @@ type
FOnResolvedHostAvailable : TOnResolvedIPsAvailableEvent;
FOnNavigationVisitorResultAvailable : TOnNavigationVisitorResultAvailableEvent;
FOnDownloadImageFinished : TOnDownloadImageFinishedEvent;
FOnCookiesFlushed : TNotifyEvent;
{$IFDEF MSWINDOWS}
FOnBrowserCompMsg : TOnCompMsgEvent;
FOnWidgetCompMsg : TOnCompMsgEvent;
@ -455,6 +456,7 @@ type
procedure doResolvedHostAvailable(result: TCefErrorCode; const resolvedIps: TStrings); virtual;
function doNavigationVisitorResultAvailable(const entry: ICefNavigationEntry; current: Boolean; index, total: Integer) : boolean; virtual;
procedure doDownloadImageFinished(const imageUrl: ustring; httpStatusCode: Integer; const image: ICefImage); virtual;
procedure doOnCookiesStoreFlushed; virtual;
function MustCreateLoadHandler : boolean; virtual;
function MustCreateFocusHandler : boolean; virtual;
function MustCreateContextMenuHandler : boolean; virtual;
@ -503,6 +505,7 @@ type
procedure SimulateMouseWheel(aDeltaX, aDeltaY : integer);
function DeleteCookies(const url : ustring = ''; const cookieName : ustring = '') : boolean;
function FlushCookieStore(aFlushImmediately : boolean = True) : boolean;
procedure RetrieveHTML(const aFrameName : ustring = ''); overload;
procedure RetrieveHTML(const aFrame : ICefFrame); overload;
procedure RetrieveHTML(const aFrameIdentifier : int64); overload;
@ -651,7 +654,8 @@ type
property OnCookiesDeleted : TOnCookiesDeletedEvent read FOnCookiesDeleted write FOnCookiesDeleted;
property OnResolvedHostAvailable : TOnResolvedIPsAvailableEvent read FOnResolvedHostAvailable write FOnResolvedHostAvailable;
property OnNavigationVisitorResultAvailable : TOnNavigationVisitorResultAvailableEvent read FOnNavigationVisitorResultAvailable write FOnNavigationVisitorResultAvailable;
property OnDownloadImageFinishedEvent : TOnDownloadImageFinishedEvent read FOnDownloadImageFinished write FOnDownloadImageFinished;
property OnDownloadImageFinishedEvent : TOnDownloadImageFinishedEvent read FOnDownloadImageFinished write FOnDownloadImageFinished;
property OnCookiesFlushed : TNotifyEvent read FOnCookiesFlushed write FOnCookiesFlushed;
{$IFDEF MSWINDOWS}
property OnBrowserCompMsg : TOnCompMsgEvent read FOnBrowserCompMsg write FOnBrowserCompMsg;
property OnWidgetCompMsg : TOnCompMsgEvent read FOnWidgetCompMsg write FOnWidgetCompMsg;
@ -772,7 +776,7 @@ implementation
uses
System.SysUtils, System.Math,
uCEFBrowser, uCEFValue, uCEFDictionaryValue, uCEFStringMultimap, uCEFFrame,
uCEFApplication, uCEFProcessMessage, uCEFRequestContext,
uCEFApplication, uCEFProcessMessage, uCEFRequestContext, uCEFCookieManager,
uCEFPDFPrintCallback, uCEFResolveCallback, uCEFDeleteCookiesCallback, uCEFStringVisitor,
uCEFListValue, uCEFNavigationEntryVisitor, uCEFDownloadImageCallBack;
@ -1074,7 +1078,8 @@ begin
FOnCookiesDeleted := nil;
FOnResolvedHostAvailable := nil;
FOnNavigationVisitorResultAvailable := nil;
FOnDownloadImageFinished := nil;
FOnDownloadImageFinished := nil;
FOnCookiesFlushed := nil;
end;
function TFMXChromium.CreateBrowser(const aWindowName : ustring;
@ -1991,6 +1996,31 @@ begin
end;
end;
function TFMXChromium.FlushCookieStore(aFlushImmediately : boolean = True) : boolean;
var
TempManager : ICefCookieManager;
TempCallback : ICefCompletionCallback;
begin
Result := False;
if Initialized and (FBrowser.Host <> nil) and (FBrowser.Host.RequestContext <> nil) then
begin
TempManager := FBrowser.Host.RequestContext.GetCookieManager(nil);
if (TempManager <> nil) then
try
if aFlushImmediately then
TempCallback := nil
else
TempCallback := TCefFlushStoreCompletionCallback.Create(self);
Result := TempManager.FlushStore(TempCallback);
finally
TempCallback := nil;
end;
end;
end;
// Leave aFrameName empty to get the HTML source from the main frame
procedure TFMXChromium.RetrieveHTML(const aFrameName : ustring);
var
@ -2745,6 +2775,11 @@ begin
FOnDownloadImageFinished(self, imageUrl, httpStatusCode, image);
end;
procedure TFMXChromium.doOnCookiesStoreFlushed;
begin
if assigned(FOnCookiesFlushed) then FOnCookiesFlushed(self);
end;
function TFMXChromium.MustCreateLoadHandler : boolean;
begin
Result := assigned(FOnLoadStart) or

1
source/uCEFInterfaces.pas
View File

@ -388,6 +388,7 @@ type
procedure doResolvedHostAvailable(result: TCefErrorCode; const resolvedIps: TStrings);
function doNavigationVisitorResultAvailable(const entry: ICefNavigationEntry; current: Boolean; index, total: Integer) : boolean;
procedure doDownloadImageFinished(const imageUrl: ustring; httpStatusCode: Integer; const image: ICefImage);
procedure doOnCookiesStoreFlushed;
function MustCreateLoadHandler : boolean;
function MustCreateFocusHandler : boolean;
function MustCreateContextMenuHandler : boolean;

2
update_CEF4Delphi.json
View File

@ -2,7 +2,7 @@
"UpdateLazPackages" : [
{
"ForceNotify" : true,
"InternalVersion" : 28,
"InternalVersion" : 29,
"Name" : "cef4delphi_lazarus.lpk",
"Version" : "76.1.13.0"
}