Discussion :

[Rinduc]

Bonjour,

Après de nombreuses recherches dans Delphi et sur le net, impossible de trouver une réponse à la question suivante :

J'utilise le composant THTTPRIO pour accéder à un Webservice nécessitant un certificat.

Mon problème est le suivant, à chaque démarrage, j'ai la sécurité Windows qui vient me demandant de confirmer qu'il s'agit du bon certificat.

Est-il possible de désactiver cette demande par Delphi ou directement sur Windows ?

Je vous remercie d'avance de votre aide.

[Rinduc]

Bonjour,

Après de nombreuses heures de recherches, voici ma solution :

Les liens suivants m'ont grandement aidés :

http://stackoverflow.com/questions/3...ificate-prompt
http://www.portugal-a-programar.pt/t...ion-error-122/ --> M'a permis de corriger et mettre la valeur Sizeof(CertContext)*5

Lien pour Capicom_tlb.pas : https://github.com/cesarjr/ACBr/blob...APICOM_TLB.pas
Lien pour Capicom installation : http://164.100.181.16/SSDGSAP/RegisterDLL.htm

//Code dans ma fiche

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, CheckSedexWebService1,
  Soap.InvokeRegistry, Soap.Rio, Soap.SOAPHTTPClient,
  comobj, WinInet, capicom_tlb, Soap.SOAPHTTPTrans;
 
 
class procedure TForm1.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(nil);
  store.Open(CAPICOM_CURRENT_USER_STORE, 'MY', CAPICOM_STORE_OPEN_READ_ONLY);
  certs := TCertificates.create(nil);
  certs.ConnectTo(store.Certificates as ICertificates2);
  cert := TCertificate.create(nil);
 
  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 not(InternetSetOption(request, INTERNET_OPTION_CLIENT_CERT_CONTEXT, PCertContext, Sizeof(CertContext) * 5)) then raise Exception.create('Erreur lors de l''attribution du certificat: ' + inttostr(GetLastError));
 
      Break;
    end;
  end;
 
  store.Close;
 
  certs.Free;
  store.Free;
end;

//Triche en modifiant les sources Delphi qui ont été copiées dans le projet :
-CompVer.inc
-Soap.SOAPHTTPClient.pas
-Soap.UDDIHelper.pas
-Soap.SOAPHTTPTrans.pas

Puis la modification a été effectuée de la manière suivante :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
//  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;

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
//La fonction CallInternetErrorDlg est trichée pour être compatible avec certificat
 function CallInternetErrorDlg: DWord;
  var
    P: Pointer;
  begin
    if LastError = ERROR_INTERNET_CLIENT_AUTH_CERT_NEEDED then begin
 
      tform1.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;

[ShaiLeTroll]

Ton approche par L'activeX système Capicom est très intéressant

Quelle version a-tu de Delphi ?
En lisant le code, semble que la directive CLIENT_CERTIFICATE_SUPPORT conditionne un code très similaire dans THTTPReqRespHelper.HandleWinInetErrorEx


Faudrait essayer sans modifier le code en gérant OnWinInetError

HTTPRIO1.HTTPWebNode.OnWinInetError := ...

if HTTPRIO1.Supports(IClientCertInfo) then

Une fois en D7, j'ai été obligé d'intégrer au projet une version modifié de SaopTrans, semble que tu as une version plus récente mais toujours autant de problème


Lorsque j'ai du faire un connection avec un Certificat HTTPS, je l'ai fait via Indy TIdHTTP et non THTTPRIO
Sur un webservice REST et non SOAP

utilise un TIdHTTP et TIdConnectionInterceptOpenSSL.SSLOptions.CertFile
C'est ce que j'ai dans mon BCB6

Certificat HTTPS avec indy+OpenSSL pour Indy 10 (c'est la 9 en BCB6)

Voir un exemple en Delphi 7 (Indy 9) de TIdSSLIOHandlerSocket