nit GetDataSert;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
OpenDialog1: TOpenDialog;
Memo1: TMemo;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
uses
Wcrypt2, XPBase64, Shared;
procedure BinToHexInverted(Buffer, Text: PChar; BufSize: Integer);
const
Convert: Array [0 .. 15] of Char = '0123456789abcdef';
var
ii: Integer;
begin
for ii := BufSize - 1 downto 0 do
begin
Text[0] := Convert[Byte(Buffer[ii]) shr 4];
Text[1] := Convert[Byte(Buffer[ii]) and $F];
Inc(Text, 2);
end;
end;
function DecodeSerialNumber(Source: CRYPT_INTEGER_BLOB): String;
begin
SetLength(Result, Source.cbData * 2);
BinToHexInverted(PChar(Source.pbData), Pointer(Result), Source.cbData);
end;
function DecodeName(Source: CERT_NAME_BLOB;
encType: DWORD = X509_ASN_ENCODING or PKCS_7_ASN_ENCODING;
strType: DWORD = CERT_X500_NAME_STR): String;
var
iLength: DWORD;
begin
iLength := CertNameToStr(encType, @Source, strType, nil, 0);
SetLength(Result, iLength);
iLength := CertNameToStr(encType, @Source, strType, Pointer(Result), iLength);
SetLength(Result, iLength);
end;
function FileTime2DateTime(FileTime: TFileTime): TDateTime;
var
LocalFileTime: TFileTime;
SystemTime: TSystemTime;
begin
FileTimeToLocalFileTime(FileTime, LocalFileTime);
FileTimeToSystemTime(LocalFileTime, SystemTime);
Result := SystemTimeToDateTime(SystemTime);
end;
procedure LOG(S: String);
begin
Form1.Memo1.Lines.Add(S);
end;
procedure TForm1.Button1Click(Sender: TObject);
var
cert: PCCERT_CONTEXT;
M: TMemoryStream;
encType: DWORD;
PS: Pbyte;
sz: DWORD;
skip: DWORD;
flags: DWORD;
I: Integer;
begin
if OpenDialog1.Execute then
begin
Memo1.Clear;
M := TMemoryStream.Create;
try
M.LoadFromFile(OpenDialog1.FileName);
encType := X509_ASN_ENCODING or PKCS_7_ASN_ENCODING;
cert := CertCreateCertificateContext(encType, M.Memory, M.Size);
if not Assigned(cert) then
begin
//
flags := CRYPT_STRING_BASE64REQUESTHEADER;
CryptStringToBinary(Pointer(M.Memory), M.Size, flags, nil, sz,
skip, flags);
GetMem(PS, sz);
try
CryptStringToBinary(Pointer(M.Memory), M.Size, flags, Pointer(PS), sz,
skip, flags);
cert := CertCreateCertificateContext(encType, PS, sz);
finally
FreeMem(PS);
end;
//
end;
if Assigned(cert) then
begin
try
//
LOG(FormatDateTime('Действителен с: dd.mm.yyyy',
FileTime2DateTime(cert^.pCertInfo^.NotBefore)));
LOG(FormatDateTime('Действителен до: dd.mm.yyyy',
FileTime2DateTime(cert^.pCertInfo^.NotAfter)));
LOG('Субъект: ' + DecodeName(cert^.pCertInfo^.Subject));
LOG('Поставщик: ' + DecodeName(cert^.pCertInfo^.Issuer));
LOG('******');
LOG('Парсим мыло субъекта: ' + GetValue('',
DecodeName(cert^.pCertInfo^.Subject), 'E=', ',', I));
LOG('******');
LOG('Серийный номер: ' + DecodeSerialNumber
(cert^.pCertInfo^.SerialNumber));
finally
if not CertFreeCertificateContext(cert) then
ShowMessage(SysErrorMessage(GetLastError));
end;
end
else
ShowMessage(SysErrorMessage(GetLastError));;
finally
M.Free;
end;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
end;
end.