Delphi HTTPRIO:有什么方法可以禁用证书提示?

Delphi HTTPRIO: any way to disable certificate prompt?

我将 HTTPRIO 与 WSDLImporter 结合使用,以与需要证书的 Web 服务进行通信。我需要做的是写一个 XML,用证书签名并使用相同的证书将它发送到 web 服务以验证 web 服务。我正在从 windows 商店获取证书并签署我的证书,我能够通过 HTTPRIO 正确发送它。但是当我调用 web 服务时,它向我显示 window 以及来自 windows 存储的所有证书,因此我可以选择我想要对 web 服务进行身份验证的证书。

这很好,但我需要它是同一个证书。因此,正如我所见,我要么必须在 window 中选择证书后签署 XML (AFAIK 不可能,因为我必须发送已经签署的 XML WS 方法的一个参数),否则我必须禁用此证书提示并在 HTTPRIO 中手动设置证书,如果我知道该怎么做就可以了。我已经尝试在 HTTPRIO 的 onBeforePost 中手动设置证书,希望它会自动禁用证书提示(使用 InternetSetOption)但它仍然显示提示,我不确定这是否确实设置了证书。

有没有办法关闭这个提示?我应该用其他方式解决这个问题吗?

我使用 OnBeforePost 事件解决了类似的问题(因为我也需要客户端 SSL 证书)。

procedure TDataModule1.HTTPRIO1HTTPWebNode1BeforePost(
  const HTTPReqResp: THTTPReqResp; aRequest: Pointer);
var lCertContext: PCCERT_CONTEXT;
begin

  ...
  if not InternetSetOption(Request, INTERNET_OPTION_CLIENT_CERT_CONTEXT, lCertContext, SizeOf(CERT_CONTEXT)) then RaiseLastOSError
  ...

但是在我的例子中,我必须从内存(从数据库)动态加载证书,所以我们现在使用 SecureBlackBox(使用 USE_INDY 和他们的 TElClientIndySSLIOHandlerSocket iohandler 和一个 TElX509Certificate 对象)。

在您的情况下,您需要以某种方式从 Windows 证书存储中获取 CERT_CONTEXT 记录,但您已经拥有了?

顺便说一句:您需要将自己的 HTTPRIO 对象传递给生成的 SOAP 函数,否则会创建一个新的 THTTPRIO 并且不会触发您的 OnBeforePost 事件:

function GetMySOAP(UseWSDL: Boolean; Addr: string; HTTPRIO: THTTPRIO = nil): IMySOAP;

所以我终于找到了办法。请注意,我必须更改 Soap.SOAPHTTPTrans.pas 而您不应更改标准 Delphi 文件。但我做到了,它解决了我的问题。首先,我写了一个函数来设置证书:

class procedure TMyCertificate.setCertificate(request:HINTERNET);
  var
    i: integer;
    store: TStore;
    c:ICertificate2;
    cert: TCertificate;
    certs: TCertificates;
    ov: OleVariant;

    CertContext  : ICertContext;
    PCertContext : PCCERT_CONTEXT;
  begin
    store := TStore.Create(pai);
    store.Open(CAPICOM_CURRENT_USER_STORE, 'My', CAPICOM_STORE_OPEN_READ_ONLY);
    certs := TCertificates.Create(pai);
    certs.ConnectTo(store.Certificates as ICertificates2);
    cert := TCertificate.Create(pai);

    for i := 1 to certs.Count do
    begin
      ov := (certs.Item[i]);
      c := IDispatch(ov) as ICertificate2;
      cert.ConnectTo(IDispatch(ov) as ICertificate2);

      if cert.HasPrivateKey And (cert.ValidFromDate <= Now) And
        (cert.ValidToDate >= Now) then
      begin
       CertContext := c as ICertContext;
       CertContext.Get_CertContext( Integer( PCertContext ) );

        if InternetSetOption( request, INTERNET_OPTION_CLIENT_CERT_CONTEXT,
                      PCertContext, Sizeof( CERT_CONTEXT ) ) = False then
                 ShowMessage( 'Error setting certificate');
        Break;
      end;
    end;

    store.Close;

    certs.Free;
    store.Free;
  end;

代码很难看,只是将证书设置为找到的第一个,但你明白了。这使用 CAPICOM 获取证书。

然后,我在 SOAPHTTPTrans 中找到了以下函数:

  function CallInternetErrorDlg: DWord;
  var
    P: Pointer;
  begin
    Result := InternetErrorDlg(GetDesktopWindow(), Request, LastError,
                               FLAGS_ERROR_UI_FILTER_FOR_ERRORS or
                               FLAGS_ERROR_UI_FLAGS_CHANGE_OPTIONS or
                               FLAGS_ERROR_UI_FLAGS_GENERATE_DATA, P);

    { After selecting client certificate send request again,
      Note: InternetErrorDlg always returns ERROR_SUCCESS when called with
            ERROR_INTERNET_CLIENT_AUTH_CERT_NEEDED }
    if LastError = ERROR_INTERNET_CLIENT_AUTH_CERT_NEEDED then
      Result := ERROR_INTERNET_FORCE_RETRY;
  end;

并将其更改为:

  function CallInternetErrorDlg: DWord;
  var
    P: Pointer;
  begin
    if LastError = ERROR_INTERNET_CLIENT_AUTH_CERT_NEEDED then begin

      TMyCertificate.setCertificate(Request);

      Result := ERROR_INTERNET_FORCE_RETRY;
    end

    else
    Result := InternetErrorDlg(GetDesktopWindow(), Request, LastError,
                               FLAGS_ERROR_UI_FILTER_FOR_ERRORS or
                               FLAGS_ERROR_UI_FLAGS_CHANGE_OPTIONS or
                               FLAGS_ERROR_UI_FLAGS_GENERATE_DATA, P);
  end;

问题已解决。

我发现一个有趣的事实是,在 POST 之前,HTTPRIO 发送一个 GET,它在这个 GET 操作中要求证书,所以在 onBeforePost 中设置证书是没有用的,因为它在这个 GET 之后执行。