Question

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

这没关系，但我需要它是相同的证书。所以，正如我所看到的，我在这个窗口中选择证书之后必须签署XML（AFAIK不可能，因为我必须将已经签名的XML作为参数发送到WS方法）或者我＆＃ 39; d必须禁用此证书提示并在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;

问题解决了。

我发现一个有趣的事实是，在POSTing之前，HTTPRIO发送一个GET，并在此GET操作中要求提供证书，因此在onBeforePost中设置证书是没有用的，因为它在此GET之后执行。

Delphi HTTPRIO：禁用证书提示的任何方法吗？

2 个答案: