Невозможно загрузить сайт с Delphi TWebBrowser - PullRequest
Новая
       50

Невозможно загрузить сайт с Delphi TWebBrowser

0 голосов
/ 07 января 2020

Я пытаюсь загрузить сайт в 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;
...