Muitas vezes precisamos saber a validade de um certificado digital,
o modo mais comum é instalar o mesmo e utilizar as funções da capicom.dll.
Há casos porém, que não podemos instalar o certificado, ou, que não
podemos fazer uso da capicom.dll.
Para resolver este problema, podemos ler a data de validade diretamente do
certificado através da OpenSSL.
A função em si é complexa, mas o seu uso é muito simples.
Seu uso é aplicado somente para certificados do tipo A1.
Para utilizar a função é necessário também que o arquivo openssl.exe
esteja junto com o seu executável.
Você pode baixar da internet pelo site http://indy.fulgan.com/SSL/,
ou se você utilizar o ACBr, eles disponibilizam este exe junto com os
demais arquivos.
É necessário estar de SysUtils, ShellAPI e Windows na seção uses,
em versões unicode declare System.SysUtils, Winapi.ShellAPI e Winapi.Windows.
Abaixo segue o código fonte da função:
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 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 | function ValidadeCertificado(wCertificado, wSenha: string): string; function Months(wM: string): string; begin wM := UpperCase(wM); if wM = 'JAN' then Result := '1' else if wM = 'FEB' then Result := '2' else if wM = 'MAR' then Result := '3' else if wM = 'APR' then Result := '4' else if wM = 'MAY' then Result := '5' else if wM = 'JUN' then Result := '6' else if wM = 'JUL' then Result := '7' else if wM = 'AUG' then Result := '8' else if wM = 'SEP' then Result := '9' else if wM = 'OCT' then Result := '10' else if wM = 'NOV' then Result := '11' else if wM = 'DEC' then Result := '12'; end; procedure Delay(msecs: Integer); var FirstTickCount: longint; begin FirstTickCount := GetTickCount; repeat Application.ProcessMessages; until ((GetTickCount - FirstTickCount) >= longint(msecs)); end; var strFile: TextFile; strLine: String; wPos: Integer; wDiretorio_Padrao: string; wComando: string; cExe, cArq1, cArq2: string; begin Result := ''; try // diretorio padrao wDiretorio_Padrao := ExtractFilePath(Application.ExeName); cExe := '"' + wDiretorio_Padrao + 'openssl.exe"'; // cópia arquivo PFX CopyFile(PChar(wCertificado), PChar(wDiretorio_Padrao + 'certificado.pfx'), true); cArq1 := '"' + wDiretorio_Padrao + 'certificado.pfx "'; cArq2 := '"' + wDiretorio_Padrao + 'certificado.pem "'; wComando := ' pkcs12 -in ' + cArq1 + ' -out ' + cArq2 + ' -nokeys -passin pass:' + wSenha; ShellExecute(Application.Handle, NIL, PChar(cExe), PChar(wComando), nil, 0); // para dar tempo do arquivo ficar disponivel para uso Delay(150); cArq1 := '"' + wDiretorio_Padrao + 'certificado.pem "'; cArq2 := '"' + wDiretorio_Padrao + 'validade.txt "'; wComando := ' x509 -enddate -in ' + cArq1 + ' -text -out ' + cArq2; ShellExecute(Application.Handle, NIL, PChar(cExe), PChar(wComando), nil, 0); // para dar tempo do arquivo ficar disponivel para uso Delay(150); // Lê arquivo if FileExists(wDiretorio_Padrao + 'validade.txt') then begin AssignFile(strFile, wDiretorio_Padrao + 'validade.txt'); Reset(strFile); while not EOF(strFile) do begin Readln(strFile, strLine); wPos := Pos('NOT AFTER :', UpperCase(strLine)); if (wPos <> 0) then begin Result := trim(copy(strLine, wPos + 11, 25)); Break; end; end; CloseFile(strFile); // identica data corretamente dd/mm/aaaa Result := DateToStr(StrToDate(Copy(Result, 5, 2) + '/' + Months(Copy(Result, 1, 3)) + '/' + Copy(Result, 17, 4))); end except end; // apaga arquivos criados if FileExists(wDiretorio_Padrao + 'validade.txt') then DeleteFile(wDiretorio_Padrao + 'validade.txt'); if FileExists(wDiretorio_Padrao + 'certificado.pem') then DeleteFile(wDiretorio_Padrao + 'certificado.pem'); if FileExists(wDiretorio_Padrao + 'certificado.pfx') then DeleteFile(wDiretorio_Padrao + 'certificado.pfx'); end; |
Para utilizar a função, basta chamar ela passando o caminho
do certificado digital e a senha do mesmo.
Exemplo de uso:
1 2 3 4 5 6 | procedure TForm1.Button1Click(Sender: TObject); begin ShowMessage( ValidadeCertificado('D:\certificados\meu_certificado.pfx', 'senha certificado')); end; |
