VPF::программно получить серийный номер сертификата ЭЦП

Validator

Дата 12.1.2009, 10:15 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 2
Регистрация: 20.12.2008

Репутация: нет
Всего: нет

1) Есть сертификат: файл с расширением *.cer

2) Необходимо программно узнать его серийный номер

3) Как сделать

Rrader

Дата 14.1.2009, 14:05 (ссылка)

(нет голосов)

Загрузка ...

Inspired =)

Профиль
Группа: Экс. модератор
Сообщений: 1535
Регистрация: 7.5.2005

Репутация: 18
Всего: 191

Код


unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    OpenDialog1: TOpenDialog;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

  CRYPTOAPI_BLOB = packed record
    cbData: DWORD;
    pbData: PByte;
  end;

  CRYPT_INTEGER_BLOB = CRYPTOAPI_BLOB;
  CRYPT_OBJID_BLOB = CRYPTOAPI_BLOB;
  CERT_NAME_BLOB = CRYPTOAPI_BLOB;

  CRYPT_ALGORITHM_IDENTIFIER = packed record
    pszObjId: LPSTR;
    Parameters: CRYPT_OBJID_BLOB;
  end;

  CRYPT_BIT_BLOB = packed record
    cbData: DWORD;
    pbData: PBYTE;
    cUnusedBits: DWORD;
  end;

  CERT_PUBLIC_KEY_INFO = packed record
    Algorithm: CRYPT_ALGORITHM_IDENTIFIER;
    PublicKey: CRYPT_BIT_BLOB;
  end;

  CERT_EXTENSION = packed record
    pszObjId:  LPSTR;
    fCritical: BOOL;
    Value: CRYPT_OBJID_BLOB;
  end;
  PCERT_EXTENSION = ^CERT_EXTENSION;
  TARR_CERT_EXTENSION = PCERT_EXTENSION;

  CERT_INFO = packed record
    dwVersion: DWORD;
    SerialNumber: CRYPT_INTEGER_BLOB;
    SignatureAlgorithm: CRYPT_ALGORITHM_IDENTIFIER;
    Issuer: CERT_NAME_BLOB;
    NotBefore: FILETIME;
    NotAfter: FILETIME;
    Subject: CERT_NAME_BLOB;
    SubjectPublicKeyInfo: CERT_PUBLIC_KEY_INFO;
    IssuerUniqueId: CRYPT_BIT_BLOB;
    SubjectUniqueId: CRYPT_BIT_BLOB;
    cExtension: DWORD;
    rgExtension: TARR_CERT_EXTENSION;
  end;
  PCERT_INFO = ^CERT_INFO;

  HCERTSTORE = Pointer;
  HCRYPTPROV = ULONG;

  CERT_CONTEXT = packed record
    dwCertEncodingType: DWORD;
    pbCertEncoded: PBYTE;
    cbCertEncoded: DWORD;
    pCertInfo: PCERT_INFO;
    hCertStore: HCERTSTORE;
  end;
  PCERT_CONTEXT = ^CERT_CONTEXT;
  PCCERT_CONTEXT = ^CERT_CONTEXT;

function CertFreeCertificateContext(pCertContext:
  PCCERT_CONTEXT): BOOL; stdcall external 'crypt32.dll';

function CertCreateCertificateContext(dwCertEncodingType: DWORD;
  pbCertEncoded: PBYTE; cbCertEncoded: DWORD): PCCERT_CONTEXT; stdcall
  external 'crypt32.dll';

const
  X509_ASN_ENCODING = $00000001; 
  PKCS_7_ASN_ENCODING = $00010000; 

var
  Form1: TForm1;

implementation

{$R *.dfm}

function ByteArrayToStr(pbData: PByte; cbData: DWORD): String;
var
  I, J: Integer;
  S: String;
begin
  Result := '';
  if not Assigned(pbData) or (cbData <= 0) then
    Exit;
  for I := 0 to cbData - 1 do
  begin
    J := PByteArray(pbData)^[I];
    S := IntToHex(J, 2);
    if (I > 0) and (I and 1 = 0) then
      S := S + ' ';
    Result := S + Result;
  end;
end;

function GetSerialNumber(CertInfo: PCCERT_CONTEXT): String;
begin
  Result := ByteArrayToStr(CertInfo.pCertInfo.SerialNumber.pbData,
    CertInfo.pCertInfo.SerialNumber.cbData);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  Context: PCCERT_CONTEXT;
  M: TMemoryStream;
begin
  if OpenDialog1.Execute then
  begin
    M := TMemoryStream.Create;
    try
      M.LoadFromFile(OpenDialog1.FileName);
      Context := CertCreateCertificateContext(X509_ASN_ENCODING or
        PKCS_7_ASN_ENCODING, M.Memory, M.Size);
      if Assigned(Context) then
      try
        ShowMessage(GetSerialNumber(Context));
      finally
        if not CertFreeCertificateContext(Context) then
          ShowMessage(SysErrorMessage(GetLastError));
      end;
    finally
      M.Free;
    end;
  end;
end;

end.

Это сообщение отредактировал(а) Rrader - 14.1.2009, 14:07

--------------------

Let's do this quickly!
Rest in peace, Vit!

Validator

Дата 14.1.2009, 14:40 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 2
Регистрация: 20.12.2008

Репутация: нет
Всего: нет

Спасибо огромное!!!

1 Пользователей читают эту тему (1 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Для новичков \| Следующая тема »