Ver Mensaje Individual
  #2022  
Antiguo 28-06-2017
richihu richihu is offline
Registrado
NULL
 
Registrado: jun 2014
Posts: 5
Reputación: 0
richihu Va por buen camino
Thumbs up SOS "Error en el soporte del canal seguro"

Hola a todos,

He revisado todos los posts y he probado a cargar un certificado válido con CAPICOM en el OnBeforePost del HTTPRIO pero me sige dando el error, por favro si alguien se le ocurre algo...Gracias!

procedure TfrmMain.HTTPReqResp1BeforePost(const HTTPReqResp: THTTPReqResp; Data: Pointer);
var
FCertificatesList: TInterfaceList;
i, j: Integer;
Store: ICertificates;
Certificate: ICertificate2;

ExtProperty: IExtendedProperty;

PCertContext : PCCERT_CONTEXT;
CertContext : ICertContext;
stAux: String;

CertsUtils: TUtilities;
begin
inherited;


FCertificatesList := TInterfaceList.Create();

//CAPICOM_LOCAL_MACHINE_STORE
Store1.Open(CAPICOM_CURRENT_USER_STORE, 'My', CAPICOM_STORE_OPEN_READ_ONLY); //CAPICOM_STORE_OPEN_MAXIMUM_ALLOWED or CAPICOM_STORE_OPEN_INCLUDE_ARCHIVED or CAPICOM_STORE_OPEN_EXISTING_ONLY

Store := Store1.Certificates;

try
CertsUtils := TUtilities.Create(Self);

for I := 1 to Store1.Certificates.Count do
begin
Certificate := IInterface(Store.Item[i]) as ICertificate2;

Certificate.GetInfo(CAPICOM_CERT_INFO_SUBJECT_SIMPLE_NAME);
// dtcCerts.Values[i-1, 1] := Certificate.GetInfo(CAPICOM_CERT_INFO_ISSUER_SIMPLE_NAME);
// dtcCerts.Values[i-1, 2] := Certificate.ValidToDate;

stAux := '';
for j := 1 to Certificate.ExtendedProperties.Count do
begin
ExtProperty := IInterface(Certificate.ExtendedProperties.Item[j]) as IExtendedProperty;
if ExtProperty.PropID = CAPICOM_PROPID_FRIENDLY_NAME then
begin
stAux := CertsUtils.BinaryStringToByteArray(ExtProperty.Value[CAPICOM_ENCODE_BINARY]);
break;
end;
end;

stAux := Certificate.SerialNumber;

// Cargo certificado válido
if Certificate.SerialNumber = '2C2DBEE53ACFD8965809C4707F55FE28' then
begin
CertContext:= Certificate as ICertContext;
CertContext.Get_CertContext(Integer(PCertContext));

// Por aquí pasa y no devuelve error pero aún así...
if InternetSetOption(Data, INTERNET_OPTION_CLIENT_CERT_CONTEXT, PCertContext, Sizeof(CERT_CONTEXT))= False then
ShowMessage('Error en InternetSetOption');
end;

FCertificatesList.Add(Certificate);
end;

finally
// dtcCerts.EndUpdate();
CertsUtils.Free();
end;
Responder Con Cita