[delphi-br] HTTPrio + certificado

Thu, 14 Jan 2010 11:51:04 -0800 

Boa tarde pessoal;

Estou tendo problemas ao acessar um WebService usando https e certificado.
Já procurei na net e li muito a respeito de um bug no THttpPrio, fiz algumas 
modificações no codigo, mas não resolveu o problema.

Na verdade agora, estou se saber se o problema é o componente (httprio) ou com 
o webservice... (ou outro talvez);

Alguem já passou por isto?

Estou utilizando as seguintes rotinas;

procedure TForm1.Button1Click(Sender: TObject);
var
  sSelo: SeloService;
  igetSelos: getSelos;
  rgetSelos: getSelosResponse;

  igetBancos: getBancos;
  rgetBancos: getBancosResponse;
  iCount: Integer;
begin
  sSelo := GetSeloService(CheckBox1.Checked, '', HTTPRIO1);
  
  {
     Se eu remover este evento funciona para o metodo getBancos mas falha no  
getSelos (pois o mesmo precisa ter um certificado, 
     Error "java.lang.NullPointerException"

     Se eu manter este evento, na chamada de getBancos já é exibido
    Error: "Erro no suporte a canais seguros - URL:......"
     

  }
  HTTPRIO1.HTTPWebNode.OnBeforePost := WebNode1BeforePost;

  if Assigned(sSelo) then
  begin
    igetBancos := getBancos.create;
    rgetBancos := sSelo.getBancos(igetBancos);

    if Assigned(rgetBancos) then
    begin
      Memo1.Lines.Add('');
      Memo1.Lines.Add('rgetBancos');


      for iCount := 0 to rgetBancos.GetbancoArrayLength - 1 do
      begin
        Memo1.Lines.Add(rgetBancos.bancoArray[iCount].nmbanco);
      end;
    end;

    igetSelos := getSelos.create;
    igetSelos.user := 'cartorio';
    igetSelos.pass := 'selodigital';

    rgetSelos := sSelo.getSelos(igetSelos);
    if Assigned(rgetSelos) then
    begin
      Memo1.Lines.Add('');
      Memo1.Lines.Add('rgedselos');
    end;
  end;
end;

procedure TForm1.WebNode1BeforePost(const HTTPReqResp: THTTPReqResp; Data: 
Pointer);
const
  INTERNET_OPTION_CLIENT_CERT_CONTEXT = 84;
var
  Store        : IStore3;
  Certs        : ICertificates2;
  Certs2       : ICertificates2;  
  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 := '57AE756684EE54AC';  
//  V := 'F4879F85224846A6F551E2310A5D8F1575A252AB';
  V := 'B760A85BF9B2A6AE00ED74EBD54AC9966866F55C';


  (* 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 as ICertificates2;
  Certs2 := Certs.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;


Atenc;
Elazar Dornelles Ceza


      
____________________________________________________________________________________
Veja quais são os assuntos do momento no Yahoo! +Buscados
http://br.maisbuscados.yahoo.com

[As partes desta mensagem que não continham texto foram removidas]

Responder a