Delphi 修改TWebBrowser的UA (User Agent)

转,原文是wordpress网上的不能打开,所以转帖一下。

 https://theroadtodelphi.wordpress.com/2011/03/11/changing-the-ua-user-agent-of-a-twebbrowser-component/

The user agent strings identify what a user is using to access a web resource. some websites may deliver (slightly) different content depending upon what browser is being used. For example, if you use a iPhone user agent to browse to a WordPress site like https://theroadtodelphi.wordpress.com the result will see something like this :

As you can see the content is designed to fit with a mobile device. in this post I will show how you can change the user agent of a TWebBrowser component.

to change the UA of TWebBrowser you must call the OnAmbientPropertyChange event of the IOleControl interface with theDISPID_AMBIENT_USERAGENT flag and in the implementation of the Invoke function for the IDispatch interface set the value for the New User Agent String.

check the next source code using a interposer class of the TWebBrowser which declare a new property called UserAgent in the component.

const
  DISPID_AMBIENT_USERAGENT = -5513;
 
type
  TWebBrowser =class(SHDocVw.TWebbrowser, IDispatch)
  private
    FUserAgent:string;
    procedureSetUserAgent (constValue:string);
    functionInvoke(DispID:Integer;constIID: TGUID; LocaleID:Integer; Flags:Word;varParams; VarResult, ExcepInfo, ArgErr:Pointer): HRESULT; stdcall;
  public
    propertyUserAgent:stringread FUserAgentwriteSetUserAgent;
    constructorCreate(AOwner: TComponent); override;
  end;

and the implementation

constructorTWebBrowser.Create(AOwner: TComponent);
begin
  inheritedCreate(AOwner);
  FUserAgent:='';
end;
 
functionTWebBrowser.Invoke(DispID:Integer;constIID: TGUID; LocaleID:Integer; Flags:Word;varParams; VarResult, ExcepInfo, ArgErr:Pointer): HRESULT;
begin
  //check if the DISPID_AMBIENT_USERAGENT flag is being processed and if the User Agent to set is not empty
  if(FUserAgent <>'')and(FlagsandDISPATCH_PROPERTYGET <>0)andAssigned(VarResult)and(DispId=DISPID_AMBIENT_USERAGENT)then
  begin
    //set the user agent
    POleVariant(VarResult)^:= FUserAgent+#13#10;
    Result := S_OK;//return S_OK
  end
  else
  Result :=inheritedInvoke(DispID, IID, LocaleID, Flags, Params, VarResult, ExcepInfo, ArgErr);//call the default Invoke method
end;
 
procedureTWebBrowser.SetUserAgent(constValue:string);
var
  Control: IOleControl;
begin
  FUserAgent := Value;
  //the current interface supports IOleControl?
  ifDefaultInterface.QueryInterface(IOleControl, Control) =0then
    Control.OnAmbientPropertyChange(DISPID_AMBIENT_USERAGENT);//call the OnAmbientPropertyChange event
end;

Now to use the above code your only need to add a TWebBrowser component to your form, then add the declaration of the New TWebBrowser class to begin of your unit and finally you must add the implementation of the methods show in this article.

Now to set the new user agent, you only must set the UserAgent property.

WebBrowser1.UserAgent:=’Mozilla/5.0 (iPhone; U; CPU like Mac OS X; en) AppleWebKit/420+ (KHTML, like Gecko) Version/3.0 Mobile/1A543a Safari/419.3′;
WebBrowser1.Navigate(EditURL.Text);

check the screen-shots for the demo application

For more info about User Agent strings check these links

Understanding User-Agent Strings

RFC 1945 – 10.15 User-Agent

——————————————————————————————————————————————

查看源码 点击 Github.


本地下载源码: Changing the UA (User Agent) of a TWebBrowser component

发表评论