pascal/CEF4Delphi
1
0
Fork 0
mirror of https://github.com/salvadordf/CEF4Delphi.git synced 2025-07-02 22:26:53 +02:00
Code Issues Actions Releases Activity

Added a "Show DevTools" context menu option to the DOMVisitor demo

Browse Source 
- Updated the DOMVisitor demo for Lazarus.
- Replaced some local variable types from string to ustring to fix some issues in Delpi XE2.
This commit is contained in:
Salvador Díaz Fau
2020-08-22 12:29:11 +02:00
parent 3c1dae426c
commit e36cd5e8c7
7 changed files with 707 additions and 121 deletions
Download Patch File Download Diff File Expand all files Collapse all files

634
demos/Lazarus/DOMVisitor/uDOMVisitor.pas
View File

@ -44,27 +44,42 @@ unit uDOMVisitor;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Menus,
Windows, Messages, SysUtils, Variants, Classes, Graphics, Menus, SyncObjs,
Controls, Forms, Dialogs, StdCtrls, ExtCtrls, Types, ComCtrls, ClipBrd,
uCEFChromium, uCEFWindowParent, uCEFInterfaces, uCEFApplication, uCEFTypes, uCEFConstants,
uCEFWinControl, uCEFSentinel;
uCEFChromium, uCEFWindowParent, uCEFInterfaces, uCEFApplication, uCEFTypes,
uCEFConstants, uCEFWinControl, uCEFChromiumCore, uCEFChromiumEvents;
const
MINIBROWSER_VISITDOM_PARTIAL = WM_APP + $101;
MINIBROWSER_VISITDOM_FULL = WM_APP + $102;
MINIBROWSER_COPYFRAMEIDS_1 = WM_APP + $103;
MINIBROWSER_COPYFRAMEIDS_2 = WM_APP + $104;
MINIBROWSER_SHOWMESSAGE = WM_APP + $105;
MINIBROWSER_SHOWSTATUSTEXT = WM_APP + $106;
MINIBROWSER_VISITDOM_JS = WM_APP + $107;
MINIBROWSER_SHOWERROR = WM_APP + $108;
MINIBROWSER_CONTEXTMENU_VISITDOM_PARTIAL = MENU_ID_USER_FIRST + 1;
MINIBROWSER_CONTEXTMENU_VISITDOM_FULL = MENU_ID_USER_FIRST + 2;
MINIBROWSER_CONTEXTMENU_COPYFRAMEIDS_1 = MENU_ID_USER_FIRST + 3;
MINIBROWSER_CONTEXTMENU_COPYFRAMEIDS_2 = MENU_ID_USER_FIRST + 4;
MINIBROWSER_CONTEXTMENU_VISITDOM_JS = MENU_ID_USER_FIRST + 5;
MINIBROWSER_CONTEXTMENU_SETINPUTVALUE_JS = MENU_ID_USER_FIRST + 6;
MINIBROWSER_CONTEXTMENU_SETINPUTVALUE_DT = MENU_ID_USER_FIRST + 7;
MINIBROWSER_CONTEXTMENU_SHOWDEVTOOLS = MENU_ID_USER_FIRST + 8;
DOMVISITOR_MSGNAME_PARTIAL = 'domvisitorpartial';
DOMVISITOR_MSGNAME_FULL = 'domvisitorfull';
RETRIEVEDOM_MSGNAME_PARTIAL = 'retrievedompartial';
RETRIEVEDOM_MSGNAME_FULL = 'retrievedomfull';
FRAMEIDS_MSGNAME = 'getframeids';
CONSOLE_MSG_PREAMBLE = 'DOMVISITOR';
type
NODE_ID = 'keywords';
type
TDTVisitStatus = (dvsIdle, dvsGettingDocNodeID, dvsQueryingSelector, dvsSettingAttributeValue);
{ TDOMVisitorFrm }
TDOMVisitorFrm = class(TForm)
CEFWindowParent1: TCEFWindowParent;
Chromium1: TChromium;
@ -75,54 +90,72 @@ type
Panel1: TPanel;
GoBtn: TButton;
VisitDOMBtn: TButton;
procedure CEFSentinel1Close(Sender: TObject);
procedure GoBtnClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure Chromium1AfterCreated(Sender: TObject;
const browser: ICefBrowser);
procedure Chromium1BeforeContextMenu(Sender: TObject;
const browser: ICefBrowser; const frame: ICefFrame;
const params: ICefContextMenuParams; const model: ICefMenuModel);
procedure Chromium1ContextMenuCommand(Sender: TObject;
const browser: ICefBrowser; const frame: ICefFrame;
const params: ICefContextMenuParams; commandId: Integer;
eventFlags: Cardinal; out Result: Boolean);
procedure Chromium1ProcessMessageReceived(Sender: TObject;
const browser: ICefBrowser; const frame: ICefFrame; sourceProcess: TCefProcessId;
const message: ICefProcessMessage; out Result: Boolean);
procedure Timer1Timer(Sender: TObject);
procedure VisitDOMBtnClick(Sender: TObject);
procedure Chromium1BeforePopup(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: Boolean; var Result: Boolean);
procedure FormShow(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure Chromium1Close(Sender: TObject; const browser: ICefBrowser;
var aAction : TCefCloseBrowserAction);
procedure Chromium1BeforeClose(Sender: TObject;
const browser: ICefBrowser);
private
{ Private declarations }
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure FormDestroy(Sender: TObject);
procedure Chromium1AfterCreated(Sender: TObject; const browser: ICefBrowser);
procedure Chromium1BeforeContextMenu(Sender: TObject; const browser: ICefBrowser; const frame: ICefFrame; const params: ICefContextMenuParams; const model: ICefMenuModel);
procedure Chromium1ContextMenuCommand(Sender: TObject; const browser: ICefBrowser; const frame: ICefFrame; const params: ICefContextMenuParams; commandId: Integer; eventFlags: Cardinal; out Result: Boolean);
procedure Chromium1ProcessMessageReceived(Sender: TObject; const browser: ICefBrowser; const frame: ICefFrame; sourceProcess: TCefProcessId; const message: ICefProcessMessage; out Result: Boolean);
procedure Chromium1BeforePopup(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: Boolean; var Result: Boolean);
procedure Chromium1Close(Sender: TObject; const browser: ICefBrowser; var aAction : TCefCloseBrowserAction);
procedure Chromium1BeforeClose(Sender: TObject; const browser: ICefBrowser);
procedure Chromium1ConsoleMessage(Sender: TObject; const browser: ICefBrowser; level: TCefLogSeverity; const message, source: ustring; line: Integer; out Result: Boolean);
procedure Chromium1DevToolsMethodResult(Sender: TObject; const browser: ICefBrowser; message_id: integer; success: boolean; const result: ICefValue);
protected
// Variables to control when can we destroy the form safely
FCanClose : boolean; // Set to True in TChromium.OnBeforeClose
FClosing : boolean; // Set to True in the CloseQuery event.
// Critical section and fields to show information received in CEF events safely.
FCritSection : TCriticalSection;
FMsgContents : string;
FStatusText : string;
FStatus : TDTVisitStatus;
FErrorText : string;
function GetMsgContents : string;
function GetStatusText : string;
function GetErrorText : string;
procedure SetMsgContents(const aValue : string);
procedure SetStatusText(const aValue : string);
procedure SetErrorText(const aValue : string);
procedure BrowserCreatedMsg(var aMessage : TMessage); message CEF_AFTERCREATED;
procedure BrowserDestroyMsg(var aMessage : TMessage); message CEF_DESTROY;
procedure VisitDOMMsg(var aMessage : TMessage); message MINIBROWSER_VISITDOM_PARTIAL;
procedure VisitDOM2Msg(var aMessage : TMessage); message MINIBROWSER_VISITDOM_FULL;
procedure VisitDOM3Msg(var aMessage : TMessage); message MINIBROWSER_VISITDOM_JS;
procedure CopyFrameIDs1(var aMessage : TMessage); message MINIBROWSER_COPYFRAMEIDS_1;
procedure CopyFrameIDs2(var aMessage : TMessage); message MINIBROWSER_COPYFRAMEIDS_2;
procedure ShowMessageMsg(var aMessage : TMessage); message MINIBROWSER_SHOWMESSAGE;
procedure ShowStatusTextMsg(var aMessage : TMessage); message MINIBROWSER_SHOWSTATUSTEXT;
procedure ShowErrorMsg(var aMessage : TMessage); message MINIBROWSER_SHOWERROR;
procedure WMMove(var aMessage : TWMMove); message WM_MOVE;
procedure WMMoving(var aMessage : TMessage); message WM_MOVING;
procedure ShowStatusText(const aText : string);
public
{ Public declarations }
function QuerySelector(aNodeID : integer; const aSelector : string) : integer;
function SetAttributeValue(aNodeID : integer; const aName, aValue : string) : integer;
function HandleGetDocumentRslt(aSuccess : boolean; const aResult: ICefValue) : boolean;
function HandleQuerySelectorRslt(aSuccess : boolean; const aResult: ICefValue) : boolean;
function HandleSetAttributeValueRslt(aSuccess : boolean; const aResult: ICefValue) : boolean;
function HandleErrorRslt(const aResult: ICefValue) : boolean;
property MsgContents : string read GetMsgContents write SetMsgContents;
property StatusText : string read GetStatusText write SetStatusText;
property ErrorText : string read GetErrorText write SetErrorText;
end;
var
@ -135,30 +168,77 @@ implementation
{$R *.lfm}
uses
uCEFProcessMessage, uCEFMiscFunctions, uCEFSchemeRegistrar, uCEFRenderProcessHandler,
uCEFv8Handler, uCEFDomVisitor, uCEFDomNode, uCEFTask;
uCEFProcessMessage, uCEFMiscFunctions, uCEFSchemeRegistrar,
uCEFRenderProcessHandler, uCEFv8Handler, uCEFDomVisitor, uCEFDomNode,
uCEFTask, uCEFDictionaryValue, uCEFJson;
// This demo sends messages from the browser process to the render process,
// and from the render process to the browser process.
// To send a message from the browser process you must use the TChromium.SendProcessMessage
// procedure with a PID_RENDERER parameter. The render process receives those messages in
// the GlobalCEFApp.OnProcessMessageReceived event.
// To send a message from the browser process you must use the
// TChromium.SendProcessMessage procedure with a PID_RENDERER parameter. The
// render process receives those messages in the
// GlobalCEFApp.OnProcessMessageReceived event.
// To send messages from the render process you must use the frame.SendProcessMessage
// procedure with a PID_BROWSER parameter. The browser process receives those messages in
// the TChromium.OnProcessMessageReceived event.
// To send messages from the render process you must use the
// frame.SendProcessMessage procedure with a PID_BROWSER parameter. The browser
// process receives those messages in the TChromium.OnProcessMessageReceived
// event.
// message.name is used to identify different messages sent with SendProcessMessage.
// message.name is used to identify different messages sent with
// SendProcessMessage.
// The OnProcessMessageReceived event can recognize any number of messages identifying them
// by message.name
// The OnProcessMessageReceived event can recognize any number of messages
// identifying them by message.name
// The CEF API is not as powerful as JavaScript to visit the DOM. Consider using
// TChromium.ExecuteJavaScript to execute custom JS code in case you need more
// powerful features.
// Read the code comments in the JSExtension demo for more information about the
// Chromium processes and how to send messages between them :
// https://github.com/salvadordf/CEF4Delphi/blob/master/demos/Delphi_VCL/JavaScript/JSExtension/uJSExtension.pas
// This demo also uses de "console trick" to send information from the render
// process to the browser process.
// This method for sending text messages is limited to around 10000 characters
// but it's much easier to implement than using a JavaScript extension.
// It cosist of using the JavaScript command "console.log" with a known text
// preamble. The browser process receives the console message in the
// TChromium.OnConsoleMessage event and we identify the right message thanks to
// the preamble in the message.
// This demo also uses DevTool methods to change the "value" attribute of an
// INPUT HTML element. Each method is called using the
// TChromium.ExecuteDevToolsMethod function and the results are received in the
// TChromium.OnDevToolsMethodResult event.
// To test this feature right click on the web page and select the "Set INPUT
// value using DevTools methods" option.
// That menu option will execute the "DOM.getDocument" method to get the NodeId
// of the document node and it will trigger the TChromium.OnDevToolsMethodResult event.
// In that event we use the NodeId of the document to call the "DOM.querySelector" method
// with the "#keywords" selector, which is the ID atttribute of the INPUT element we need.
// The TChromium.OnDevToolsMethodResult event is triggered once again and now we have the
// NodeId of the INPUT element. Now we can call the "DOM.setAttributeValue" method to
// update the "value" attribute in the INPUT element.
// Read these documents for more details about the DevTools methods :
// General information -> https://chromedevtools.github.io/devtools-protocol/
// "DOM.getDocument" method -> https://chromedevtools.github.io/devtools-protocol/tot/DOM/#method-getDocument
// "DOM.querySelector" method -> https://chromedevtools.github.io/devtools-protocol/tot/DOM/#method-querySelector
// "DOM.setAttributeValue" method -> https://chromedevtools.github.io/devtools-protocol/tot/DOM/#method-setAttributeValue
// Destruction steps
// =================
// 1. FormCloseQuery sets CanClose to FALSE calls TChromium.CloseBrowser which triggers the TChromium.OnClose event.
// 2. TChromium.OnClose sends a CEFBROWSER_DESTROY message to destroy CEFWindowParent1 in the main thread, which triggers the TChromium.OnBeforeClose event.
// 3. TChromium.OnBeforeClose sets FCanClose := True and sends WM_CLOSE to the form.
// 1. FormCloseQuery sets CanClose to FALSE calls TChromium.CloseBrowser which
// triggers the TChromium.OnClose event.
// 2. TChromium.OnClose sends a CEFBROWSER_DESTROY message to destroy
// CEFWindowParent1 in the main thread, which triggers the
// TChromium.OnBeforeClose event.
// 3. TChromium.OnBeforeClose sets FCanClose := True and sends WM_CLOSE to the
// form.
procedure SimpleDOMIteration(const aDocument: ICefDomDocument);
var
@ -186,11 +266,10 @@ begin
end;
end;
procedure SimpleNodeSearch(const aDocument: ICefDomDocument);
const
NODE_ID = 'lst-ib'; // input box node found in google.com homepage
procedure SimpleNodeSearch(const aDocument: ICefDomDocument; const aFrame : ICefFrame);
var
TempNode : ICefDomNode;
TempJSCode, TempMessage : ustring;
begin
try
if (aDocument <> nil) then
@ -199,8 +278,27 @@ begin
if (TempNode <> nil) then
begin
CefLog('CEF4Delphi', 1, CEF_LOG_SEVERITY_ERROR, NODE_ID + ' element name : ' + TempNode.Name);
CefLog('CEF4Delphi', 1, CEF_LOG_SEVERITY_ERROR, NODE_ID + ' element value : ' + TempNode.GetValue);
// Here we send the name and value of the element with the "console trick".
// The name and value contents are included in TempMessage and the we
// execute "console.log" in JavaScript to send TempMessage with a
// known preamble that will be used to identify the message in the
// TChromium.OnConsoleMessage event.
// NOTE : In case you try to read or write node values using the CEF API
// you should know that ICefDomNode.GetValue and ICefDomNode.SetValue
// only work in text nodes. ICefDomNode.GetElementAttribute returns
// the attribute value specified in the HTML and not the current value.
// It's recommended that you use JavaScript or DevTools methods if
// you need to get or set the value of HTML elements.
// For example, if you want to use the "console trick" and you want
// to get the value of the search box in our forum you would have to
// execute this JavaScript code :
// console.log("DOMVISITOR" + document.getElementById("keywords").value);
TempMessage := 'name:' + TempNode.Name;
TempJSCode := 'console.log("' + CONSOLE_MSG_PREAMBLE + TempMessage + '");';
aFrame.ExecuteJavaScript(TempJSCode, 'about:blank', 0);
end;
TempNode := aDocument.GetFocusedNode;
@ -235,7 +333,7 @@ begin
SimpleDOMIteration(document);
// Simple DOM searches
SimpleNodeSearch(document);
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
@ -269,6 +367,39 @@ begin
end;
end;
procedure DOMVisitor_GetFrameIDs(const browser: ICefBrowser; const frame : ICefFrame);
var
i : NativeUInt;
TempCount : NativeUInt;
TempArray : TCefFrameIdentifierArray;
TempString : ustring;
TempMsg : ICefProcessMessage;
begin
TempCount := browser.FrameCount;
if browser.GetFrameIdentifiers(TempCount, TempArray) then
begin
TempString := '';
i := 0;
while (i < TempCount) do
begin
TempString := TempString + inttostr(TempArray[i]) + CRLF;
inc(i);
end;
try
TempMsg := TCefProcessMessageRef.New(FRAMEIDS_MSGNAME);
TempMsg.ArgumentList.SetString(0, TempString);
if (frame <> nil) and frame.IsValid then
frame.SendProcessMessage(PID_BROWSER, TempMsg);
finally
TempMsg := nil;
end;
end;
end;
procedure GlobalCEFApp_OnProcessMessageReceived(const browser : ICefBrowser;
const frame : ICefFrame;
sourceProcess : TCefProcessId;
@ -301,7 +432,13 @@ begin
end;
aHandled := True;
end;
end
else
if (message.name = FRAMEIDS_MSGNAME) then
begin
DOMVisitor_GetFrameIDs(browser, frame);
aHandled := True;
end;
end;
end;
@ -309,13 +446,25 @@ procedure CreateGlobalCEFApp;
begin
GlobalCEFApp := TCefApplication.Create;
GlobalCEFApp.RemoteDebuggingPort := 9000;
GlobalCEFApp.OnProcessMessageReceived := GlobalCEFApp_OnProcessMessageReceived;
GlobalCEFApp.OnProcessMessageReceived := GlobalCEFApp_OnProcessMessageReceived;
// 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
GlobalCEFApp.LogFile := 'debug.log';
GlobalCEFApp.LogSeverity := LOGSEVERITY_INFO;
// Delphi can only debug one process and it debugs the browser process by
// default. If you need to debug code executed in the render process you will
// need to use any of the methods described here :
// https://www.briskbard.com/index.php?lang=en&pageid=cef#debugging
// 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.
//GlobalCEFApp.SingleProcess := True;
end;
procedure TDOMVisitorFrm.Chromium1AfterCreated(Sender: TObject; const browser: ICefBrowser);
@ -336,6 +485,13 @@ procedure TDOMVisitorFrm.Chromium1BeforeContextMenu(Sender: TObject;
begin
model.AddItem(MINIBROWSER_CONTEXTMENU_VISITDOM_PARTIAL, 'Visit DOM in CEF (only Title)');
model.AddItem(MINIBROWSER_CONTEXTMENU_VISITDOM_FULL, 'Visit DOM in CEF (BODY HTML)');
model.AddItem(MINIBROWSER_CONTEXTMENU_VISITDOM_JS, 'Visit DOM using JavaScript');
model.AddItem(MINIBROWSER_CONTEXTMENU_COPYFRAMEIDS_1, 'Copy frame IDs in the browser process');
model.AddItem(MINIBROWSER_CONTEXTMENU_COPYFRAMEIDS_2, 'Copy frame IDs in the render process');
model.AddItem(MINIBROWSER_CONTEXTMENU_SETINPUTVALUE_JS, 'Set INPUT value using JavaScript');
model.AddItem(MINIBROWSER_CONTEXTMENU_SETINPUTVALUE_DT, 'Set INPUT value using DevTools methods');
model.AddSeparator;
model.AddItem(MINIBROWSER_CONTEXTMENU_SHOWDEVTOOLS, 'Show DevTools');
end;
procedure TDOMVisitorFrm.Chromium1BeforePopup(Sender: TObject;
@ -359,10 +515,39 @@ begin
aAction := cbaDelay;
end;
procedure TDOMVisitorFrm.Chromium1ConsoleMessage(Sender: TObject;
const browser: ICefBrowser; level: Cardinal; const message, source: ustring;
line: Integer; out Result: Boolean);
begin
// In this event we receive the message with the name and value of a DOM node
// from the render process.
// This event may receive many other messages but we identify our message
// thanks to the preamble.
// The we set MsgContents with the rest of the message and send a
// MINIBROWSER_SHOWMESSAGE message to show MsgContents in the main thread safely.
// This and many other TChromium events are executed in a CEF thread. The VCL
// should be used only in the main thread and we use a message and a field
// protected by a synchronization object to call showmessage safely.
if (length(message) > 0) and
(copy(message, 1, length(CONSOLE_MSG_PREAMBLE)) = CONSOLE_MSG_PREAMBLE) then
begin
MsgContents := copy(message, succ(length(CONSOLE_MSG_PREAMBLE)), length(message));
if (length(MsgContents) = 0) then
MsgContents := 'There was an error reading the search box information'
else
MsgContents := 'Search box information: ' + quotedstr(MsgContents);
PostMessage(Handle, MINIBROWSER_SHOWMESSAGE, 0, 0);
end;
end;
procedure TDOMVisitorFrm.Chromium1ContextMenuCommand(Sender: TObject;
const browser: ICefBrowser; const frame: ICefFrame;
const params: ICefContextMenuParams; commandId: Integer;
eventFlags: Cardinal; out Result: Boolean);
var
TempPoint : TPoint;
begin
Result := False;
@ -372,9 +557,143 @@ begin
MINIBROWSER_CONTEXTMENU_VISITDOM_FULL :
PostMessage(Handle, MINIBROWSER_VISITDOM_FULL, 0, 0);
MINIBROWSER_CONTEXTMENU_VISITDOM_JS :
PostMessage(Handle, MINIBROWSER_VISITDOM_JS, 0, 0);
MINIBROWSER_CONTEXTMENU_COPYFRAMEIDS_1 :
PostMessage(Handle, MINIBROWSER_COPYFRAMEIDS_1, 0, 0);
MINIBROWSER_CONTEXTMENU_COPYFRAMEIDS_2 :
PostMessage(Handle, MINIBROWSER_COPYFRAMEIDS_2, 0, 0);
MINIBROWSER_CONTEXTMENU_SETINPUTVALUE_JS :
frame.ExecuteJavaScript('document.getElementById("' + NODE_ID + '").value = "qwerty";', 'about:blank', 0);
MINIBROWSER_CONTEXTMENU_SETINPUTVALUE_DT :
// https://chromedevtools.github.io/devtools-protocol/tot/DOM/#method-getDocument
if (Chromium1.ExecuteDevToolsMethod(0, 'DOM.getDocument', nil) <> 0) then
FStatus := dvsGettingDocNodeID
else
FStatus := dvsIdle;
MINIBROWSER_CONTEXTMENU_SHOWDEVTOOLS :
begin
TempPoint.x := params.XCoord;
TempPoint.y := params.YCoord;
Chromium1.ShowDevTools(TempPoint, nil);
end;
end;
end;
function TDOMVisitorFrm.HandleGetDocumentRslt(aSuccess : boolean; const aResult: ICefValue) : boolean;
var
TempRsltDict, TempRootNode : ICefDictionaryValue;
TempDocNodeID : integer;
begin
Result := False;
if aSuccess and (aResult <> nil) then
begin
TempRsltDict := aResult.GetDictionary;
if TCEFJson.ReadDictionary(TempRsltDict, 'root', TempRootNode) and
TCEFJson.ReadInteger(TempRootNode, 'nodeId', TempDocNodeID) and
(QuerySelector(TempDocNodeID, '#' + NODE_ID) <> 0) then
Result := True;
end
else
if not(HandleErrorRslt(aResult)) then
ErrorText := 'GetDocument was not successful!';
if not(Result) then
PostMessage(Handle, MINIBROWSER_SHOWERROR, 0, 0);
end;
function TDOMVisitorFrm.HandleQuerySelectorRslt(aSuccess : boolean; const aResult: ICefValue) : boolean;
var
TempRsltDict : ICefDictionaryValue;
TempNodeID : integer;
begin
Result := False;
if aSuccess and (aResult <> nil) then
begin
TempRsltDict := aResult.GetDictionary;
if TCEFJson.ReadInteger(TempRsltDict, 'nodeId', TempNodeID) and
(SetAttributeValue(TempNodeID, 'value', 'qwerty') <> 0) then
Result := True;
end
else
if not(HandleErrorRslt(aResult)) then
ErrorText := 'QuerySelector was not successful!';
if not(Result) then
PostMessage(Handle, MINIBROWSER_SHOWERROR, 0, 0);
end;
function TDOMVisitorFrm.HandleSetAttributeValueRslt(aSuccess : boolean; const aResult: ICefValue) : boolean;
begin
Result := False;
if aSuccess then
Result := True
else
if not(HandleErrorRslt(aResult)) then
ErrorText := 'SetAttributeValue was not successful!';
if not(Result) then
PostMessage(Handle, MINIBROWSER_SHOWERROR, 0, 0);
end;
function TDOMVisitorFrm.HandleErrorRslt(const aResult: ICefValue) : boolean;
var
TempRsltDict : ICefDictionaryValue;
TempCode : integer;
TempMessage : ustring;
begin
Result := False;
if (aResult <> nil) then
begin
TempRsltDict := aResult.GetDictionary;
if TCEFJson.ReadInteger(TempRsltDict, 'code', TempCode) and
TCEFJson.ReadString(TempRsltDict, 'message', TempMessage) then
begin
ErrorText := 'Error (' + inttostr(TempCode) + ') : ' + quotedstr(TempMessage);
Result := True;
end;
end;
end;
procedure TDOMVisitorFrm.Chromium1DevToolsMethodResult(Sender: TObject;
const browser: ICefBrowser; message_id: Integer; success: Boolean;
const result: ICefValue);
begin
case FStatus of
dvsGettingDocNodeID :
if HandleGetDocumentRslt(success, result) then
begin
FStatus := dvsQueryingSelector;
exit;
end;
dvsQueryingSelector :
if HandleQuerySelectorRslt(success, result) then
begin
FStatus := dvsSettingAttributeValue;
exit;
end;
dvsSettingAttributeValue :
HandleSetAttributeValueRslt(success, result);
end;
FStatus := dvsIdle;
end;
procedure TDOMVisitorFrm.Chromium1ProcessMessageReceived(Sender: TObject;
const browser: ICefBrowser; const frame: ICefFrame; sourceProcess: TCefProcessId;
const message: ICefProcessMessage; out Result: Boolean);
@ -387,16 +706,26 @@ begin
if (message.Name = DOMVISITOR_MSGNAME_PARTIAL) then
begin
ShowStatusText('DOM Visitor result text : ' + message.ArgumentList.GetString(0));
StatusText := 'DOM Visitor result text : ' + message.ArgumentList.GetString(0);
Result := True;
end
else
if (message.Name = DOMVISITOR_MSGNAME_FULL) then
begin
Clipboard.AsText := message.ArgumentList.GetString(0);
ShowStatusText('HTML copied to the clipboard');
StatusText := 'HTML copied to the clipboard';
Result := True;
end;
end
else
if (message.Name = FRAMEIDS_MSGNAME) then
begin
Clipboard.AsText := message.ArgumentList.GetString(0);
StatusText := 'Frame IDs copied to the clipboard in the render process.';
Result := True;
end;
if Result then
PostMessage(Handle, MINIBROWSER_SHOWSTATUSTEXT, 0, 0);
end;
procedure TDOMVisitorFrm.FormCloseQuery(Sender: TObject;
@ -416,6 +745,14 @@ procedure TDOMVisitorFrm.FormCreate(Sender: TObject);
begin
FCanClose := False;
FClosing := False;
FStatus := dvsIdle;
FCritSection := TCriticalSection.Create;
end;
procedure TDOMVisitorFrm.FormDestroy(Sender: TObject);
begin
FreeAndNil(FCritSection);
end;
procedure TDOMVisitorFrm.FormShow(Sender: TObject);
@ -430,11 +767,6 @@ begin
Chromium1.LoadURL(AddressEdt.Text);
end;
procedure TDOMVisitorFrm.CEFSentinel1Close(Sender: TObject);
begin
end;
procedure TDOMVisitorFrm.BrowserCreatedMsg(var aMessage : TMessage);
begin
CEFWindowParent1.UpdateSize;
@ -470,6 +802,67 @@ begin
Chromium1.SendProcessMessage(PID_RENDERER, TempMsg);
end;
procedure TDOMVisitorFrm.VisitDOM3Msg(var aMessage : TMessage);
var
TempJSCode, TempMessage : string;
begin
// Here we send the name and value of the element with the "console trick".
// We execute "console.log" in JavaScript to send TempMessage with a
// known preamble that will be used to identify the message in the
// TChromium.OnConsoleMessage event.
TempMessage := 'document.getElementById("' + NODE_ID + '").value';
TempJSCode := 'console.log("' + CONSOLE_MSG_PREAMBLE + '" + ' + TempMessage + ');';
chromium1.ExecuteJavaScript(TempJSCode, 'about:blank');
end;
procedure TDOMVisitorFrm.CopyFrameIDs1(var aMessage : TMessage);
var
i : NativeUInt;
TempCount : NativeUInt;
TempArray : TCefFrameIdentifierArray;
TempString : string;
begin
TempCount := Chromium1.FrameCount;
if Chromium1.GetFrameIdentifiers(TempCount, TempArray) then
begin
TempString := '';
i := 0;
while (i < TempCount) do
begin
TempString := TempString + inttostr(TempArray[i]) + CRLF;
inc(i);
end;
clipboard.AsText := TempString;
ShowStatusText('Frame IDs copied to the clipboard in the browser process (' + inttostr(TempCount) + ')');
end;
end;
procedure TDOMVisitorFrm.CopyFrameIDs2(var aMessage : TMessage);
var
TempMsg : ICefProcessMessage;
begin
TempMsg := TCefProcessMessageRef.New(FRAMEIDS_MSGNAME);
Chromium1.SendProcessMessage(PID_RENDERER, TempMsg);
end;
procedure TDOMVisitorFrm.ShowMessageMsg(var aMessage : TMessage);
begin
showmessage(MsgContents);
end;
procedure TDOMVisitorFrm.ShowStatusTextMsg(var aMessage : TMessage);
begin
ShowStatusText(StatusText);
end;
procedure TDOMVisitorFrm.ShowErrorMsg(var aMessage : TMessage);
begin
messagedlg(ErrorText, mtError, [mbOK], 0);
end;
procedure TDOMVisitorFrm.WMMove(var aMessage : TWMMove);
begin
inherited;
@ -489,6 +882,46 @@ begin
StatusPnl.Caption := aText;
end;
// https://chromedevtools.github.io/devtools-protocol/tot/DOM/#method-querySelector
function TDOMVisitorFrm.QuerySelector(aNodeID : integer; const aSelector : string) : integer;
var
TempParams : ICefDictionaryValue;
begin
Result := 0;
try
if (length(aSelector) > 0) then
begin
TempParams := TCefDictionaryValueRef.New;
TempParams.SetInt('nodeId', aNodeID);
TempParams.SetString('selector', aSelector);
Result := Chromium1.ExecuteDevToolsMethod(0, 'DOM.querySelector', TempParams);
end;
finally
TempParams := nil;
end;
end;
// https://chromedevtools.github.io/devtools-protocol/tot/DOM/#method-setAttributeValue
function TDOMVisitorFrm.SetAttributeValue(aNodeID : integer; const aName, aValue : string) : integer;
var
TempParams : ICefDictionaryValue;
begin
Result := 0;
try
if (aNodeID <> 0) then
begin
TempParams := TCefDictionaryValueRef.New;
TempParams.SetInt('nodeId', aNodeID);
TempParams.SetString('name', aName);
TempParams.SetString('value', aValue);
Result := Chromium1.ExecuteDevToolsMethod(0, 'DOM.setAttributeValue', TempParams);
end;
finally
TempParams := nil;
end;
end;
procedure TDOMVisitorFrm.Timer1Timer(Sender: TObject);
begin
Timer1.Enabled := False;
@ -496,4 +929,73 @@ begin
Timer1.Enabled := True;
end;
function TDOMVisitorFrm.GetMsgContents : string;
begin
Result := '';
if (FCritSection <> nil) then
try
FCritSection.Acquire;
Result := FMsgContents;
finally
FCritSection.Release;
end;
end;
procedure TDOMVisitorFrm.SetMsgContents(const aValue : string);
begin
if (FCritSection <> nil) then
try
FCritSection.Acquire;
FMsgContents := aValue;
finally
FCritSection.Release;
end;
end;
function TDOMVisitorFrm.GetStatusText : string;
begin
Result := '';
if (FCritSection <> nil) then
try
FCritSection.Acquire;
Result := FStatusText;
finally
FCritSection.Release;
end;
end;
procedure TDOMVisitorFrm.SetStatusText(const aValue : string);
begin
if (FCritSection <> nil) then
try
FCritSection.Acquire;
FStatusText := aValue;
finally
FCritSection.Release;
end;
end;
function TDOMVisitorFrm.GetErrorText : string;
begin
Result := '';
if (FCritSection <> nil) then
try
FCritSection.Acquire;
Result := FErrorText;
finally
FCritSection.Release;
end;
end;
procedure TDOMVisitorFrm.SetErrorText(const aValue : string);
begin
if (FCritSection <> nil) then
try
FCritSection.Acquire;
FErrorText := aValue;
finally
FCritSection.Release;
end;
end;
end.