Occasional access violation error

[PioPio]

Hello,

I am developing a new project that scans a web page. The program works most of the time but I have occasional access violation errors.
When this happens I can run the program again and I may get the same error again or the program executes and progress normally without any error.

I looked at the web page and I cannot see the page changing.
What am I missing out?

The following is the source

Code: Select all

program MyProgram;

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,
  Vcl.ExtCtrls,
  uCEFWindowParent,
  uCEFInterfaces,
  Vcl.StdCtrls,
  Vcl.ComCtrls;

const
  MINIBROWSER_VISITDOM_PARTIAL = WM_APP + $101;
  RETRIEVEDOM_MSGNAME_PARTIAL = 'retrievedompartial';
  DOMVISITOR_MSGNAME_PARTIAL = 'domvisitorpartial';
  CONSOLE_MSG_PREAMBLE = 'DOMVISITOR';

type
  TForm4 = class(TForm)
    Chromium1: TChromium;
    CEFWindowParent: TCEFWindowParent;
    Button1: TButton;
    Timer1: TTimer;
    Panel1: TPanel;
    Timer2: TTimer;
    StatusBar1: TStatusBar;
    function ScanMainPage: Boolean;
    procedure VisitDOMMsg(var aMessage: TMessage); message MINIBROWSER_VISITDOM_PARTIAL;
    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 FormActivate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Timer2Timer(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

procedure CreateGlobalCEFApp;

var
  Form4: TForm4;

implementation

uses
  uCEFTypes,
  uCEFDomVisitor,
  uCEFProcessMessage,
  uCEFApplication;

{$R *.dfm}

function SimpleNodeSearch(const aDocument: ICefDomDocument; const aFrame: ICefFrame): string;
var
  TempNode: ICefDomNode;
  TempJSCode, TempMessage: string;
  Value: string;
begin
  try
    if (aDocument <> nil) 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;
      Value := TempNode.AsMarkup;
      TempNode := TempNode.FirstChild;
      Value := TempNode.AsMarkup; //Sometimes this line throws an access violation error
      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.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;
      TempNode := TempNode.NextSibling;
      Value := TempNode.AsMarkup;
    end;
  finally

  end;

//
end;

procedure DOMVisitor_OnDocAvailable(const browser: ICefBrowser; const frame: ICefFrame; const
  document: ICefDomDocument);
var
  TempMessage: ICefProcessMessage;
  S: string;
begin
  // Simple DOM searches
  S := SimpleNodeSearch(document, frame);

  // 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 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;
  end;
end;

procedure CreateGlobalCEFApp;
var
  a: string;
  res: Boolean;
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';
  res := 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.Button1Click(Sender: TObject);
begin
  Chromium1.LoadURL('https://www.xxxxxxxxxxxxx');
end;

procedure TForm4.Chromium1LoadEnd(Sender: TObject; const browser: ICefBrowser; const frame:
  ICefFrame; httpStatusCode: Integer);
begin
  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);
var
  a: string;
begin
  if isLoading then
  begin
  end
  else
  begin
    if Chromium1.VisibleNavigationEntry.Url <> 'about:blank' then
    begin
      Self.ScanMainPage;
    end;
  end;
end;

procedure TForm4.FormActivate(Sender: TObject);
begin
  Self.WindowState := wsMaximized;
end;

function TForm4.ScanMainPage: Boolean;
begin
  PostMessage(Handle, MINIBROWSER_VISITDOM_PARTIAL, 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.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;

end.

[salvadordf]

Hi,

I would check several things in SimpleNodeSearch.

• Replace "if (aDocument <> nil) then" with "if (aDocument <> nil) and (aFrame <> nil) and aFrame.IsValid then"
• Check that FirstChild and NextSibling return a valid node pointer. Add "if TempNode <> nil then" after each of those calls because the page could be incomplete or totally different.

[PioPio]

Hi,

I would check several things in SimpleNodeSearch.
[*]Replace "if (aDocument <> nil) then" with "if (aDocument <> nil) and (aFrame <> nil) and aFrame.IsValid then"

This did not improve but I kept it anyway.

....because the page could be incomplete or totally different.

This is probably what happens.
How can I wait until the page is complete? if I add a Sleep(5000) it will not solve the issue as the program does not progress and the page does not complete in the meantime

[salvadordf]

The isLoading parameter in the TChromiumCore.OnLoadingStateChange event is the recommended way to know when the web page finished loading but this may never happen or it may happen several times depending on the web page and the network conditions.

Alternatively, you can also use other events as imperfect workarounds :

• Use the TChromiumCore.OnLoadEnd event and check is frame.IsMain to know when the main frame finished loading.
• Count the TChromiumCore.OnBeforeResourceLoad events and check how many TChromiumCore.OnResourceLoadComplete are triggered. You could set an arbitrary percentage of finished resources to consider that page as loaded.

[PioPio]

The isLoading parameter in the TChromiumCore.OnLoadingStateChange event is the recommended way to know when the web page finished loading but this may never happen or it may happen several times depending on the web page and the network conditions.

Alternatively, you can also use other events as imperfect workarounds :

• Use the TChromiumCore.OnLoadEnd event and check is frame.IsMain to know when the main frame finished loading.
• Count the TChromiumCore.OnBeforeResourceLoad events and check how many TChromiumCore.OnResourceLoadComplete are triggered. You could set an arbitrary percentage of finished resources to consider that page as loaded.

Hi Salvador,

I tried all of the above but the result is still the same. Sometimes it works, sometimes it doesn't.
Any more suggestions?

[salvadordf]

It's not easy to give a universal solution to this problem because some web pages add content dynamically and the network status can affect the loading of some images, scripts, etc.

I would suggest that you save the HTML before trying to search for nodes. That way you'll know what was different when it fails.

[zaqaz]

problem with js scipts, which can work on background

im use fucntion to check load is end

Code: Select all

Function Object_WebBrowser_Base01.Page_IsLoading_5Sec():boolean;
var
      Time_End     : TDateTime;
      TimeCheckSec : integer;
begin
  result        := false;
  TimeCheckSec  := 5;
  Time_End      := IncMilliSecond( now, round(TimeCheckSec * 1000));


  while true do
  begin
    sleep(50);
    application.processmessages;
    if now > Time_End then
       break;

    result := BrowserCrm.IsLoading;
    if result then
       break;
  end;

end;

//*******************************************************************************

Function Object_WebBrowser_Base01.Page_WaitLoad():boolean;
var
      Time_End     : TDateTime;
      StopPageLoad : boolean;
begin

    result        := true;
    StopPageLoad  := false;

//    f010_pause(5);

    Time_End     := IncMilliSecond( now, round(const_Timeout_PageLoad * 1000));


    while true do
    begin
        sleep(50);
        Application.ProcessMessages;

        if now > Time_End then
        begin
           StopPageLoad := true;
           break;
        end;


        if not(fPage_IsLoading_5Sec) then
           break;

    end;

    if StopPageLoad then
    begin
       Page_StopLoad;
    end;



end;

i know it not good code, but
it just works.

[PioPio]

problem with js scipts, which can work on background

im use fucntion to check load is end

Code: Select all

Function Object_WebBrowser_Base01.Page_IsLoading_5Sec():boolean;
var
      Time_End     : TDateTime;
      TimeCheckSec : integer;
begin
  result        := false;
  TimeCheckSec  := 5;
  Time_End      := IncMilliSecond( now, round(TimeCheckSec * 1000));


  while true do
  begin
    sleep(50);
    application.processmessages;
    if now > Time_End then
       break;

    result := BrowserCrm.IsLoading;
    if result then
       break;
  end;

end;

//*******************************************************************************

Function Object_WebBrowser_Base01.Page_WaitLoad():boolean;
var
      Time_End     : TDateTime;
      StopPageLoad : boolean;
begin

    result        := true;
    StopPageLoad  := false;

//    f010_pause(5);

    Time_End     := IncMilliSecond( now, round(const_Timeout_PageLoad * 1000));


    while true do
    begin
        sleep(50);
        Application.ProcessMessages;

        if now > Time_End then
        begin
           StopPageLoad := true;
           break;
        end;


        if not(fPage_IsLoading_5Sec) then
           break;

    end;

    if StopPageLoad then
    begin
       Page_StopLoad;
    end;



end;

i know it not good code, but
it just works.

Hi Zaz,

I am not sure how I should use both functions. Do I have to check if the browser is loading via Page_IsLoading_5Sec and if it is then I have to stop the browser via Page_WaitLoad?

[zaqaz]

use Page_WaitLoad

Page_IsLoading_5Sec - get true if on 5sec was event isLoading - so you must wait more (realized on Page_WaitLoad)
if Page_IsLoading_5Sec = false - you can work (on last 5sec browser do nothing)

it just works ))

1. it just works on pages with many scripts which run XMLHttpRequest's after documentcomplete
2. Page_WaitLoad - stop browser only if timeout, make your personal function for it.