I have an application that runs correctly when GlobalCEFApp.SingleProcess := True but when I change into GlobalCEFApp.SingleProcess := False then it stops working correctly.
The programs cannot exit this loop:
Code: Select all
procedure TForm4.Button1Click(Sender: TObject);
.....
while True do
begin
if MainPageScanned <> soNoScan then
begin
Break;
end;
Application.ProcessMessages;
end;
Code: Select all
program MyProgrem;
uses
Vcl.Forms,
Winapi.Windows,
uCEFApplication,
Main in 'Main.pas' {Form4};
{$R *.res}
{$SetPEFlags IMAGE_FILE_LARGE_ADDRESS_AWARE}
begin
CreateGlobalCEFApp;
if GlobalCEFApp.StartMainProcess then
begin
Application.Initialize;
Application.MainFormOnTaskbar := True;
Application.CreateForm(TForm4, Form4);
Application.Run;
end;
GlobalCEFApp.Free;
end.
Code: Select all
unit Main;
interface
uses
Winapi.Windows,
Winapi.Messages,
System.SysUtils,
System.Variants,
System.Classes,
Vcl.Graphics,
Vcl.Controls,
Vcl.Forms,
Vcl.Dialogs,
uCEFChromium,
uCEFTypes,
Vcl.ExtCtrls,
uCEFWindowParent,
uCEFInterfaces,
System.Generics.Collections,
Vcl.StdCtrls,
Vcl.ComCtrls,
uCEFChromiumCore,
uCEFWinControl;
const
MINIBROWSER_VISITDOM_PARTIAL = WM_APP + $101;
MINIBROWSER_VISITDOM_PARTIAL2 = WM_APP + $102;
RETRIEVEDOM_MSGNAME_PARTIAL = 'retrievedompartial';
RETRIEVEDOM_MSGNAME_PARTIAL2 = 'retrievedompartial2';
DOMVISITOR_MSGNAME_PARTIAL = 'domvisitorpartial';
DOMVISITOR_MSGNAME_PARTIAL2 = 'domvisitorpartial2';
CONSOLE_MSG_PREAMBLE = 'DOMVISITOR';
type
TForm4 = class(TForm)
Chromium1: TChromium;
CEFWindowParent: TCEFWindowParent;
Button1: TButton;
Timer1: TTimer;
Panel1: TPanel;
Timer2: TTimer;
StatusBar1: TStatusBar;
Timer3: TTimer;
procedure FormCreate(Sender: TObject);
function ScanMainPage: Boolean;
function ScanSecondaryPage: Boolean;
procedure VisitDOMMsg(var aMessage: TMessage); message MINIBROWSER_VISITDOM_PARTIAL;
procedure VisitDOMMsg2(var aMessage: TMessage); message MINIBROWSER_VISITDOM_PARTIAL2;
procedure Button1Click(Sender: TObject);
procedure Chromium1LoadEnd(Sender: TObject; const browser: ICefBrowser; const frame: ICefFrame;
httpStatusCode: Integer);
procedure Chromium1LoadingStateChange(Sender: TObject; const browser: ICefBrowser; isLoading,
canGoBack, canGoForward: Boolean);
procedure Chromium1ProcessMessageReceived(Sender: TObject; const browser: ICefBrowser;
sourceProcess: TCefProcessId; const message: ICefProcessMessage; out Result: Boolean);
procedure FormActivate(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure Timer2Timer(Sender: TObject);
procedure Timer3Timer(Sender: TObject);
private
{ Private declarations }
FMainPageLoaded: Boolean;
FSecondaryPageLoaded: Boolean;
public
{ Public declarations }
end;
ScanOutcome = (soNoScan, soScanSuccesful, soScanNOTSuccesful);
TMyStats = class
MyName: string;
Stats: string;
constructor Create(const aMyName, aStats: string); reintroduce;
end;
TInformationList = class
MyTime: string;
MyEvent: string;
Href: string;
MyStats: TObjectList<TMyStats>;
constructor Create(aMyTime, aMyEvent, aHref: string); reintroduce;
procedure AddMyStats(const aMyName, aStats: string);
end;
procedure CreateGlobalCEFApp;
var
Form4: TForm4;
MainPageScanned: ScanOutcome;
OpeningSecondaryPage: Boolean;
ScanSecondaryPageComplete: Boolean;
InformationList: TObjectList<TInformationList>;
I: Integer;
I2: Integer;
I3: Integer;
I4: Integer;
MyPosition: Integer;
implementation
uses
System.DateUtils,
uCEFDomVisitor,
uCEFProcessMessage,
uCEFApplication;
{$R *.dfm}
function MyNodeSearch(const aDocument: ICefDomDocument; const aFrame: ICefFrame; out S: string):
Boolean;
var
TempNode: ICefDomNode;
MyNode: ICefDomNode;
NextMyNode: ICefDomNode;
MyStatsNode: ICefDomNode;
Stat: string;
MyName: string;
HasStats: Boolean;
a: string;
begin
try
if (aDocument <> nil) and (aFrame <> nil) and (aFrame.IsValid) then
begin
TempNode := aDocument.Body;
TempNode := TempNode.FirstChild;
TempNode := TempNode.NextSibling;
TempNode := TempNode.NextSibling;
TempNode := TempNode.NextSibling;
TempNode := TempNode.NextSibling;
TempNode := TempNode.NextSibling;
TempNode := TempNode.NextSibling;
TempNode := TempNode.NextSibling;
TempNode := TempNode.NextSibling;
TempNode := TempNode.NextSibling;
TempNode := TempNode.NextSibling;
TempNode := TempNode.NextSibling;
TempNode := TempNode.NextSibling;
TempNode := TempNode.NextSibling;
TempNode := TempNode.NextSibling;
TempNode := TempNode.NextSibling;
TempNode := TempNode.NextSibling;
TempNode := TempNode.FirstChild;
if TempNode = nil then
Exit(false);
TempNode := TempNode.NextSibling;
TempNode := TempNode.FirstChild;
TempNode := TempNode.NextSibling;
TempNode := TempNode.FirstChild;
TempNode := TempNode.NextSibling;
TempNode := TempNode.FirstChild;
repeat
TempNode := TempNode.NextSibling;
a := TempNode.GetElementAttribute('class');
until Pos('xxxxxxxxxxxxxx', a) > 0;
TempNode := TempNode.FirstChild;
TempNode := TempNode.NextSibling;
NextMyNode := TempNode; // first horse
MyNode := NextMyNode;
while MyNode <> nil do
begin
Stat := '';
MyNode := MyNode.FirstChild;
MyNode := MyNode.NextSibling;
if Pos('xxxxxxxxxxxcdbf', MyNode.AsMarkup) > 0 then
begin
HasStats := True
end
else
begin
HasStats := False;
end;
MyNode := MyNode.FirstChild;
MyNode := MyNode.NextSibling;
MyNode := MyNode.NextSibling;
MyNode := MyNode.NextSibling;
if HasStats = True then
begin
MyStatsNode := MyNode;
MyStatsNode := MyStatsNode.NextSibling;
MyStatsNode := MyStatsNode.NextSibling;
MyStatsNode := MyStatsNode.FirstChild;
MyStatsNode := MyStatsNode.NextSibling;
MyStatsNode := MyStatsNode.FirstChild;
MyStatsNode := MyStatsNode.NextSibling;
MyStatsNode := MyStatsNode.NextSibling;
MyStatsNode := MyStatsNode.NextSibling;
MyStatsNode := MyStatsNode.NextSibling;
MyStatsNode := MyStatsNode.NextSibling;
MyStatsNode := MyStatsNode.NextSibling;
MyStatsNode := MyStatsNode.NextSibling;
MyStatsNode := MyStatsNode.FirstChild;
MyStatsNode := MyStatsNode.NextSibling;
MyStatsNode := MyStatsNode.FirstChild;
MyStatsNode := MyStatsNode.NextSibling;
Stat := MyStatsNode.AsMarkup;
Stat := UpperCase(Stat);
end
else
begin
MyStatsNode := nil;
end;
MyNode := MyNode.FirstChild;
MyNode := MyNode.NextSibling;
MyNode := MyNode.NextSibling;
MyNode := MyNode.NextSibling;
MyNode := MyNode.NextSibling;
MyNode := MyNode.NextSibling;
MyNode := MyNode.FirstChild;
MyNode := MyNode.NextSibling;
MyNode := MyNode.NextSibling;
MyNode := MyNode.NextSibling;
MyNode := MyNode.FirstChild;
MyName := MyNode.GetValue;
MyName := Trim(MyName);
InformationList[MyPosition].AddMyStats(MyName, Stat);
if HasStats = True then
begin
MyNode := MyNode;
end;
NextMyNode := NextMyNode.NextSibling;
NextMyNode := NextMyNode.NextSibling;
MyNode := NextMyNode;
if Pos('xxxxxxxxxx=', MyNode.AsMarkup) = 0 then
begin
MyNode := nil;
ScanSecondaryPageComplete := true;
InformationList.TrimExcess;
end;
end;
Result := True;
end
else
begin
Result := False;
end;
except
Result := False;
end;
end;
function SimpleNodeSearch(const aDocument: ICefDomDocument; const aFrame: ICefFrame; out S: string):
Boolean;
var
TempNode: ICefDomNode;
MyNode: ICefDomNode;
Value: string;
Href: string;
MyTime: string;
MyEvent: string;
begin
S := '';
MainPageScanned := soNoScan;
OpeningSecondaryPage := False;
try
if (aDocument <> nil) and (aFrame <> nil) and (aFrame.IsValid) then
begin
TempNode := aDocument.Body;
TempNode := TempNode.FirstChild;
TempNode := TempNode.NextSibling;
Value := TempNode.AsMarkup;
TempNode := TempNode.NextSibling;
Value := TempNode.AsMarkup;
TempNode := TempNode.NextSibling;
Value := TempNode.AsMarkup;
TempNode := TempNode.NextSibling;
Value := TempNode.AsMarkup;
TempNode := TempNode.NextSibling;
Value := TempNode.AsMarkup;
TempNode := TempNode.NextSibling;
Value := TempNode.AsMarkup;
TempNode := TempNode.NextSibling;
Value := TempNode.AsMarkup;
TempNode := TempNode.NextSibling;
Value := TempNode.AsMarkup;
TempNode := TempNode.NextSibling;
Value := TempNode.AsMarkup;
TempNode := TempNode.NextSibling;
Value := TempNode.AsMarkup;
TempNode := TempNode.NextSibling;
Value := TempNode.AsMarkup;
TempNode := TempNode.NextSibling;
Value := TempNode.AsMarkup;
TempNode := TempNode.NextSibling;
Value := TempNode.AsMarkup;
TempNode := TempNode.NextSibling;
Value := TempNode.AsMarkup;
TempNode := TempNode.NextSibling;
Value := TempNode.AsMarkup;
TempNode := TempNode.NextSibling;
Value := TempNode.AsMarkup;
TempNode := TempNode.NextSibling;
TempNode := TempNode.FirstChild;
if TempNode = nil then
begin
MainPageScanned := soScanNOTSuccesful;
Exit(false);
end;
TempNode := TempNode.NextSibling;
if TempNode <> nil then
Value := TempNode.AsMarkup;
TempNode := TempNode.FirstChild;
Value := TempNode.AsMarkup;
TempNode := TempNode.NextSibling;
Value := TempNode.AsMarkup;
TempNode := TempNode.FirstChild;
Value := TempNode.AsMarkup;
TempNode := TempNode.NextSibling;
Value := TempNode.AsMarkup;
TempNode := TempNode.FirstChild;
Value := TempNode.AsMarkup;
TempNode := TempNode.NextSibling;
Value := TempNode.AsMarkup;
TempNode := TempNode.NextSibling;
Value := TempNode.AsMarkup;
TempNode := TempNode.NextSibling;
Value := TempNode.AsMarkup;
TempNode := TempNode.NextSibling;
Value := TempNode.AsMarkup;
TempNode := TempNode.NextSibling;
Value := TempNode.AsMarkup;
TempNode := TempNode.NextSibling;
Value := TempNode.AsMarkup;
TempNode := TempNode.NextSibling;
Value := TempNode.AsMarkup;
TempNode := TempNode.NextSibling;
Value := TempNode.AsMarkup;
TempNode := TempNode.NextSibling;
Value := TempNode.AsMarkup;
TempNode := TempNode.FirstChild;
Value := TempNode.AsMarkup;
MyNode := TempNode.NextSibling; // first element header
while MyNode <> nil do
begin
TempNode := MyNode.FirstChild;
TempNode := TempNode.NextSibling;
MyTime := TempNode.GetElementAttribute('time');
MyEvent := TempNode.GetElementAttribute('data-MyEvent');
Href := TempNode.GetElementAttribute('href');
InformationList.Add(TInformationList.Create(MyTime, MyEvent, Href));
MyNode := MyNode.NextSibling;
MyNode := MyNode.NextSibling;
end;
Result := True;
MainPageScanned := soScanSuccesful;
end
else
begin
Result := False;
end;
except
MainPageScanned := soScanNOTSuccesful;
Result := False;
end;
end;
procedure DOMVisitor_OnDocAvailable(const browser: ICefBrowser; const frame: ICefFrame; const
document: ICefDomDocument);
var
TempMessage: ICefProcessMessage;
S: string;
begin
// Simple DOM searches
SimpleNodeSearch(document, frame, S);
// Sending back some custom results to the browser process
// Notice that the DOMVISITOR_MSGNAME_PARTIAL message name needs to be recognized in
// Chromium1ProcessMessageReceived
try
TempMessage := TCefProcessMessageRef.New(DOMVISITOR_MSGNAME_PARTIAL);
TempMessage.ArgumentList.SetString(0, 'string found: ' + S);
if (frame <> nil) and frame.IsValid then
frame.SendProcessMessage(PID_BROWSER, TempMessage);
finally
TempMessage := nil;
end;
end;
procedure DOMVisitor_OnDocAvailable2(const browser: ICefBrowser; const frame: ICefFrame; const
document: ICefDomDocument);
var
TempMessage: ICefProcessMessage;
S: string;
// Found: Boolean;
begin
// Race DOM searches
MyNodeSearch(document, frame, S);
// Sending back some custom results to the browser process
// Notice that the DOMVISITOR_MSGNAME_PARTIAL message name needs to be recognized in
// Chromium1ProcessMessageReceived
try
TempMessage := TCefProcessMessageRef.New(DOMVISITOR_MSGNAME_PARTIAL);
TempMessage.ArgumentList.SetString(0, 'string found: ' + S);
if (frame <> nil) and frame.IsValid then
frame.SendProcessMessage(PID_BROWSER, TempMessage);
finally
TempMessage := nil;
end;
end;
procedure TForm4.Chromium1ProcessMessageReceived(Sender: TObject; const browser: ICefBrowser;
sourceProcess: TCefProcessId; const message: ICefProcessMessage; out Result: Boolean);
begin
Result := False;
if (message = nil) or (message.ArgumentList = nil) then
exit;
// Message received from the DOMVISITOR in CEF
if (message.Name = DOMVISITOR_MSGNAME_PARTIAL) then
begin
Result := True;
end
else if (message.Name = DOMVISITOR_MSGNAME_PARTIAL2) then
begin
ScanSecondaryPageComplete := True;
end;
Result := True;
end;
procedure GlobalCEFApp_OnProcessMessageReceived(const browser: ICefBrowser; const frame: ICefFrame;
sourceProcess: TCefProcessId; const message: ICefProcessMessage; var aHandled: boolean);
var
TempVisitor: TCefFastDomVisitor2;
begin
aHandled := False;
if (browser <> nil) then
begin
if (message.name = RETRIEVEDOM_MSGNAME_PARTIAL) then
begin
if (frame <> nil) and frame.IsValid then
begin
TempVisitor := TCefFastDomVisitor2.Create(browser, frame, DOMVisitor_OnDocAvailable);
frame.VisitDom(TempVisitor);
end;
aHandled := True;
end;
if (message.name = RETRIEVEDOM_MSGNAME_PARTIAL2) then
begin
if (frame <> nil) and frame.IsValid then
begin
TempVisitor := TCefFastDomVisitor2.Create(browser, frame, DOMVisitor_OnDocAvailable2);
frame.VisitDom(TempVisitor);
end;
aHandled := True;
end;
end;
end;
procedure CreateGlobalCEFApp;
var
a: string;
begin
GlobalCEFApp := TCefApplication.Create;
GlobalCEFApp.OnProcessMessageReceived := GlobalCEFApp_OnProcessMessageReceived;
GlobalCEFApp.FrameworkDirPath := 'E:\Delphi\CEF4Delphi\bin\';
GlobalCEFApp.ResourcesDirPath := 'E:\Delphi\CEF4Delphi\bin\';
GlobalCEFApp.LocalesDirPath := 'E:\Delphi\CEF4Delphi\bin\locales\';
// GlobalCEFApp.DisableJavascript := True;
// Enabling the debug log file for then DOM visitor demo.
// This adds lots of warnings to the console, specially if you run this inside VirtualBox.
// Remove it if you don't want to use the DOM visitor
// a:=ExtractFilePath(ParamStr(0));
a := ExtractFilePath(ParamStr(0)) + 'debug.log';
DeleteFile(a);
// Using the "Single process" mode is one of the ways to debug all the code
// because everything is executed in the browser process and Delphi won't have
// any problems. However, The "Single process" mode is unsupported by CEF and
// it causes unexpected issues. You should *ONLY* use it for debugging
// purposses.
{$IFDEF DEBUG}
GlobalCEFApp.SingleProcess := True; // this generates memory leaks
{$ENDIF}
end;
procedure TForm4.FormCreate(Sender: TObject);
begin
InformationList := TObjectList<TInformationList>.Create;
end;
procedure TForm4.Button1Click(Sender: TObject);
var
I: Integer;
Url: string;
begin
repeat
MainPageScanned := soNoScan;
FMainPageLoaded := False;
Chromium1.CleanupInstance;
Chromium1.LoadURL('https://www.xxxxxxxxxxxxx');
InformationList.Clear;
while True do
begin
if FMainPageLoaded = True then
begin
Break;
end;
Application.ProcessMessages;
end;
while True do // this becomes an infinite loop if I set GlobalCEFApp.SingleProcess := False;
begin
if MainPageScanned <> soNoScan then
begin
Break;
end;
Application.ProcessMessages;
end;
until MainPageScanned = soScanSuccesful;
for I := 0 to InformationList.Count - 1 do
begin
repeat
MyPosition := I;
FSecondaryPageLoaded := False;
ScanSecondaryPageComplete := False;
Url := InformationList[I].Href;
Chromium1.LoadURL('https://www.xxxxxxxxxxxxx/' + Url);
while True do
begin
if FSecondaryPageLoaded = True then
begin
Break;
end;
Application.ProcessMessages;
end;
while True do
begin
if ScanSecondaryPageComplete = True then
begin
Break;
end;
Application.ProcessMessages;
end;
until ScanSecondaryPageComplete = True;
end;
for I := 0 to InformationList.Count - 1 do
begin
end;
end;
procedure TForm4.Chromium1LoadEnd(Sender: TObject; const browser: ICefBrowser; const frame:
ICefFrame; httpStatusCode: Integer);
begin
if (frame.IsMain) then
begin
if browser.MainFrame.Url <> 'about:blank' then
begin
if FMainPageLoaded = False then
begin
FMainPageLoaded := True;
end
else
begin
FSecondaryPageLoaded := True;
end;
end;
end;
if Button1.Visible = True then
begin
StatusBar1.Panels[0].Text := 'Scan main page';
end;
end;
procedure TForm4.Chromium1LoadingStateChange(Sender: TObject; const browser: ICefBrowser; isLoading,
canGoBack, canGoForward: Boolean);
begin
if isLoading = False then
begin
if Chromium1.VisibleNavigationEntry.Url <> 'about:blank' then
begin
if MainPageScanned <> soScanSuccesful then
begin
Chromium1.StopLoad;
Self.ScanMainPage;
end
else
begin
if FSecondaryPageLoaded = True then
begin
Self.ScanSecondaryPage;
end
else
begin
// Self.ScanSecondaryPage;
end;
end;
end;
end;
end;
procedure TForm4.FormActivate(Sender: TObject);
begin
Self.WindowState := wsMaximized;
end;
function TForm4.ScanMainPage: Boolean;
var
TimeCheckSec: Integer;
Time_End: TdateTime;
res: Boolean;
begin
TimeCheckSec := 5;
Time_End := IncMilliSecond(now, round(TimeCheckSec * 1000));
while True do
begin
Sleep(50);
Application.ProcessMessages;
if Now > Time_End then
Break;
res := Chromium1.IsLoading;
if res = True then
Break;
end;
PostMessage(Handle, MINIBROWSER_VISITDOM_PARTIAL, 0, 0);
Result := True;
end;
function TForm4.ScanSecondaryPage: Boolean;
begin
OpeningSecondaryPage := False;
Timer3.Enabled := True;
while True do
begin
if OpeningSecondaryPage = True then
begin
Break;
end;
Application.ProcessMessages;
end;
Timer3.Enabled := False;
PostMessage(Handle, MINIBROWSER_VISITDOM_PARTIAL2, 0, 0);
Result := True;
end;
procedure TForm4.Timer1Timer(Sender: TObject);
begin
Timer1.Enabled := False;
if not (Chromium1.CreateBrowser(CEFWindowParent)) and not (Chromium1.Initialized) then
begin
Timer1.Enabled := True;
end
else
begin
Timer2.Enabled := True;
end;
end;
procedure TForm4.Timer2Timer(Sender: TObject);
begin
Button1.Visible := True;
end;
procedure TForm4.Timer3Timer(Sender: TObject);
begin
OpeningSecondaryPage := True;
end;
procedure TForm4.VisitDOMMsg(var aMessage: TMessage);
var
TempMsg: ICefProcessMessage;
begin
// Use the ArgumentList property if you need to pass some parameters.
TempMsg := TCefProcessMessageRef.New(RETRIEVEDOM_MSGNAME_PARTIAL);
// Same name than TCefCustomRenderProcessHandler.MessageName
Chromium1.SendProcessMessage(PID_RENDERER, TempMsg);
end;
procedure TForm4.VisitDOMMsg2(var aMessage: TMessage);
var
TempMsg: ICefProcessMessage;
begin
// Use the ArgumentList property if you need to pass some parameters.
TempMsg := TCefProcessMessageRef.New(RETRIEVEDOM_MSGNAME_PARTIAL2);
// Same name than TCefCustomRenderProcessHandler.MessageName
Chromium1.SendProcessMessage(PID_RENDERER, TempMsg);
end;
{ TInformationList }
procedure TInformationList.AddMyStats(const aMyName, aStats: string);
begin
MyStats.Add(TMyStats.Create(aMyName, aStats));
end;
constructor TInformationList.Create(aMyTime, aMyEvent, aHref: string);
begin
MyTime := aMyTime;
MyEvent := aMyEvent;
Href := aHref;
MyStats := TObjectList<TMyStats>.Create;
end;
{ TMyStats }
constructor TMyStats.Create(const aMyName, aStats: string);
begin
MyName := aMyName;
Stats := aStats;
end;
end.
Many thanks
Alberto