How to change the User Agent string in DCEF3 - delphi

Question

I've been looking to change the User Agent string in the Delphi Chromium Embedded Framework, but can"t seem to find a way.
Having looked through ceflib.pas, I see that it can be set, but there is no obvious call that I can make, such as:
Chromium.SetUserAgent('string');
or:
Chromium.Browser.useragent = 'string';
(Note: I am battling to interface with this component - at least to it's full potential - as there seems to be no decent documentation, if any.)

Answer 1

dont use the TChromium component, instead create your client at run time, and use the cefloadlib to customize it, see this example:
CefLoadLib('','this_is_my_user_agent','','','','',LOGSEVERITY_DISABLE,ANGLE_IN_PROCESS,0,0);
a full sample program can be found in **dcef-r306\dcef\demos\cefclient**
this is the full code of the sample program with a customized user agent(search for stackoverflow and you will find the changed code it):
{$IFDEF FPC}
{$MODE DELPHI}{$H+}
{$APPTYPE GUI}
{$ENDIF}
{$I cef.inc}
program cefclient;
uses
Classes,
Windows,
Messages,
SysUtils,
ceflib,
ceffilescheme in '..\filescheme\ceffilescheme.pas';
type
TCustomClient = class(TCefClientOwn)
private
FLifeSpan: ICefBase;
FLoad: ICefBase;
FDisplay: ICefBase;
protected
function GetLifeSpanHandler: ICefBase; override;
function GetLoadHandler: ICefBase; override;
function GetDisplayHandler: ICefBase; override;
public
constructor Create; override;
end;
TCustomLifeSpan = class(TCefLifeSpanHandlerOwn)
protected
procedure OnAfterCreated(const browser: ICefBrowser); override;
end;
TCustomLoad = class(TCefLoadHandlerOwn)
protected
procedure OnLoadStart(const browser: ICefBrowser; const frame: ICefFrame); override;
procedure OnLoadEnd(const browser: ICefBrowser; const frame: ICefFrame;
httpStatusCode: Integer); override;
end;
TCustomDisplay = class(TCefDisplayHandlerOwn)
protected
procedure OnAddressChange(const browser: ICefBrowser;
const frame: ICefFrame; const url: ustring); override;
procedure OnTitleChange(const browser: ICefBrowser; const title: ustring); override;
end;
TScheme = class(TCefSchemeHandlerOwn)
private
FResponse: TMemoryStream;
procedure Output(const str: ustring);
protected
function ProcessRequest(const Request: ICefRequest; var redirectUrl: ustring;
const callback: ICefSchemeHandlerCallback): Boolean; override;
procedure GetResponseHeaders(const response: ICefResponse; var responseLength: Int64); override;
function ReadResponse(DataOut: Pointer; BytesToRead: Integer;
var BytesRead: Integer; const callback: ICefSchemeHandlerCallback): Boolean; override;
public
constructor Create(SyncMainThread: Boolean;
const scheme: ustring; const browser: ICefBrowser; const request: ICefRequest); override;
destructor Destroy; override;
end;
TExtension = class(TCefv8HandlerOwn)
private
FTestParam: ustring;
protected
function Execute(const name: ustring; const obj: ICefv8Value;
const arguments: TCefv8ValueArray; var retval: ICefv8Value;
var exception: ustring): Boolean; override;
end;
type
{$IFDEF FPC}
TWindowProc = LongInt;
{$ELSE}
TWindowProc = Pointer;
WNDPROC = Pointer;
{$ENDIF}
var
Window : HWND;
handl: ICefBase = nil;
brows: ICefBrowser = nil;
browsrHwnd: HWND = INVALID_HANDLE_VALUE;
navigateto: ustring = 'http://www.google.com';
backWnd, forwardWnd, reloadWnd, stopWnd, editWnd: HWND;
editWndOldProc: TWindowProc;
isLoading, canGoBack, canGoForward: Boolean;
const
MAX_LOADSTRING = 100;
MAX_URL_LENGTH = 255;
BUTTON_WIDTH = 72;
URLBAR_HEIGHT = 24;
IDC_NAV_BACK = 200;
IDC_NAV_FORWARD = 201;
IDC_NAV_RELOAD = 202;
IDC_NAV_STOP = 203;
function CefWndProc(Wnd: HWND; message: UINT; wParam: Integer; lParam: Integer): Integer; stdcall;
var
ps: PAINTSTRUCT;
info: TCefWindowInfo;
rect: TRect;
hdwp: THandle;
x: Integer;
strPtr: array[0..MAX_URL_LENGTH-1] of WideChar;
strLen, urloffset: Integer;
begin
if Wnd = editWnd then
case message of
WM_CHAR:
if (wParam = VK_RETURN) then
begin
// When the user hits the enter key load the URL
FillChar(strPtr, SizeOf(strPtr), 0);
PDWORD(#strPtr)^ := MAX_URL_LENGTH;
strLen := SendMessageW(Wnd, EM_GETLINE, 0, Integer(#strPtr));
if (strLen > 0) then
begin
strPtr[strLen] := #0;
brows.MainFrame.LoadUrl(strPtr);
end;
Result := 0;
end else
Result := CallWindowProc(WNDPROC(editWndOldProc), Wnd, message, wParam, lParam);
else
Result := CallWindowProc(WNDPROC(editWndOldProc), Wnd, message, wParam, lParam);
end else
case message of
WM_PAINT:
begin
BeginPaint(Wnd, ps);
EndPaint(Wnd, ps);
result := 0;
end;
WM_CREATE:
begin
handl := TCustomClient.Create;
x := 0;
GetClientRect(Wnd, rect);
backWnd := CreateWindowW('BUTTON', 'Back',
WS_CHILD or WS_VISIBLE or BS_PUSHBUTTON
or WS_DISABLED, x, 0, BUTTON_WIDTH, URLBAR_HEIGHT,
Wnd, IDC_NAV_BACK, HInstance, nil);
Inc(x, BUTTON_WIDTH);
forwardWnd := CreateWindowW('BUTTON', 'Forward',
WS_CHILD or WS_VISIBLE or BS_PUSHBUTTON
or WS_DISABLED, x, 0, BUTTON_WIDTH,
URLBAR_HEIGHT, Wnd, IDC_NAV_FORWARD,
HInstance, nil);
Inc(x, BUTTON_WIDTH);
reloadWnd := CreateWindowW('BUTTON', 'Reload',
WS_CHILD or WS_VISIBLE or BS_PUSHBUTTON
or WS_DISABLED, x, 0, BUTTON_WIDTH,
URLBAR_HEIGHT, Wnd, IDC_NAV_RELOAD,
HInstance, nil);
Inc(x, BUTTON_WIDTH);
stopWnd := CreateWindowW('BUTTON', 'Stop',
WS_CHILD or WS_VISIBLE or BS_PUSHBUTTON
or WS_DISABLED, x, 0, BUTTON_WIDTH, URLBAR_HEIGHT,
Wnd, IDC_NAV_STOP, HInstance, nil);
Inc(x, BUTTON_WIDTH);
editWnd := CreateWindowW('EDIT', nil,
WS_CHILD or WS_VISIBLE or WS_BORDER or ES_LEFT or
ES_AUTOVSCROLL or ES_AUTOHSCROLL or WS_DISABLED,
x, 0, rect.right - BUTTON_WIDTH * 4,
URLBAR_HEIGHT, Wnd, 0, HInstance, nil);
// Assign the edit window's WNDPROC to this function so that we can
// capture the enter key
editWndOldProc := TWindowProc(GetWindowLong(editWnd, GWL_WNDPROC));
SetWindowLong(editWnd, GWL_WNDPROC, LongInt(#CefWndProc));
FillChar(info, SizeOf(info), 0);
Inc(rect.top, URLBAR_HEIGHT);
info.Style := WS_CHILD or WS_VISIBLE or WS_CLIPCHILDREN or WS_CLIPSIBLINGS or WS_TABSTOP;
info.WndParent := Wnd;
info.x := rect.left;
info.y := rect.top;
info.Width := rect.right - rect.left;
info.Height := rect.bottom - rect.top;
CefBrowserCreate(#info, handl.Wrap, navigateto, nil);
isLoading := False;
canGoBack := False;
canGoForward := False;
SetTimer(Wnd, 1, 100, nil);
result := 0;
end;
WM_TIMER:
begin
// Update the status of child windows
EnableWindow(editWnd, True);
EnableWindow(backWnd, canGoBack);
EnableWindow(forwardWnd, canGoForward);
EnableWindow(reloadWnd, not isLoading);
EnableWindow(stopWnd, isLoading);
Result := 0;
end;
WM_COMMAND:
case LOWORD(wParam) of
IDC_NAV_BACK:
begin
brows.GoBack;
Result := 0;
end;
IDC_NAV_FORWARD:
begin
brows.GoForward;
Result := 0;
end;
IDC_NAV_RELOAD:
begin
brows.Reload;
Result := 0;
end;
IDC_NAV_STOP:
begin
brows.StopLoad;
Result := 0;
end;
else
result := DefWindowProc(Wnd, message, wParam, lParam);
end;
WM_DESTROY:
begin
brows := nil;
PostQuitMessage(0);
result := 0;
end;
WM_SETFOCUS:
begin
if browsrHwnd <> INVALID_HANDLE_VALUE then
PostMessage(browsrHwnd, WM_SETFOCUS, wParam, 0);
Result := 0;
end;
WM_SIZE:
begin
if(browsrHwnd <> INVALID_HANDLE_VALUE) then
begin
// Resize the browser window and address bar to match the new frame
// window size
GetClientRect(Wnd, rect);
Inc(rect.top, URLBAR_HEIGHT);
urloffset := rect.left + BUTTON_WIDTH * 4;
hdwp := BeginDeferWindowPos(1);
hdwp := DeferWindowPos(hdwp, editWnd, 0, urloffset, 0, rect.right - urloffset, URLBAR_HEIGHT, SWP_NOZORDER);
hdwp := DeferWindowPos(hdwp, browsrHwnd, 0, rect.left, rect.top,
rect.right - rect.left, rect.bottom - rect.top, SWP_NOZORDER);
EndDeferWindowPos(hdwp);
end;
result := DefWindowProc(Wnd, message, wParam, lParam);
end;
WM_CLOSE:
begin
if brows <> nil then
brows.ParentWindowWillClose;
result := DefWindowProc(Wnd, message, wParam, lParam);
end
else
result := DefWindowProc(Wnd, message, wParam, lParam);
end;
end;
{ TCustomClient }
constructor TCustomClient.Create;
begin
inherited;
FLifeSpan := TCustomLifeSpan.Create;
FLoad := TCustomLoad.Create;
FDisplay := TCustomDisplay.Create;
end;
function TCustomClient.GetDisplayHandler: ICefBase;
begin
Result := FDisplay;
end;
function TCustomClient.GetLifeSpanHandler: ICefBase;
begin
Result := FLifeSpan;
end;
function TCustomClient.GetLoadHandler: ICefBase;
begin
Result := FLoad;
end;
{ TCustomLifeSpan }
procedure TCustomLifeSpan.OnAfterCreated(const browser: ICefBrowser);
begin
if not browser.IsPopup then
begin
// get the first browser
brows := browser;
browsrHwnd := brows.GetWindowHandle;
end;
end;
{ TCustomLoad }
procedure TCustomLoad.OnLoadEnd(const browser: ICefBrowser;
const frame: ICefFrame; httpStatusCode: Integer);
begin
if browser.GetWindowHandle = browsrHwnd then
isLoading := False;
end;
procedure TCustomLoad.OnLoadStart(const browser: ICefBrowser;
const frame: ICefFrame);
begin
if browser.GetWindowHandle = browsrHwnd then
begin
isLoading := True;
canGoBack := browser.CanGoBack;
canGoForward := browser.CanGoForward;
end;
end;
{ TCustomDisplay }
procedure TCustomDisplay.OnAddressChange(const browser: ICefBrowser;
const frame: ICefFrame; const url: ustring);
begin
if (browser.GetWindowHandle = browsrHwnd) and frame.IsMain then
SetWindowTextW(editWnd, PWideChar(url));
end;
procedure TCustomDisplay.OnTitleChange(const browser: ICefBrowser;
const title: ustring);
begin
if browser.GetWindowHandle = browsrHwnd then
SetWindowTextW(Window, PWideChar(title));
end;
{ TScheme }
constructor TScheme.Create(SyncMainThread: Boolean;
const scheme: ustring; const browser: ICefBrowser; const request: ICefRequest);
begin
inherited;
FResponse := TMemoryStream.Create;
end;
destructor TScheme.Destroy;
begin
FResponse.Free;
inherited;
end;
function TScheme.ProcessRequest(const Request: ICefRequest; var redirectUrl: ustring;
const callback: ICefSchemeHandlerCallback): Boolean;
begin
OutPut('<html>');
OutPut(' <body>ClientV8ExtensionHandler says:<br><pre>');
OutPut('<script language="javascript">');
OutPut(' cef.test.test_param =''Assign and retrieve a value succeeded the first time.'';');
OutPut(' document.writeln(cef.test.test_param);');
OutPut(' cef.test.test_param = ''Assign and retrieve a value succeeded the second time.'';');
OutPut(' document.writeln(cef.test.test_param);');
OutPut(' var obj = cef.test.test_object();');
OutPut(' document.writeln(obj.param);');
OutPut(' document.writeln(obj.GetMessage());');
OutPut('</script>');
OutPut('</pre></body>');
OutPut('</html>');
FResponse.Seek(0, soFromBeginning);
callback.HeadersAvailable;
callback.BytesAvailable;
Result := True;
end;
procedure TScheme.GetResponseHeaders(const response: ICefResponse;
var responseLength: Int64);
begin
response.Status := 200;
response.StatusText := 'OK';
response.MimeType := 'text/html';
ResponseLength := FResponse.Size;
end;
function TScheme.ReadResponse(DataOut: Pointer; BytesToRead: Integer;
var BytesRead: Integer; const callback: ICefSchemeHandlerCallback): Boolean;
begin
BytesRead := FResponse.Read(DataOut^, BytesToRead);
Result := True;
end;
procedure TScheme.Output(const str: ustring);
var
u: UTF8String;
begin
{$IFDEF UNICODE}
u := UTF8String(str);
{$ELSE}
u := UTF8Encode(str);
{$ENDIF}
FResponse.Write(PAnsiChar(u)^, Length(u));
end;
function TExtension.Execute(const name: ustring; const obj: ICefv8Value;
const arguments: TCefv8ValueArray; var retval: ICefv8Value;
var exception: ustring): Boolean;
begin
if(name = 'SetTestParam') then
begin
// Handle the SetTestParam native function by saving the string argument
// into the local member.
if (Length(arguments) <> 1) or (not arguments[0].IsString) then
begin
Result := false;
Exit;
end;
FTestParam := arguments[0].GetStringValue;
Result := true;
end
else if(name = 'GetTestParam') then
begin
// Handle the GetTestParam native function by returning the local member
// value.
retval := TCefv8ValueRef.CreateString(Ftestparam);
Result := true;
end
else if (name = 'GetTestObject') then
begin
// Handle the GetTestObject native function by creating and returning a
// new V8 object.
retval := TCefv8ValueRef.CreateObject(nil);
// Add a string parameter to the new V8 object.
retval.SetValueByKey('param', TCefv8ValueRef.CreateString(
'Retrieving a parameter on a native object succeeded.'));
// Add a function to the new V8 object.
retval.SetValueByKey('GetMessage',
TCefv8ValueRef.CreateFunction('GetMessage', Self));
Result := true;
end
else if(name = 'GetMessage') then
begin
// Handle the GetMessage object function by returning a string.
retval := TCefv8ValueRef.CreateString(
'Calling a function on a native object succeeded.');
Result := true;
end else
Result := false;
end;
const
code =
'var cef;'+
'if (!cef)'+
' cef = {};'+
'if (!cef.test)'+
' cef.test = {};'+
'(function() {'+
' cef.test.__defineGetter__(''test_param'', function() {'+
' native function GetTestParam();'+
' return GetTestParam();'+
' });'+
' cef.test.__defineSetter__(''test_param'', function(b) {'+
' native function SetTestParam();'+
' if(b) SetTestParam(b);'+
' });'+
' cef.test.test_object = function() {'+
' native function GetTestObject();'+
' return GetTestObject();'+
' };'+
'})();';
var
{$IFDEF CEF_MULTI_THREADED_MESSAGE_LOOP}
Msg : TMsg;
{$ENDIF}
wndClass : TWndClass;
begin
CefCache := 'cache';
CefLoadLib('','stackoverflow','','','','',LOGSEVERITY_DISABLE,ANGLE_IN_PROCESS,0,0);
CefRegisterCustomScheme('client', True, False, False);
CefRegisterCustomScheme('file', True, False, False);
CefRegisterSchemeHandlerFactory('client', 'test', False, TScheme);
CefRegisterSchemeHandlerFactory('file', '', False, TFileScheme);
CefRegisterExtension('v8/test', code, TExtension.Create as ICefV8Handler);
//navigateto := 'client://test/';
//navigateto := 'file://c:\';
try
wndClass.style := CS_HREDRAW or CS_VREDRAW;
wndClass.lpfnWndProc := #CefWndProc;
wndClass.cbClsExtra := 0;
wndClass.cbWndExtra := 0;
wndClass.hInstance := hInstance;
wndClass.hIcon := LoadIcon(0, IDI_APPLICATION);
wndClass.hCursor := LoadCursor(0, IDC_ARROW);
wndClass.hbrBackground := 0;
wndClass.lpszMenuName := nil;
wndClass.lpszClassName := 'chromium';
RegisterClass(wndClass);
Window := CreateWindow(
'chromium', // window class name
'Chromium browser', // window caption
WS_OVERLAPPEDWINDOW or WS_CLIPCHILDREN, // window style
Integer(CW_USEDEFAULT), // initial x position
Integer(CW_USEDEFAULT), // initial y position
Integer(CW_USEDEFAULT), // initial x size
Integer(CW_USEDEFAULT), // initial y size
0, // parent window handle
0, // window menu handle
hInstance, // program instance handle
nil); // creation parameters
ShowWindow(Window, SW_SHOW);
UpdateWindow(Window);
{$IFNDEF CEF_MULTI_THREADED_MESSAGE_LOOP}
CefRunMessageLoop;
{$ELSE}
while(GetMessageW(msg, 0, 0, 0)) do
begin
TranslateMessage(msg);
DispatchMessageW(msg);
end;
{$ENDIF}
finally
handl := nil;
end;
end.
if you still want to use the TChromium Component then you should see this article:
chromiumembedded/issues
they have made a patch for this issue, but i think you need to apply the patch and recompile the lib.
use this link to test the result :
whatismyuseragent

Answer 2

Another way is to define CefUserAgent in ceflib.pas function CefLoadLibDefault: Boolean;
function CefLoadLibDefault: Boolean;
begin
CefUserAgent:='Mozilla/4.0 (compatible; MSIE 7.0; Windows NT 6.0)'; //addition for example
if LibHandle = 0 then
Result := CefLoadLib(CefCache, CefUserAgent, CefProductVersion, CefLocale, CefLogFile,
CefBrowserSubprocessPath, CefLogSeverity,
CefJavaScriptFlags, CefResourcesDirPath, CefLocalesDirPath, CefSingleProcess,
CefCommandLineArgsDisabled, CefPackLoadingDisabled, CefRemoteDebuggingPort,
CefReleaseDCheck, CefUncaughtExceptionStackSize, CefContextSafetyImplementation) else
Result := True;
end;