pascal/CEF4Delphi
1
0
Fork 0
mirror of https://github.com/salvadordf/CEF4Delphi.git synced 2025-04-17 06:57:13 +02:00
Code Issues Actions Releases Activity

Improved function to emulate the user agent thanks to 김케이 KimK-Hack

Browse Source
This commit is contained in:
Salvador Díaz Fau 2024-04-18 12:06:34 +02:00
parent 939b98d006
commit 7b21547a4b
5 changed files with 112 additions and 34 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
demos/Delphi_VCL/MobileBrowser/uMobileBrowser.dfm
View File

@ -41,7 +41,7 @@ object Form1: TForm1
Align = alClient
ReadOnly = True
ScrollBars = ssBoth
TabOrder = 0
TabOrder = 3
end
object Panel3: TPanel
Left = 0
@ -54,7 +54,7 @@ object Form1: TForm1
Padding.Top = 10
Padding.Right = 10
Padding.Bottom = 10
TabOrder = 1
TabOrder = 0
object CanEmulateBtn: TButton
Left = 10
Top = 10
@ -86,7 +86,7 @@ object Form1: TForm1
Padding.Left = 10
Padding.Right = 10
Padding.Bottom = 10
TabOrder = 2
TabOrder = 1
object GroupBox1: TGroupBox
Left = 10
Top = 0
@ -218,7 +218,7 @@ object Form1: TForm1
Padding.Left = 10
Padding.Right = 10
Padding.Bottom = 10
TabOrder = 3
TabOrder = 2
object GroupBox2: TGroupBox
Left = 10
Top = 0
@ -239,7 +239,7 @@ object Form1: TForm1
Align = alTop
BevelOuter = bvNone
Padding.Bottom = 5
TabOrder = 0
TabOrder = 1
object Label1: TLabel
Left = 0
Top = 0
@ -270,7 +270,7 @@ object Form1: TForm1
Align = alTop
BevelOuter = bvNone
Padding.Bottom = 5
TabOrder = 1
TabOrder = 0
object Label2: TLabel
Left = 0
Top = 0
@ -300,7 +300,7 @@ object Form1: TForm1
Height = 25
Align = alBottom
Caption = 'Override device metrics'
TabOrder = 2
TabOrder = 5
OnClick = OverrideDeviceMetricsBtnClick
end
object Panel8: TPanel
@ -311,7 +311,7 @@ object Form1: TForm1
Align = alTop
BevelOuter = bvNone
Padding.Bottom = 5
TabOrder = 3
TabOrder = 2
object Label3: TLabel
Left = 0
Top = 0
@ -343,7 +343,7 @@ object Form1: TForm1
Align = alTop
BevelOuter = bvNone
Padding.Bottom = 5
TabOrder = 4
TabOrder = 3
object Label4: TLabel
Left = 0
Top = 0
@ -379,7 +379,7 @@ object Form1: TForm1
Align = alTop
BevelOuter = bvNone
Padding.Bottom = 5
TabOrder = 5
TabOrder = 4
object Label5: TLabel
Left = 0
Top = 0

40
demos/Delphi_VCL/MobileBrowser/uMobileBrowser.pas
View File

@ -53,6 +53,9 @@ type
procedure Timer1Timer(Sender: TObject);
procedure CanEmulateBtnClick(Sender: TObject);
procedure OverrideUserAgentBtnClick(Sender: TObject);
procedure EmulateTouchChkClick(Sender: TObject);
procedure ClearDeviceMetricsOverrideBtnClick(Sender: TObject);
procedure OverrideDeviceMetricsBtnClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure FormCreate(Sender: TObject);
@ -64,9 +67,6 @@ type
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, Result: Boolean);
procedure Chromium1OpenUrlFromTab(Sender: TObject; const browser: ICefBrowser; const frame: ICefFrame; const targetUrl: ustring; targetDisposition: TCefWindowOpenDisposition; userGesture: Boolean; out Result: Boolean);
procedure Chromium1DevToolsMethodResult(Sender: TObject; const browser: ICefBrowser; message_id: Integer; success: Boolean; const result: ICefValue);
procedure EmulateTouchChkClick(Sender: TObject);
procedure ClearDeviceMetricsOverrideBtnClick(Sender: TObject);
procedure OverrideDeviceMetricsBtnClick(Sender: TObject);
protected
// Variables to control when can we destroy the form safely
@ -102,7 +102,7 @@ implementation
{$R *.dfm}
uses
uCEFApplication, uCefMiscFunctions;
uCEFApplication, uCefMiscFunctions, uCEFListValue;
// This demo allows you to emulate a mobile browser using the "Emulation" namespace of the DevTools.
// It's necesary to reload the browser after using the controls in the right panel.
@ -294,10 +294,42 @@ end;
procedure TForm1.OverrideUserAgentBtnClick(Sender: TObject);
var
TempParams : ICefDictionaryValue;
TempMetadataDict, TempBrandDict, TempFullVersionDict: ICefDictionaryValue;
TempBrandsArray, TempFullVersionListArray: ICefListValue;
begin
try
TempParams := TCefDictionaryValueRef.New;
TempMetadataDict := TCefDictionaryValueRef.New;
TempBrandsArray := TCefListValueRef.New;
TempFullVersionListArray := TCefListValueRef.New;
TempBrandsArray.SetSize(1);
TempBrandDict := TCefDictionaryValueRef.New;
TempBrandDict.SetString('brand', 'Chromium');
TempBrandDict.SetString('version', '91');
TempBrandsArray.SetDictionary(0, TempBrandDict);
TempFullVersionListArray.SetSize(1);
TempFullVersionDict := TCefDictionaryValueRef.New;
TempFullVersionDict.SetString('brand', 'Chromium'); //Not:A
TempFullVersionDict.SetString('version', '91.0.4472.114');
TempFullVersionListArray.SetDictionary(0, TempFullVersionDict);
TempMetadataDict.SetList('brands', TempBrandsArray);
TempMetadataDict.SetList('fullVersionList', TempFullVersionListArray);
TempMetadataDict.SetString('platform', 'Android'); //or Windows
TempMetadataDict.SetString('platformVersion', '12');
TempMetadataDict.SetString('architecture', 'arm');
TempMetadataDict.SetString('model', 'SM-F916N');
TempMetadataDict.SetBool('mobile', true);
TempMetadataDict.SetString('bitness', '32');
TempParams.SetString('userAgent', UserAgentCb.Text);
// Setting the userAgentMetadata value is optional and can be omited.
// All the values in TempMetadataDict are just an example and they should be customized for each use case.
TempParams.SetDictionary('userAgentMetadata', TempMetadataDict);
FPendingMsgID := DEVTOOLS_SETUSERAGENTOVERRIDE_MSGID;
Chromium1.ExecuteDevToolsMethod(0, 'Emulation.setUserAgentOverride', TempParams);

50
demos/Lazarus_Windows/MobileBrowser/uMobileBrowser.lfm
View File

@ -14,7 +14,7 @@ object Form1: TForm1
OnCreate = FormCreate
OnShow = FormShow
Position = poScreenCenter
LCLVersion = '2.2.0.4'
LCLVersion = '3.2.0.0'
object Splitter1: TSplitter
Left = 739
Height = 624
@ -33,6 +33,7 @@ object Form1: TForm1
BevelOuter = bvNone
ClientHeight = 624
ClientWidth = 294
ParentBackground = False
TabOrder = 0
object LogMem: TMemo
Left = 0
@ -42,7 +43,7 @@ object Form1: TForm1
Align = alClient
ReadOnly = True
ScrollBars = ssBoth
TabOrder = 0
TabOrder = 3
end
object Panel3: TPanel
Left = 0
@ -53,7 +54,8 @@ object Form1: TForm1
BevelOuter = bvNone
ClientHeight = 58
ClientWidth = 294
TabOrder = 1
ParentBackground = False
TabOrder = 0
object CanEmulateBtn: TButton
Left = 0
Height = 25
@ -61,8 +63,8 @@ object Form1: TForm1
Width = 294
Align = alTop
Caption = 'Can emulate'
OnClick = CanEmulateBtnClick
TabOrder = 0
OnClick = CanEmulateBtnClick
end
object ClearDeviceMetricsOverrideBtn: TButton
Left = 0
@ -71,8 +73,8 @@ object Form1: TForm1
Width = 294
Align = alBottom
Caption = 'Clear device metrics override'
OnClick = ClearDeviceMetricsOverrideBtnClick
TabOrder = 1
OnClick = ClearDeviceMetricsOverrideBtnClick
end
end
object Panel4: TPanel
@ -84,7 +86,8 @@ object Form1: TForm1
BevelOuter = bvNone
ClientHeight = 97
ClientWidth = 294
TabOrder = 2
ParentBackground = False
TabOrder = 1
object GroupBox1: TGroupBox
Left = 0
Height = 73
@ -94,6 +97,7 @@ object Form1: TForm1
Caption = ' User agent '
ClientHeight = 55
ClientWidth = 290
ParentBackground = False
TabOrder = 0
object UserAgentCb: TComboBox
Left = 0
@ -135,19 +139,19 @@ object Form1: TForm1
Width = 290
Align = alBottom
Caption = 'Override user agent'
OnClick = OverrideUserAgentBtnClick
TabOrder = 1
OnClick = OverrideUserAgentBtnClick
end
end
object EmulateTouchChk: TCheckBox
Left = 0
Height = 19
Top = 78
Height = 17
Top = 80
Width = 294
Align = alBottom
Caption = 'Emulate Touch'
OnClick = EmulateTouchChkClick
TabOrder = 1
OnClick = EmulateTouchChkClick
end
end
object Panel5: TPanel
@ -159,7 +163,8 @@ object Form1: TForm1
BevelOuter = bvNone
ClientHeight = 205
ClientWidth = 294
TabOrder = 3
ParentBackground = False
TabOrder = 2
object GroupBox2: TGroupBox
Left = 0
Height = 205
@ -169,6 +174,7 @@ object Form1: TForm1
Caption = ' Emulate device metrics '
ClientHeight = 187
ClientWidth = 290
ParentBackground = False
TabOrder = 0
object Panel6: TPanel
Left = 0
@ -179,7 +185,8 @@ object Form1: TForm1
BevelOuter = bvNone
ClientHeight = 27
ClientWidth = 290
TabOrder = 0
ParentBackground = False
TabOrder = 1
object Label1: TLabel
Left = 0
Height = 27
@ -209,7 +216,8 @@ object Form1: TForm1
BevelOuter = bvNone
ClientHeight = 27
ClientWidth = 290
TabOrder = 1
ParentBackground = False
TabOrder = 0
object Label2: TLabel
Left = 0
Height = 27
@ -237,8 +245,8 @@ object Form1: TForm1
Width = 290
Align = alBottom
Caption = 'Override device metrics'
TabOrder = 5
OnClick = OverrideDeviceMetricsBtnClick
TabOrder = 2
end
object Panel8: TPanel
Left = 0
@ -249,7 +257,8 @@ object Form1: TForm1
BevelOuter = bvNone
ClientHeight = 27
ClientWidth = 290
TabOrder = 3
ParentBackground = False
TabOrder = 2
object Label3: TLabel
Left = 0
Height = 27
@ -266,6 +275,7 @@ object Form1: TForm1
Top = 0
Width = 215
Align = alClient
EnableSets = False
MaxLength = 4
TabOrder = 0
EditMask = '#.##;1;0'
@ -282,7 +292,8 @@ object Form1: TForm1
BevelOuter = bvNone
ClientHeight = 27
ClientWidth = 290
TabOrder = 4
ParentBackground = False
TabOrder = 3
object Label4: TLabel
Left = 0
Height = 27
@ -321,7 +332,8 @@ object Form1: TForm1
BevelOuter = bvNone
ClientHeight = 27
ClientWidth = 290
TabOrder = 5
ParentBackground = False
TabOrder = 4
object Label5: TLabel
Left = 0
Height = 27
@ -354,6 +366,7 @@ object Form1: TForm1
BevelOuter = bvNone
ClientHeight = 624
ClientWidth = 739
ParentBackground = False
TabOrder = 1
object AddressPnl: TPanel
Left = 0
@ -365,6 +378,7 @@ object Form1: TForm1
ClientHeight = 20
ClientWidth = 739
Enabled = False
ParentBackground = False
TabOrder = 0
object AddressEdt: TEdit
Left = 0
@ -382,8 +396,8 @@ object Form1: TForm1
Width = 31
Align = alRight
Caption = 'Go'
OnClick = GoBtnClick
TabOrder = 1
OnClick = GoBtnClick
end
end
object CEFWindowParent1: TCEFWindowParent

34
demos/Lazarus_Windows/MobileBrowser/uMobileBrowser.pas
View File

@ -110,7 +110,7 @@ implementation
{$R *.lfm}
uses
uCEFApplication, uCEFMiscFunctions;
uCEFApplication, uCEFMiscFunctions, uCEFListValue;
// This demo allows you to emulate a mobile browser using the "Emulation" namespace of the DevTools.
// It's necesary to reload the browser after using the controls in the right panel.
@ -305,10 +305,42 @@ end;
procedure TForm1.OverrideUserAgentBtnClick(Sender: TObject);
var
TempParams : ICefDictionaryValue;
TempMetadataDict, TempBrandDict, TempFullVersionDict: ICefDictionaryValue;
TempBrandsArray, TempFullVersionListArray: ICefListValue;
begin
try
TempParams := TCefDictionaryValueRef.New;
TempMetadataDict := TCefDictionaryValueRef.New;
TempBrandsArray := TCefListValueRef.New;
TempFullVersionListArray := TCefListValueRef.New;
TempBrandsArray.SetSize(1);
TempBrandDict := TCefDictionaryValueRef.New;
TempBrandDict.SetString('brand', 'Chromium');
TempBrandDict.SetString('version', '91');
TempBrandsArray.SetDictionary(0, TempBrandDict);
TempFullVersionListArray.SetSize(1);
TempFullVersionDict := TCefDictionaryValueRef.New;
TempFullVersionDict.SetString('brand', 'Chromium'); //Not:A
TempFullVersionDict.SetString('version', '91.0.4472.114');
TempFullVersionListArray.SetDictionary(0, TempFullVersionDict);
TempMetadataDict.SetList('brands', TempBrandsArray);
TempMetadataDict.SetList('fullVersionList', TempFullVersionListArray);
TempMetadataDict.SetString('platform', 'Android'); //or Windows
TempMetadataDict.SetString('platformVersion', '12');
TempMetadataDict.SetString('architecture', 'arm');
TempMetadataDict.SetString('model', 'SM-F916N');
TempMetadataDict.SetBool('mobile', true);
TempMetadataDict.SetString('bitness', '32');
TempParams.SetString('userAgent', UserAgentCb.Text);
// Setting the userAgentMetadata value is optional and can be omited.
// All the values in TempMetadataDict are just an example and they should be customized for each use case.
TempParams.SetDictionary('userAgentMetadata', TempMetadataDict);
FPendingMsgID := DEVTOOLS_SETUSERAGENTOVERRIDE_MSGID;
Chromium1.ExecuteDevToolsMethod(0, 'Emulation.setUserAgentOverride', TempParams);

2
update_CEF4Delphi.json
View File

@ -2,7 +2,7 @@
"UpdateLazPackages" : [
{
"ForceNotify" : true,
"InternalVersion" : 582,
"InternalVersion" : 583,
"Name" : "cef4delphi_lazarus.lpk",
"Version" : "123.0.13"
}