Обойти самозаверяющие сертификаты в веб-браузере с помощью IHTTPSecurity - PullRequest
Новая
       10

Обойти самозаверяющие сертификаты в веб-браузере с помощью IHTTPSecurity

0 голосов
/ 05 октября 2018

Я исследовал все, что мог, для реализации интерфейса IHTTPSECURITY с Delphi TWebBrowser.Я пытаюсь перейти на сайт через https.На сайте есть самоподписанный сертификат.Я хочу, чтобы предупреждения о безопасности не появлялись и не появлялись в браузере.

Если я переключаю режим silent в значение true для браузера, диалоговое окно безопасности больше не появляется, но браузер автоматически выбирает «Нет» какответ на вопрос «Вы хотите продолжить»?Я нашел код для реализации этого для EmbeddedWB ( why-doesnt-queryservice-get-call-for-ihttpsecurity-when-using-tembeddedwb ).Я пытался реализовать это для TWebBrowser, но функция onSecurityProblem не срабатывает.Мой код ниже: 

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.OleCtrls, Vcl.StdCtrls, SHDocVw, ActiveX, Winapi.Urlmon, Winapi.WinInet;

  type TWebBrowser = class(SHDocVw.TWebBrowser, IHTTPSecurity, IWindowForBindingUI)
  private
    function GetWindow(const guidReason: TGUID; out hwnd): HRESULT; stdcall;
    function OnSecurityProblem(dwProblem: Cardinal): HRESULT; stdcall;
  end;


type
  TForm1 = class(TForm)
    WebBrowser1: TWebBrowser;
    Button1: TButton;
    Edit1: TEdit;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses System.NetEncoding;

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
  var
    Flags, TargetFrameName, PostData, headers, url:OleVariant;
    authenticate:string;
begin
  webBrowser1.Navigate('about:blank');
  Flags := '1';
  TargetFrameName := '';
  PostData := '';

  Authenticate := TNetEncoding.Base64.Encode('MediaUser:test');
  Headers:='Authorization: Basic '+Authenticate;
  webBrowser1.Navigate(Edit1.text, flags, TargetFrameName, PostData, headers);
end;

function TWebBrowser.GetWindow(const guidReason: TGUID;
  out hwnd): HRESULT;
begin
  Result := S_FALSE;
end;


function TWebBrowser.OnSecurityProblem(dwProblem: Cardinal): HRESULT;
begin
  if (dwProblem = ERROR_INTERNET_INVALID_CA) or
     (dwProblem = ERROR_INTERNET_SEC_CERT_CN_INVALID)
    then Result := S_OK
    else Result := E_ABORT;
end;

end.

Что я делаю не так?

В качестве дополнительной проблемы, когда завершается работа вышеуказанного приложения, я получаю неопределенный EoleException.

...