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.