to create a browser (windows7sp1 chrom105.3-CEF4Delphi (TChromium)), load a link, process the page and close the browser I apply the following code below (the code is not complete, just to understand the processes):
Code: Select all
unit uMain;
interface
uses
{$IFDEF DELPHI16_UP}
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls,
{$ELSE}
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls,
{$ENDIF}
uCEFChromium, uCEFWindowParent, uCEFInterfaces, uCEFConstants, uCEFTypes, uCEFChromiumCore, uCEFWinControl, uCefProcessMessage;
type
TMain = class(TForm)
CEFWindowParent1: TCEFWindowParent;
crm: TChromium;
tmr_ : TTimer;
...
protected
//FClosing: Boolean; //???
FCanClose: Boolean;
glUrlStr: string;
glUrlStack: TStringList;
...
(* You have to handle this two messages to call NotifyMoveOrResizeStarted or some page elements will be
misaligned *)
procedure WMMove(var aMessage: TWMMove); message WM_MOVE;
procedure WMMoving(var aMessage: TMessage); message WM_MOVING;
(* You also have to handle these two messages to setGlobalCEFApp.OsmodalLoop *)
procedure WMEnterMenuLoop(var aMessage: TMessage); message WM_ENTERMENULOOP;
procedure WMExitMenuLoop(var aMessage: TMessage); message WM_EXITMENULOOP;
procedure BrowserDestroyMsg(var aMessage: TMessage); message CEF_DESTROY;
public
{ Public declarations }
end;
var
Main: TMain;
implementation
procedure TMain.FormCreate(Sender: TObject);
begin
glUrlStack := TStringList.Create;
ConfIni := TMemIniFile.Create(ExtractFilePath(Application.ExeName) + 'BroConf.ini');
glUrlStr := ConfIni.ReadString('StrConfigBowser', 'Param1', 'https://gogo.com');
...
ConfIni := TMemIniFile.Create(ExtractFilePath(Application.ExeName) + 'conf.ini');
...
FCanClose := false;
//FClosing := false;
end;
procedure TMain.FormShow(Sender: TObject);
begin (* create browser *)
glUrlStack.Text := glUrlStr;
crm.CreateBrowser(CEFWindowParent1);
Tmr_start.Enabled := true; // complete process startup
tmr_Stop.Enabled := true; // close the browser in any case after 60 seconds if for some reason it froze
end;
procedure TMain.tmr_StopTimer(Sender: TObject);
begin (* close app after 60 sec*)
tmr_Stop.Enabled := false;
Main.Close;
end;
procedure TMain.Tmr_startTimer(Sender: TObject);
begin
Tmr_start.Enabled := false;
UrlStr := glUrlStack[0]; // link transfer to download
glUrlStack.Delete(0);
(* start load url *)
crm.ClearCache;
crm.DeleteCookies();
crm.LoadImagesAutomatically := false; (* do not load pic *)
if not(UrlStr.Equals('')) then crm.LoadURL(UrlStr);
tmr_Ctrl_A_C.Enabled := true; // start the page text retrieval process
end;
procedure TMain.tmr_Ctrl_A_CTimer(Sender: TObject);
begin
tmr_Ctrl_A_C.Enabled := false;
crm.RetrieveText;
glLoadCtrl := 0;
tmr_Load_Ctrl.Enabled := true; // start the page load control process
end;
procedure TMain.tmr_Load_CtrlTimer(Sender: TObject);
begin
Inc(glLoadCtrl, 1); // not the whole code, wait 10 seconds and close the application.
if not(glPageTxt.Equals('')) then
begin (* page is loaded after 3000 ms *)
tmr_Load_Ctrl.Enabled := false;
crm.browser.MainFrame.GetSourceProc(CallbackGetHtml);
tmr_Start_Processing_Text.Enabled := true; // page loaded, start processing
end;
end;
procedure TMain.tmr_Start_Processing_TextTimer(Sender: TObject);
begin
tmr_Start_Processing_Text.Enabled := false;
if DomenErrorUrls(gDomrnErrosLst.Text, PageTxt, gRange, Rate) then
begin
if glLoadNextLink then tmr_Wait_Start.Enabled := true;
end
else
begin
if not(HtmlCode.Equals('')) then
begin
if (gAllJS.Equals('')) and (cLinkStr.Equals('')) then
begin
if glLoadNextLink then tmr_Wait_Start.Enabled := true; // If the page doesn't match, close the application.
end
else
begin
if not(gAllJS.Equals('')) then
begin
tmr_StartAllJS.Enabled := true;
end
else
begin
if glLoadNextLink and (glUrlStack.Count = 0) then tmr_Wait_Start.Enabled := true;
end;
end;
end;
end;
procedure TMain.tmr_Wait_StartTimer(Sender: TObject);
begin
tmr_Wait_Start.Enabled := false;
Main.Close; // start process to close application
end;
procedure TMain.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
CanClose := FCanClose;
Visible := false;
crm.CloseBrowser(true); // without this line the browser form closes but all threads live (task manager).
{if not(FClosing) then
begin
FClosing := true; ???
Visible := false;
crm.CloseBrowser(true);
end;}
end;
procedure TMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
ConfIni := TMemIniFile.Create(ExtractFilePath(Application.ExeName) + 'BroConf.ini');
ConfIni.WriteBool('BoolConfigBowser', 'Param1', true); // just signal about the browser closed to another application that controls the browser start
{crm.CloseBrowser(true);
crm.CloseAllBrowsers;
crm.Destroy;} // it makes worse.
end;
procedure TMain.FormDestroy(Sender: TObject);
begin
FreeAndNil(glUrlStack);
// these three lines are necessary
crm.CloseBrowser(true);
crm.CloseAllBrowsers;
crm.Destroy;
end;
-----------------------------------*
procedure TMain.crmAfterCreated(Sender: TObject; const browser: ICefBrowser);
begin (* Now the browser is fully initialized we can send a message to the main
form to load the initial web page. *)
PostMessage(Handle, CEF_AFTERCREATED, 0, 0);
end;
procedure TMain.crmBeforeClose(Sender: TObject; const browser: ICefBrowser);
begin (* close form after chrom closed *)
FCanClose := true;
PostMessage(Handle, WM_CLOSE, 0, 0);
end;
procedure TMain.crmBeforePopup(Sender: TObject; const browser: ICefBrowser; const frame: ICefFrame;
const targetUrl, targetFrameName: ustring; targetDisposition: TCefWindowOpenDisposition;
userGesture: Boolean; const popupFeatures: TCefPopupFeatures; var windowInfo: TCefWindowInfo;
var client: ICefClient; var settings: TCefBrowserSettings; var extra_info: ICefDictionaryValue;
var noJavascriptAccess, Result: Boolean);
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 TMain.crmClose(Sender: TObject; const browser: ICefBrowser; var aAction: TCefCloseBrowserAction);
begin
PostMessage(Handle, CEF_DESTROY, 0, 0);
aAction := cbaDelay;
end;
procedure TMain.crmOpenUrlFromTab(Sender: TObject; const browser: ICefBrowser; const frame: ICefFrame;
const targetUrl: ustring; targetDisposition: TCefWindowOpenDisposition; userGesture: Boolean;
out Result: Boolean);
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 TMain.WMMove(var aMessage: TWMMove);
begin
inherited;
if (crm <> nil) then
crm.NotifyMoveOrResizeStarted;
end;
procedure TMain.WMMoving(var aMessage: TMessage);
begin
inherited;
if (crm <> nil) then
crm.NotifyMoveOrResizeStarted;
end;
procedure TMain.WMEnterMenuLoop(var aMessage: TMessage);
begin
inherited;
if (aMessage.wParam = 0) and (GlobalCEFApp <> nil) then
GlobalCEFApp.OsmodalLoop := true;
end;
procedure TMain.WMExitMenuLoop(var aMessage: TMessage);
begin
inherited;
if (aMessage.wParam = 0) and (GlobalCEFApp <> nil) then
GlobalCEFApp.OsmodalLoop := false;
end;
procedure TMain.BrowserDestroyMsg(var aMessage: TMessage);
begin
FreeAndNil(CEFWindowParent1);
end;
initialization
ReportMemoryLeaksOnShutdown := true;
end.
2) sometimes there are links (no way to determine which ones yet) to sites with the following when loading them:
- a single thread can consume up to 2 gb of memory or from 4 mb
- when closing the application, the thread remains hanging in the processor memory without consuming the processor, until the computer is shut down by the operator.
- dozens of such threads accumulate, sometimes the computer freezes, apparently there is not enough memory for all of them.
at the same time the browser application is closed and the application controller calls a new browser, and it works normally, just in the computer memory there are extra threads from previous browser launches.
If possible, please point out a way to properly close the browser application (code above) so that no unnecessary threads are left hanging.
Thank you.
