Amigos, é Urgente.

Preciso Autenticar comunicação para webservice(soap) via capicom.dll
achei exemplos em sites internacionais. mas não consigo implementar a
rotina.

Aqui vai:

unit main;

(*
Example Delphi SOAP using client side certificates.

According to MSDN you'll need at least IE 5.5.

JwaWinCrypt taken from: http://members.chello.nl/m.vanbrakel2/

CAPICOM_TLB import unit from CAPICOM.DLL. Download from:

http://www.microsoft.com/downloads/details.aspx?FamilyID=860ee43a-a843-4
62f-abb5-ff88ea5896f6&DisplayLang=en

Author: Martijn Brinkers
*)

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls,
Forms,
Dialogs, StdCtrls, SignCertificate (* my soap service wrapper, use
your own *),
SOAPHTTPClient, SOAPHTTPTrans, WinINet, CAPICOM_TLB, JwaWinCrypt;

type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }

procedure OnBeforePost(const HTTPReqResp: THTTPReqResp; Data:
Pointer);
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

const INTERNET_OPTION_CLIENT_CERT_CONTEXT = 84;

procedure TForm1.Button1Click(Sender: TObject);
var
CA : RemoteCA;
Rio : THTTPRIO;
begin
(* create our own THTTPRIO so we can set the OnBeforePost event
handler *)
Rio := THTTPRIO.Create( Nil );
Rio.HTTPWebNode.OnBeforePost := OnBeforePost;

(* get some instance of the SOAP wrapper. Use your own generated one
*)
CA := GetRemoteCA( False,
'https://localhost:8005/secure/signcertificate', Rio );

(* call some soap function *)
ShowMessage( CA.ping );
end;

procedure TForm1.OnBeforePost(const HTTPReqResp: THTTPReqResp; Data:
Pointer);
var
Store : IStore;
Certs : ICertificates;
Cert : ICertificate2;
CertContext : ICertContext;
PCertContext : PCCERT_CONTEXT;
V : OleVariant;
begin
(*
thumbprint of the certificate to use. Look at CAPICOM docs to see
how to find certs using other Id's
*)
V := '07C1E1CA997417E1CFF235FDD39C3093B7A827D2';

(* create Certificate store object *)
Store := CoStore.Create;

(* open the My Store containing certs with private keys *)
Store.Open( CAPICOM_CURRENT_USER_STORE, 'MY',
CAPICOM_STORE_OPEN_MAXIMUM_ALLOWED );

(* find the certificate with the given thumbprint *)
Certs := Store.Certificates.Find( CAPICOM_CERTIFICATE_FIND_SHA1_HASH,
V, False );

(* any certificates found? *)
if Certs.Count > 0 then
begin
(* get the certificate context *)
Cert := IInterface( Certs.Item[ 1 ] ) as ICertificate2;
CertContext := Cert as ICertContext;
CertContext.Get_CertContext( Integer( PCertContext ) );

(* set the certificate to use for the SSL connection *)
if InternetSetOption( Data, INTERNET_OPTION_CLIENT_CERT_CONTEXT,
PCertContext, Sizeof( CERT_CONTEXT ) ) = False then
begin
ShowMessage( 'Something went wrong' );
end;
end;
end;

Responder a