Club Delphi  
    Paypal   FTP   CCD     Buscar   Trucos   Trabajo   Foros

Retroceder   Foros Club Delphi > Proyecto SIF/Veri*Factu/Ley Antifraude > SDK Componente Verifactu para Delphi 7+ - Subforo Avisos/consultas
Registrarse FAQ Miembros Calendario Guía de estilo Temas de Hoy

 
 
Herramientas Buscar en Tema Desplegado
  #3  
Antiguo 25-11-2025
Avatar de ramherfer
ramherfer ramherfer is offline
Miembro
 
Registrado: may 2013
Ubicación: Valencia
Posts: 162
Poder: 14
ramherfer Va por buen camino
Yo utilizo esta función que me devuelve los días que faltan hasta la caducidad y si son 60 o menos envía mensaje al usuario cada vez que entra en la app.

Código Delphi [-]
function VerificarCaducidadCertificadoDesdePFX(const ArchivoPFX, Pwd: string; out DiasHastaCaducidad: Integer; out ErrorCode: Integer): Boolean;
var
  CertStore: HCERTSTORE;
  CertContext: PCERT_CONTEXT;
  PFXFile: TMemoryStream;
  PFXBlob: CRYPT_DATA_BLOB;
  ExpFT: FILETIME;
  SysTime: TSystemTime;
  ExpirationDate: TDateTime;
begin
  Result := False;
  DiasHastaCaducidad := 0;
  ErrorCode := 0;

  CertStore := nil; CertContext := nil;
  PFXFile := TMemoryStream.Create;
  try
    try
      PFXFile.LoadFromFile(ArchivoPFX);
      if PFXFile.Size = 0 then begin ErrorCode := 1001; Exit; end; // PFX vacío

      PFXBlob.cbData := PFXFile.Size;
      GetMem(PFXBlob.pbData, PFXBlob.cbData);
      try
        PFXFile.Position := 0;
        PFXFile.ReadBuffer(PFXBlob.pbData^, PFXBlob.cbData);

        CertStore := PFXImportCertStore(PFXBlob, PWideChar(WideString(Pwd)), 0);
        if CertStore = nil then begin
          ErrorCode := GetLastError;  // 86 = contraseña inválida
          Exit;
        end;

        CertContext := CertFindCertificateInStore(
          CertStore, X509_ASN_ENCODING or PKCS_7_ASN_ENCODING,
          0, CERT_FIND_ANY, nil, nil);
        if CertContext = nil then begin ErrorCode := 1002; Exit; end; // sin cert

        ExpFT := CertContext^.pCertInfo^.NotAfter;
        if not FileTimeToSystemTime(ExpFT, SysTime) then begin ErrorCode := 1003; Exit; end;

        ExpirationDate := SystemTimeToDateTime(SysTime);
        DiasHastaCaducidad := Trunc(ExpirationDate - Now); // puede ser negativo
        NotAfter := ExpirationDate;
        Result := True;
      finally
        if Assigned(PFXBlob.pbData) then FreeMem(PFXBlob.pbData);
      end;
    except
      on E: Exception do begin
        ErrorCode := 1999; // error no esperado
        Result := False;
      end;
    end;
  finally
    if CertContext <> nil then CertFreeCertificateContext(CertContext);
    if CertStore   <> nil then CertCloseStore(CertStore, 0);
    PFXFile.Free;
  end;
end;

Tenemos la ruta del fichero de certificado p12/pfx y la contraseña del mismo.

Si el usuario utiliza un certificado instalado en el sistema tenemos la siguiente función que tambien devuelve los días hasta la caducidad:

Código Delphi [-]
function VerificarCaducidadCertificado: Boolean;


    function ExtraerCN(const SubjectName: string): string;

    var
      PosCN, PosFin: Integer;
    begin
      Result := '';
      PosCN := Pos('CN=', SubjectName);
      if PosCN > 0 then
      begin
        PosCN := PosCN + 3; // Saltar "CN="
        PosFin := Pos(',', Copy(SubjectName, PosCN, Length(SubjectName))); // Buscar la siguiente coma
        if PosFin > 0 then
          Result := Copy(SubjectName, PosCN, PosFin - 1)
        else
          Result := Copy(SubjectName, PosCN, Length(SubjectName)); // Si no hay coma, tomar todo hasta el final
      end;
    end;


const
  CAPICOM_CURRENT_USER_STORE = 2;
  CAPICOM_MY_STORE = 'My';
var
  Store, Certs, Cert: OleVariant;
  i: Integer;
  CertName, CNExtraido: string;
begin
  Result := False;

  // Crear el objeto de almacén de certificados
  Store := CreateOleObject('CAPICOM.Store');
  Store.Open(CAPICOM_CURRENT_USER_STORE, CAPICOM_MY_STORE, 0); // Abre "Personal"

  // Obtener la colección de certificados en el almacén
  Certs := Store.Certificates;

  if Certs.Count > 0 then
  begin
    // Recorrer los certificados para buscar el que coincida con el nombre almacenado en sVFVerifactu
    for i := 1 to Certs.Count do
    begin
      Cert := Certs.Item[i];
      CertName := Cert.SubjectName;
      CNExtraido := ExtraerCN(CertName); // Extraemos solo el CN

      // Comparar con sVFCertificado
      if CNExtraido = sVFCertificado then
      begin
        // Intentamos obtener la fecha de expiración
        try
          NotAfter := VarToDateTime(Cert.ValidToDate); // Se usa ValidToDate en lugar de ExpirationDate
          DiasHastaCaducidad := DaysBetween(Now, NotAfter);

          // Si quedan menos de 60 días, devolver True
          Result := DiasHastaCaducidad <= 60;
          Exit;
        except
          ShowMessage('Error obteniendo la fecha de caducidad del certificado.');
          Result := False;
          Exit;
        end;
      end;

    end; // Final del for

  end;

  ShowMessage('NO SE ENCUENTRA EL CERTIFICADO EN EL ALMACÉN DE CERTIFICADOS');
end;

Compañero, espero te sirva alguna.
Un saludo,
Ramiro
__________________
Se humilde para admitir tus errores, inteligente para aprender de ellos y maduro para corregirlos.
Responder Con Cita
 



Normas de Publicación
no Puedes crear nuevos temas
no Puedes responder a temas
no Puedes adjuntar archivos
no Puedes editar tus mensajes

El código vB está habilitado
Las caritas están habilitado
Código [IMG] está habilitado
Código HTML está deshabilitado
Saltar a Foro

Temas Similares
Tema Autor Foro Respuestas Último mensaje
Error al obtener certificado de disco 5.2 seccion_31 SDK Componente Verifactu para Delphi 7+ - Subforo Errores 0 08-09-2025 07:54:45
Como chequear la fecha de caducidad de mi aplicacion JoAnCa Varios 2 11-03-2009 14:52:17
obtener solo la fecha en formato fecha y sin hora BlueSteel SQL 14 09-05-2008 16:42:19
FTP con SSL, Obtener el certificado mercury2005 Internet 0 27-12-2006 08:48:42


La franja horaria es GMT +2. Ahora son las 13:18:06.


Powered by vBulletin® Version 3.6.8
Copyright ©2000 - 2026, Jelsoft Enterprises Ltd.
Traducción al castellano por el equipo de moderadores del Club Delphi
Copyright 1996-2007 Club Delphi