delphi - 无法使用 Delphi TWebBrowser 加载站点
问题描述
我正在尝试将站点加载到 delphi TwebBrowser 中。
我正在使用 10.3 Rio。
当我使用:
procedure TForm1.FormCreate(Sender: TObject);
var sURL:string;
begin
sURL:='https://web.whatsapp.com/';
WebBrowser1.Navigate(sURL);
end;
我无法加载该站点,并且在浏览器上收到下一条消息:“浏览器不兼容消息”并说要使用 Chrome、FireFox 或 Opera。
有什么办法可以解决吗?
TMyWebBrowser = 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;
TForm1 = class(TForm)
procedure FormShow(Sender: TObject);
procedure WebBrowser1DocumentComplete(ASender: TObject;
const pDisp: IDispatch; const URL: OleVariant);
procedure FormCreate(Sender: TObject);
private
WebBrowser1:TMyWebBrowser
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
WebBrowser1:=TMyWebBrowser.Create(self);
with WebBrowser1 do begin
Align := alClient;
TabOrder := 0;
OnDocumentComplete := WebBrowser1DocumentComplete;
TWinControl(WebBrowser1).Parent := Self;
end;
WebBrowser1.HandleNeeded;
end;
procedure TForm1.FormShow(Sender: TObject);
var ua,sUrl:string;
begin
ua:='Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/79.0.3945.88 Safari/537.36';
WebBrowser1.UserAgent:=ua;
sUrl := 'https://web.whatsapp.com/';
WebBrowser1.Navigate(sUrl);
end;
constructor TMyWebBrowser.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Silent := true; //don't show JS errors
FUserAgent:='';
end;
function TMyWebBrowser.Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HRESULT;
begin
if (FUserAgent <> '') and (Flags and DISPATCH_PROPERTYGET <> 0) and Assigned(VarResult) and (DispId=DISPID_AMBIENT_USERAGENT) then
begin
POleVariant(VarResult)^:= FUserAgent+#13#10;
Result := S_OK;
end
else
Result := inherited Invoke(DispID, IID, LocaleID, Flags, Params, VarResult, ExcepInfo, ArgErr);
end;
procedure TMyWebBrowser.SetUserAgent(const Value: string);
var
Control: IOleControl;
begin
FUserAgent := Value;
if DefaultInterface.QueryInterface(IOleControl, Control) = 0 then
Control.OnAmbientPropertyChange(DISPID_AMBIENT_USERAGENT);
end;
解决方案
推荐阅读
- apache-spark-sql - 使用 Spark SQL 将 yyyy-MM-dd HH:mm:ss:SSS 格式的日期转换为一天的开始
- javascript - 如何用另一个对象删除内部对象的键
- javascript - 扩展不正确的 Typescript 类定义
- typescript - 来自 PHP 编码器的类映射和 PSR-4 的打字稿中的命名空间
- ios - 调整自定义导航返回按钮的位置
- zend-framework3 - zf3骨架应用程序在更改应用程序模块的module.config.php时不起作用
- python-3.x - pathlib mkdir 按文件名创建文件夹
- javascript - 使用 javascript 应用 CSS 规则
- xcode - 存档的 macOS 应用程序以空白窗口启动
- qt - QDir::SortFlag 成员在 QML 中可用