Always run TryCloseBrowser in the CEF UI thread

This commit is contained in:
Salvador Díaz Fau 2024-09-12 12:42:58 +02:00
parent b5e337f36c
commit aba0ec399c
4 changed files with 67 additions and 6 deletions

View File

@ -117,6 +117,7 @@ type
FHTTPSUpgrade : TCefState;
FHSTSPolicyBypassList : ustring;
FCredentialsService : TCefState;
FTryingToCloseBrowser : boolean;
{$IFDEF LINUX}
FXDisplay : PXDisplay;
@ -694,6 +695,7 @@ type
procedure doSetAudioMuted(aValue : boolean); virtual;
procedure doToggleAudioMuted; virtual;
procedure doEnableFocus; virtual;
function doTryCloseBrowser : boolean; virtual;
function MustCreateAudioHandler : boolean; virtual;
function MustCreateCommandHandler : boolean; virtual;
@ -3979,6 +3981,7 @@ begin
FHTTPSUpgrade := STATE_DEFAULT;
FHSTSPolicyBypassList := '';
FCredentialsService := STATE_DEFAULT;
FTryingToCloseBrowser := False;
{$IFDEF LINUX}
FXDisplay := nil;
{$ENDIF}
@ -4867,8 +4870,13 @@ end;
procedure TChromiumCore.CloseBrowser(aForceClose : boolean);
begin
if Initialized then
begin
if (RuntimeStyle <> CEF_RUNTIME_STYLE_ALLOY) then
SetBrowserIsClosing(browser.Identifier);
Browser.Host.CloseBrowser(aForceClose);
end;
end;
procedure TChromiumCore.CloseAllBrowsers;
begin
@ -4882,9 +4890,26 @@ begin
end;
function TChromiumCore.TryCloseBrowser : boolean;
var
TempTask : ICefTask;
begin
if Initialized then
Result := Browser.Host.TryCloseBrowser
begin
if FTryingToCloseBrowser then
Result := False
else
if CefCurrentlyOn(TID_UI) then
Result := doTryCloseBrowser
else
try
Result := False;
FTryingToCloseBrowser := True;
TempTask := TCefTryCloseBrowserTask.Create(self);
CefPostTask(TID_UI, TempTask);
finally
TempTask := nil;
end;
end
else
Result := True;
end;
@ -5196,7 +5221,8 @@ begin
if Initialized then
begin
TempFrame := Browser.MainFrame;
if (TempFrame <> nil) and TempFrame.IsValid then TempFrame.LoadRequest(aRequest);
if (TempFrame <> nil) and TempFrame.IsValid then
TempFrame.LoadRequest(aRequest);
end;
end;
@ -5692,7 +5718,8 @@ begin
if Initialized then
begin
TempFrame := Browser.MainFrame;
if (TempFrame <> nil) and TempFrame.IsValid then Result := TempFrame.URL;
if (TempFrame <> nil) and TempFrame.IsValid then
Result := TempFrame.URL;
end;
end;
@ -7697,6 +7724,16 @@ begin
AudioMuted := not(AudioMuted);
end;
function TChromiumCore.doTryCloseBrowser: boolean;
begin
if Initialized then
Result := Browser.Host.TryCloseBrowser
else
Result := True;
FTryingToCloseBrowser := False;
end;
procedure TChromiumCore.doEnableFocus;
begin
FCanFocus := True;

View File

@ -507,6 +507,7 @@ type
procedure doSetAudioMuted(aValue : boolean);
procedure doToggleAudioMuted;
procedure doEnableFocus;
function doTryCloseBrowser : boolean;
function MustCreateAudioHandler : boolean;
function MustCreateCommandHandler : boolean;
function MustCreateLoadHandler : boolean;

View File

@ -197,6 +197,11 @@ type
procedure Execute; override;
end;
TCefTryCloseBrowserTask = class(TCefChromiumTask)
protected
procedure Execute; override;
end;
implementation
uses
@ -677,4 +682,22 @@ begin
end;
end;
// TCefTryCloseBrowserTask
procedure TCefTryCloseBrowserTask.Execute;
begin
try
try
if CanExecute then
IChromiumEvents(FEvents).doTryCloseBrowser;
except
on e : exception do
if CustomExceptionHandler('TCefTryCloseBrowserTask.Execute', e) then raise;
end;
finally
FEvents := nil;
end;
end;
end.

View File

@ -2,7 +2,7 @@
"UpdateLazPackages" : [
{
"ForceNotify" : true,
"InternalVersion" : 654,
"InternalVersion" : 655,
"Name" : "cef4delphi_lazarus.lpk",
"Version" : "128.4.9"
}