delphi (User Agent) of a TWebBrowser


本文整理自网络,侵删。

 
const
  DISPID_AMBIENT_USERAGENT = -5513;
 
type
  TWebBrowser = class (SHDocVw.TWebbrowser, IDispatch)
  private
    FUserAgent: string;
    procedure SetUserAgent (const Value: string);
    function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HRESULT; stdcall;
  public
    property UserAgent: string read FUserAgent write SetUserAgent;
    constructor Create(AOwner: TComponent); override;
  end;


constructor TWebBrowser.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FUserAgent:='';
end;
 
function TWebBrowser.Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer; Flags: Word; var Params; 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 (Flags and DISPATCH_PROPERTYGET <> 0) and Assigned(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 := inherited Invoke(DispID, IID, LocaleID, Flags, Params, VarResult, ExcepInfo, ArgErr); //call the default Invoke method
end;
 
procedure TWebBrowser.SetUserAgent(const Value: string);
var
  Control: IOleControl;
begin
  FUserAgent := Value;
  //the current interface supports IOleControl?
  if DefaultInterface.QueryInterface(IOleControl, Control) = 0 then
    Control.OnAmbientPropertyChange(DISPID_AMBIENT_USERAGENT); //call the OnAmbientPropertyChange event
end;


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);

相关阅读 >>

Delphi idhttp访问路由里的web

Delphi 设置combobox组合框的高度方法总结

Delphi hmac256

Delphi 缩放图形打印输出

Delphi win32,win64用于单/多线程计数素数的整数性能比较

Delphi form生成时的事件次序

Delphi treeview添加背景图片

Delphi与汇编

winapi 字符及字符串函数(14): chartooem、oemtochar

Delphi 压缩与修复access数据库

更多相关阅读请进入《Delphi》频道 >>



打赏

取消

感谢您的支持,我会继续努力的!

扫码支持
扫码打赏,您说多少就多少

打开支付宝扫一扫,即可进行扫码打赏哦

分享从这里开始,精彩与您同在

评论

管理员已关闭评论功能...