Delphi HTTPRIO：有什么方法可以禁用证书提示？

Question

我正在使用带有 WSDLImporter 的 HTTPRIO 与需要证书的 Web 服务进行通信。我需要做的是编写一个 XML，用证书对其进行签名，然后使用相同的证书将其发送到 web 服务以验证 web 服务。我正在从 Windows 商店获取证书并签署我的证书，并且我能够通过 HTTPRIO 正确发送它。但是当我调用 Web 服务时，它会显示一个窗口，其中包含来自 Windows 存储的所有证书，因此我可以选择要对 Web 服务进行身份验证的那个。

这很好，但我需要它是相同的证书。因此，如我所见，我要么必须在此窗口中选择证书后对 XML 进行签名（AFAIK 不可能，因为我必须将已签名的 XML 作为参数发送给 WS 方法），要么我有禁用此证书提示并在 HTTPRIO 中手动设置证书，如果我知道该怎么做就可以了。我已经尝试在 HTTPRIO 的 onBeforePost 中手动设置证书，希望它会自动禁用证书提示（使用 InternetSetOption）但它仍然显示提示，我不确定这是否确实设置了证书。

有没有办法禁用这个提示？我应该用另一种方式解决这个问题吗？

Answer 1

我使用 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;

Answer 2

所以我终于找到了方法。请注意，我必须更改 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 之后执行。