setting GlobalCEFApp.SingleProcess to false

[PioPio]

Hello,

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;

Here is the full source:

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.

Where am I doing wrong ?

Many thanks
Alberto

[salvadordf]

Hi,

Chromium uses multiple processes to render web pages and the DOM visitors are executed in one of the Chromium processes called "render" which is different than the main application process.

Windows don't allow one process to access variables from a different process. For that reason the DOMVisitor demo sends the visitor result to the main application process sending a message :
https://github.com/salvadordf/CEF4Delphi/blob/74f5ea02c859544054ea290b28856ec94d438be3/demos/Delphi_VCL/DOMVisitor/uDOMVisitor.pas#L361

Read the code comments in the DOMVisitor demo for all the details and send a message with the visitor results.

It's not recommended to use "Application.ProcessMessages". Replace that while loop with a simple timer.

[PioPio]

Thanks, Salvador,
I understand the use of messages because some of the process is outside the application's main thread.

When you say

Replace that while loop with a simple timer

do you mean to simply replace the loop with a Sleep(x) or to use the component TTimer?

[zaqaz]

strange

can you send full project in archive?

why you dont use my code to check loadingend?
it is not work?

[zaqaz]

Where am I doing wrong ?

imho

DOMVisitor_OnDocAvailable runs before all scecondry scripts loaded and runned.

[salvadordf]

In order to keep the app responsiveness it's recommended to avoid calling "sleep" and removing infinite loops that call Application.ProcessMessages.

Chromium sometimes doesn't react well when the host application is sleep and unresponsive.

I would recommend that you do something like this :

• Disable the user interface controls that give problems if the user clicks some button twice to search something in the DOM.
• Enable a timout timer.
• Send a process message to start the DOM search.
• Search the DOM.
• Send a process message to send the result to the main process.
• Disable the timout timer.
• Enable the user interface.

The timeout timer could be used to detect if the DOM search failed. You could also use the timer to check is all the results have arrived and to show some progress bar if necessary.

[PioPio]

strange

can you send full project in archive?

why you dont use my code to check loadingend?
it is not work?

Hi zaqaz,

I used your code but I have the same issue, sometimes it works but sometimes it doesn't, at least not for me.

[PioPio]

In order to keep the app responsiveness it's recommended to avoid calling "sleep" and removing infinite loops that call Application.ProcessMessages.

Chromium sometimes doesn't react well when the host application is sleep and unresponsive.

I would recommend that you do something like this :

• Disable the user interface controls that give problems if the user clicks some button twice to search something in the DOM.
• Enable a timout timer.
• Send a process message to start the DOM search.
• Search the DOM.
• Send a process message to send the result to the main process.
• Disable the timout timer.
• Enable the user interface.

The timeout timer could be used to detect if the DOM search failed. You could also use the timer to check is all the results have arrived and to show some progress bar if necessary.

Hi Salvador,

I have got rid of all Application.ProcessMessages and implemented the timer.
I have followed your instructions but GlobalCEFApp_OnProcessMessageReceived is not fired when I process the message to start the DOM search.
This one below is the source I have at the moment

Code: Select all

procedure CreateGlobalCEFApp;
var
  a: string;
begin
  GlobalCEFApp := TCefApplication.Create;
  GlobalCEFApp.OnProcessMessageReceived := GlobalCEFApp_OnProcessMessageReceived; // this sets GlobalCEFApp_OnProcessMessageReceived as receiver for all messages

  GlobalCEFApp.FrameworkDirPath := 'E:\Delphi\CEF4Delphi\bin\';
  GlobalCEFApp.ResourcesDirPath := 'E:\Delphi\CEF4Delphi\bin\';
  GlobalCEFApp.LocalesDirPath := 'E:\Delphi\CEF4Delphi\bin\locales\';

  GlobalCEFApp.DisableJavascript := True;

  a := ExtractFilePath(ParamStr(0)) + 'debug.log';
  DeleteFile(a);
end;

procedure TForm4.Timer4Timer(Sender: TObject);
begin
  case FStage of
    0:
      begin
      end;
    1:
      begin
        if FMainPageLoaded = True then
        begin
          Inc(FStage);
          PostMessage(Handle, MINIBROWSER_VISITDOM_PARTIAL, 0, 0);// this line is executed correctly
        end;
      end;
    2:
      begin
        if MainPageScanned = soScanSuccesful then
        begin
          Inc(FStage);
        end;
      end;
  end;
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); // this line is executed correctly
end;

procedure GlobalCEFApp_OnProcessMessageReceived(const browser: ICefBrowser; const frame: ICefFrame;
  sourceProcess: TCefProcessId; const message: ICefProcessMessage; var aHandled: boolean);
var
  TempVisitor: TCefFastDomVisitor2;
begin
  ShowMessage('GlobalCEFApp_OnProcessMessageReceived triggered');// THIS IS NOT TRIGGERED
  aHandled := False;
  if (browser <> nil) then
  begin
    ...........
  end;
end;

There must be something obvious but I cannot find what it is wrong with it.
Can you please point out in the right direction?

Many thanks
Alberto

[zaqaz]

full project please in archive.

[zaqaz]

1 advice

buy codesitelogging and make on all procedures strart / end messages

So you allways can see what run/finished, where cycle on endleess loop etc

There must be something obvious but I cannot find what it is wrong with it.
Can you please point out in the right direction?