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

Delete the cache and cookies directories in a thread

Browse Source
This commit is contained in:
Salvador Díaz Fau
2018-09-18 15:19:44 +02:00
parent e6d4d7bce5
commit 833d50134a
2 changed files with 116 additions and 36 deletions
Download Patch File Download Diff File Expand all files Collapse all files

109
source/uCEFApplication.pas
View File

@@ -251,10 +251,10 @@ type
function ExecuteProcess(const aApp : ICefApp) : integer;
procedure InitializeSettings(var aSettings : TCefSettings);
function InitializeLibrary(const aApp : ICefApp) : boolean;
procedure RenameAndDeleteDir(const aDirectory : string);
function MultiExeProcessing : boolean;
function SingleExeProcessing : boolean;
function CheckCEFLibrary : boolean;
procedure DeleteDirContents(const aDirectory : string);
procedure RegisterWidevineCDM;
function FindFlashDLL(var aFileName : string) : boolean;
procedure ShowErrorMessageDlg(const aError : string); virtual;
@@ -409,6 +409,16 @@ type
constructor Create(const aCookies : string; aPersistSessionCookies : boolean);
end;
TCEFDirectoryDeleterThread = class(TThread)
protected
FDirectory : string;
procedure Execute; override;
public
constructor Create(const aDirectory : string);
end;
var
GlobalCEFApp : TCefApplication = nil;
@@ -1050,8 +1060,8 @@ begin
try
if (aApp <> nil) then
begin
if FDeleteCache then DeleteDirContents(FCache);
if FDeleteCookies then DeleteDirContents(FCookies);
if FDeleteCache then RenameAndDeleteDir(FCache);
if FDeleteCookies then RenameAndDeleteDir(FCookies);
RegisterWidevineCDM;
@@ -1079,41 +1089,46 @@ begin
end;
end;
procedure TCefApplication.DeleteDirContents(const aDirectory : string);
{$IFNDEF DELPHI14_UP}
procedure TCefApplication.RenameAndDeleteDir(const aDirectory : string);
var
TempRec : TSearchRec;
{$ENDIF}
TempOldDir, TempNewDir : string;
i : integer;
TempThread : TCEFDirectoryDeleterThread;
begin
try
if (length(aDirectory) > 0) and DirectoryExists(aDirectory) then
begin
{$IFDEF DELPHI14_UP}
TDirectory.Delete(aDirectory, True);
{$ELSE}
if (FindFirst(aDirectory + '\*', faAnyFile, TempRec) = 0) then
begin
try
repeat
if ((TempRec.Attr and faDirectory) <> 0) then
begin
if (TempRec.Name <> '.') and (TempRec.Name <> '..') then
DeleteDirContents(aDirectory + '\' + TempRec.Name)
end
else
DeleteFile(aDirectory + '\' + TempRec.Name);
until (FindNext(TempRec) <> 0);
finally
FindClose(TempRec);
end;
end;
{$ENDIF}
end;
except
if (length(aDirectory) = 0) or not(DirectoryExists(aDirectory)) then exit;
TempOldDir := ExcludeTrailingPathDelimiter(aDirectory);
if (Pos(PathDelim, TempOldDir, 1) > 0) and
(length(ExtractFileName(TempOldDir)) > 0) then
begin
i := 0;
repeat
inc(i);
TempNewDir := TempOldDir + '(' + inttostr(i) + ')';
until not(DirectoryExists(TempNewDir));
if MoveFileW(PWideChar(TempOldDir + chr(0)), PWideChar(TempNewDir + chr(0))) then
begin
TempThread := TCEFDirectoryDeleterThread.Create(TempNewDir);
{$IFDEF DELPHI14_UP}
TempThread.Start;
{$ELSE}
TempThread.Resume;
{$ENDIF}
end
else
DeleteDirContents(aDirectory);
end
else
DeleteDirContents(aDirectory);
except
on e : exception do
if CustomExceptionHandler('TCefApplication.DeleteDirContents', e) then raise;
end;
end;
if CustomExceptionHandler('TCefApplication.RenameAndDeleteDir', e) then raise;
end;
end;
procedure TCefApplication.RegisterWidevineCDM;
var
@@ -2286,4 +2301,30 @@ begin
end;
end;
// TCEFDirectoryDeleterThread
constructor TCEFDirectoryDeleterThread.Create(const aDirectory : string);
begin
inherited Create(True);
FDirectory := aDirectory;
FreeOnTerminate := True;
end;
procedure TCEFDirectoryDeleterThread.Execute;
begin
try
{$IFDEF DELPHI14_UP}
TDirectory.Delete(FDirectory, True);
{$ELSE}
if DeleteDirContents(FDirectory) then RemoveDir(FDirectory);
{$ENDIF}
except
on e : exception do
if CustomExceptionHandler('TCEFDirectoryDeleterThread.Execute', e) then raise;
end;
end;

43
source/uCEFMiscFunctions.pas
View File

@@ -52,9 +52,9 @@ interface
uses
{$IFDEF DELPHI16_UP}
{$IFDEF MSWINDOWS}WinApi.Windows, WinApi.ActiveX,{$ENDIF} System.Classes, System.SysUtils, System.UITypes, System.Math,
{$IFDEF MSWINDOWS}WinApi.Windows, WinApi.ActiveX,{$ENDIF} System.IOUtils, System.Classes, System.SysUtils, System.UITypes, System.Math,
{$ELSE}
{$IFDEF MSWINDOWS}Windows, ActiveX,{$ENDIF} Classes, SysUtils, Controls, Graphics, Math,
{$IFDEF MSWINDOWS}Windows, ActiveX,{$ENDIF} {$IFDEF DELPHI14_UP}IOUtils,{$ENDIF} Classes, SysUtils, Controls, Graphics, Math,
{$ENDIF}
uCEFTypes, uCEFInterfaces, uCEFLibFunctions, uCEFResourceHandler,
uCEFRegisterCDMCallback;
@@ -221,6 +221,8 @@ procedure LogicalToDevice(var aRect : TCEFRect; const aDeviceScaleFactor : doubl
function GetScreenDPI : integer;
function GetDeviceScaleFactor : single;
function DeleteDirContents(const aDirectory : string) : boolean;
implementation
uses
@@ -1814,4 +1816,41 @@ begin
Result := GetScreenDPI / 96;
end;
function DeleteDirContents(const aDirectory : string) : boolean;
var
TempRec : TSearchRec;
TempPath : string;
begin
Result := True;
try
if (length(aDirectory) > 0) and
DirectoryExists(aDirectory) and
(FindFirst(aDirectory + '\*', faAnyFile, TempRec) = 0) then
try
repeat
TempPath := aDirectory + PathDelim + TempRec.Name;
if ((TempRec.Attr and faDirectory) <> 0) then
begin
if (TempRec.Name <> '.') and (TempRec.Name <> '..') then
begin
if DeleteDirContents(TempPath) then
Result := RemoveDir(TempPath) and Result
else
Result := False;
end;
end
else
Result := DeleteFile(TempPath) and Result;
until (FindNext(TempRec) <> 0) or not(Result);
finally
FindClose(TempRec);
end;
except
on e : exception do
if CustomExceptionHandler('DeleteDirContents', e) then raise;
end;
end;
end.