pascal/CEF4Delphi
1
0
Fork 0
mirror of https://github.com/salvadordf/CEF4Delphi.git synced 2024-11-24 08:02:15 +02:00
Code Issues Actions Releases Activity

Added context menu option to DOMVisitor to set the value of an INPUT element using the DevTools methods

Browse Source 
Added the TCEFJson class
This commit is contained in:
Salvador Díaz Fau 2020-07-16 15:47:27 +02:00
parent 882c79ac1b
commit 3246eff9a1
8 changed files with 421 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
demos/Delphi_VCL/DOMVisitor/uDOMVisitor.dfm
View File

@ -102,6 +102,7 @@ object DOMVisitorFrm: TDOMVisitorFrm
OnAfterCreated = Chromium1AfterCreated
OnBeforeClose = Chromium1BeforeClose
OnClose = Chromium1Close
OnDevToolsMethodResult = Chromium1DevToolsMethodResult
Left = 16
Top = 40
end

238
demos/Delphi_VCL/DOMVisitor/uDOMVisitor.pas
View File

@ -62,6 +62,7 @@ const
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;
@ -69,6 +70,7 @@ const
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;
DOMVISITOR_MSGNAME_PARTIAL = 'domvisitorpartial';
DOMVISITOR_MSGNAME_FULL = 'domvisitorfull';
@ -80,6 +82,8 @@ const
NODE_ID = 'keywords';
type
TDTVisitStatus = (dvsIdle, dvsGettingDocNodeID, dvsQueryingSelector, dvsSettingAttributeValue);
TDOMVisitorFrm = class(TForm)
CEFWindowParent1: TCEFWindowParent;
Chromium1: TChromium;
@ -108,6 +112,7 @@ type
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: Cardinal; 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
@ -119,28 +124,42 @@ type
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 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);
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
@ -155,7 +174,7 @@ implementation
uses
uCEFProcessMessage, uCEFMiscFunctions, uCEFSchemeRegistrar,
uCEFRenderProcessHandler, uCEFv8Handler, uCEFDomVisitor, uCEFDomNode,
uCEFTask;
uCEFTask, uCEFDictionaryValue, uCEFJson;
// This demo sends messages from the browser process to the render process,
// and from the render process to the browser process.
@ -193,6 +212,28 @@ uses
// TChromium.OnConsoleMessage event and we identify the right message thanks to
// the preamble in the message.
// This demos 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
@ -447,6 +488,7 @@ begin
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');
end;
procedure TDOMVisitorFrm.Chromium1BeforePopup(Sender: TObject;
@ -521,10 +563,125 @@ begin
PostMessage(Handle, MINIBROWSER_COPYFRAMEIDS_2, 0, 0);
MINIBROWSER_CONTEXTMENU_SETINPUTVALUE_JS :
frame.ExecuteJavaScript('document.getElementById("keywords").value = "qwerty";', 'about:blank', 0);
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;
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 : string;
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);
@ -576,6 +733,7 @@ procedure TDOMVisitorFrm.FormCreate(Sender: TObject);
begin
FCanClose := False;
FClosing := False;
FStatus := dvsIdle;
FCritSection := TCriticalSection.Create;
end;
@ -688,6 +846,11 @@ 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;
@ -707,6 +870,46 @@ begin
StatusBar1.Panels[0].Text := 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;
@ -760,4 +963,27 @@ begin
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.

3
packages/CEF4Delphi.dpk
View File

@ -216,7 +216,8 @@ contains
uCEFMenuButtonComponent in '..\source\uCEFMenuButtonComponent.pas',
uCEFAudioHandler in '..\source\uCEFAudioHandler.pas',
uCEFDevToolsMessageObserver in '..\source\uCEFDevToolsMessageObserver.pas',
uCEFMediaSinkDeviceInfoCallback in '..\source\uCEFMediaSinkDeviceInfoCallback.pas';
uCEFMediaSinkDeviceInfoCallback in '..\source\uCEFMediaSinkDeviceInfoCallback.pas',
uCEFJson in '..\source\uCEFJson.pas';
end.

3
packages/CEF4Delphi_D7.dpk
View File

@ -213,6 +213,7 @@ contains
uCEFMenuButtonComponent in '..\source\uCEFMenuButtonComponent.pas',
uCEFAudioHandler in '..\source\uCEFAudioHandler.pas',
uCEFDevToolsMessageObserver in '..\source\uCEFDevToolsMessageObserver.pas',
uCEFMediaSinkDeviceInfoCallback in '..\source\uCEFMediaSinkDeviceInfoCallback.pas';
uCEFMediaSinkDeviceInfoCallback in '..\source\uCEFMediaSinkDeviceInfoCallback.pas',
uCEFJson in '..\source\uCEFJson.pas';
end.

3
packages/CEF4Delphi_FMX.dpk
View File

@ -221,7 +221,8 @@ contains
uCEFMenuButtonComponent in '..\source\uCEFMenuButtonComponent.pas',
uCEFAudioHandler in '..\source\uCEFAudioHandler.pas',
uCEFDevToolsMessageObserver in '..\source\uCEFDevToolsMessageObserver.pas',
uCEFMediaSinkDeviceInfoCallback in '..\source\uCEFMediaSinkDeviceInfoCallback.pas';
uCEFMediaSinkDeviceInfoCallback in '..\source\uCEFMediaSinkDeviceInfoCallback.pas',
uCEFJson in '..\source\uCEFJson.pas';
end.

1
packages/CEF4Delphi_FMX.dproj
View File

@ -337,6 +337,7 @@
<DCCReference Include="..\source\uCEFAudioHandler.pas"/>
<DCCReference Include="..\source\uCEFDevToolsMessageObserver.pas"/>
<DCCReference Include="..\source\uCEFMediaSinkDeviceInfoCallback.pas"/>
<DCCReference Include="..\source\uCEFJson.pas"/>
<BuildConfiguration Include="Base">
<Key>Base</Key>
</BuildConfiguration>

180
source/uCEFJson.pas Normal file
View File

@ -0,0 +1,180 @@
// ************************************************************************
// ***************************** CEF4Delphi *******************************
// ************************************************************************
//
// CEF4Delphi is based on DCEF3 which uses CEF to embed a chromium-based
// browser in Delphi applications.
//
// The original license of DCEF3 still applies to CEF4Delphi.
//
// For more information about CEF4Delphi visit :
// https://www.briskbard.com/index.php?lang=en&pageid=cef
//
// Copyright © 2020 Salvador Diaz Fau. All rights reserved.
//
// ************************************************************************
// ************ vvvv Original license and comments below vvvv *************
// ************************************************************************
(*
* Delphi Chromium Embedded 3
*
* Usage allowed under the restrictions of the Lesser GNU General Public License
* or alternatively the restrictions of the Mozilla Public License 1.1
*
* Software distributed under the License is distributed on an "AS IS" basis,
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
* the specific language governing rights and limitations under the License.
*
* Unit owner : Henri Gourvest <hgourvest@gmail.com>
* Web site : http://www.progdigy.com
* Repository : http://code.google.com/p/delphichromiumembedded/
* Group : http://groups.google.com/group/delphichromiumembedded
*
* Embarcadero Technologies, Inc is not permitted to use or redistribute
* this source code without explicit permission.
*
*)
unit uCEFJson;
interface
uses
uCEFInterfaces;
type
TCEFJson = class
public
class function ReadValue(const aDictionary : ICefDictionaryValue; const aKey : string; var aValue : ICefValue) : boolean;
class function ReadBoolean(const aDictionary : ICefDictionaryValue; const aKey : string; var aValue : boolean) : boolean;
class function ReadInteger(const aDictionary : ICefDictionaryValue; const aKey : string; var aValue : integer) : boolean;
class function ReadDouble(const aDictionary : ICefDictionaryValue; const aKey : string; var aValue : double) : boolean;
class function ReadString(const aDictionary : ICefDictionaryValue; const aKey : string; var aValue : string) : boolean;
class function ReadBinary(const aDictionary : ICefDictionaryValue; const aKey : string; var aValue : ICefBinaryValue) : boolean;
class function ReadDictionary(const aDictionary : ICefDictionaryValue; const aKey : string; var aValue : ICefDictionaryValue) : boolean;
class function ReadList(const aDictionary : ICefDictionaryValue; const aKey : string; var aValue : ICefListValue) : boolean;
end;
implementation
uses
uCEFTypes;
class function TCEFJson.ReadValue(const aDictionary : ICefDictionaryValue; const aKey : string; var aValue : ICefValue) : boolean;
begin
Result := False;
aValue := nil;
if (aDictionary <> nil) then
begin
aValue := aDictionary.GetValue(aKey);
Result := (aValue <> nil);
end;
end;
class function TCEFJson.ReadBoolean(const aDictionary : ICefDictionaryValue; const aKey : string; var aValue : boolean) : boolean;
var
TempValue : ICefValue;
begin
Result := False;
aValue := False;
if ReadValue(aDictionary, aKey, TempValue) and
(TempValue.GetType = VTYPE_BOOL) then
begin
aValue := TempValue.GetBool;
Result := True;
end;
end;
class function TCEFJson.ReadInteger(const aDictionary : ICefDictionaryValue; const aKey : string; var aValue : integer) : boolean;
var
TempValue : ICefValue;
begin
Result := False;
aValue := 0;
if ReadValue(aDictionary, aKey, TempValue) and
(TempValue.GetType = VTYPE_INT) then
begin
aValue := TempValue.GetInt;
Result := True;
end;
end;
class function TCEFJson.ReadDouble(const aDictionary : ICefDictionaryValue; const aKey : string; var aValue : double) : boolean;
var
TempValue : ICefValue;
begin
Result := False;
aValue := 0;
if ReadValue(aDictionary, aKey, TempValue) and
(TempValue.GetType = VTYPE_DOUBLE) then
begin
aValue := TempValue.GetDouble;
Result := True;
end;
end;
class function TCEFJson.ReadString(const aDictionary : ICefDictionaryValue; const aKey : string; var aValue : string) : boolean;
var
TempValue : ICefValue;
begin
Result := False;
aValue := '';
if ReadValue(aDictionary, aKey, TempValue) and
(TempValue.GetType = VTYPE_STRING) then
begin
aValue := TempValue.GetString;
Result := True;
end;
end;
class function TCEFJson.ReadBinary(const aDictionary : ICefDictionaryValue; const aKey : string; var aValue : ICefBinaryValue) : boolean;
var
TempValue : ICefValue;
begin
Result := False;
aValue := nil;
if ReadValue(aDictionary, aKey, TempValue) and
(TempValue.GetType = VTYPE_BINARY) then
begin
aValue := TempValue.GetBinary;
Result := True;
end;
end;
class function TCEFJson.ReadDictionary(const aDictionary : ICefDictionaryValue; const aKey : string; var aValue : ICefDictionaryValue) : boolean;
var
TempValue : ICefValue;
begin
Result := False;
aValue := nil;
if ReadValue(aDictionary, aKey, TempValue) and
(TempValue.GetType = VTYPE_DICTIONARY) then
begin
aValue := TempValue.GetDictionary;
Result := True;
end;
end;
class function TCEFJson.ReadList(const aDictionary : ICefDictionaryValue; const aKey : string; var aValue : ICefListValue) : boolean;
var
TempValue : ICefValue;
begin
Result := False;
aValue := nil;
if ReadValue(aDictionary, aKey, TempValue) and
(TempValue.GetType = VTYPE_LIST) then
begin
aValue := TempValue.GetList;
Result := True;
end;
end;
end.

2
update_CEF4Delphi.json
View File

@ -2,7 +2,7 @@
"UpdateLazPackages" : [
{
"ForceNotify" : true,
"InternalVersion" : 161,
"InternalVersion" : 162,
"Name" : "cef4delphi_lazarus.lpk",
"Version" : "83.5.0.0"
}