unit CryptoWinUtils;

interface

uses
  Windows, classes, SysUtils;

type
  /////////////////////////////
  // WinApi структуры
  /////////////////////////////

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

  CRYPT_INTEGER_BLOB = CRYPTOAPI_BLOB;
  CRYPT_OBJID_BLOB = CRYPTOAPI_BLOB;

  CERT_NAME_BLOB = CRYPTOAPI_BLOB;
  PCERT_NAME_BLOB = ^CERT_NAME_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;

  /////////////////////////////
  // Другие структуры
  /////////////////////////////

  TCertRow = record
    SerialNumber: string;
    // ...
  end;
  TCertRows = array of TCertRow;

const
  X509_ASN_ENCODING = $00000001;
  PKCS_7_ASN_ENCODING = $00010000;

  CERT_SIMPLE_NAME_STR = 1; // All object identifiers (OIDs) are discarded. CERT_RDN entries are separated by a comma followed by a space (, ). Multiple attributes in a CERT_RDN are separated by a plus sign enclosed within spaces ( + ), for example, Firm, Qwe Asd + Zxc.
  CERT_OID_NAME_STR = 2; // OIDs are included with an equal sign (=) separator from their attribute value. CERT_RDN entries are separated by a comma followed by a space (, ). Multiple attributes in a CERT_RDN are separated by a plus sign followed by a space (+ ).
  CERT_X500_NAME_STR = 3; // OIDs are converted to their X.500 key names; otherwise, they are the same as CERT_OID_NAME_STR. If an OID does not have a corresponding X.500 name, the OID is used with a prefix of OID.
  CERT_NAME_STR_SEMICOLON_FLAG = $40000000; // Replace the comma followed by a space (, ) separator with a semicolon followed by a space (; ) separator.
  CERT_NAME_STR_CRLF_FLAG = $08000000; // Replace the comma followed by a space (, ) separator with a backslash followed by the letter r followed by a backslash followed by the letter n (\r\n) separator.
  CERT_NAME_STR_NO_PLUS_FLAG = $20000000; // Replace the plus sign enclosed within spaces ( + ) separator with a single space separator.
  CERT_NAME_STR_NO_QUOTING_FLAG = $10000000; // Disable quoting.
  CERT_NAME_STR_REVERSE_FLAG = $02000000; // The order of the RDNs in the distinguished name string is reversed after decoding. This flag is not set by default.
  CERT_NAME_STR_DISABLE_IE4_UTF8_FLAG = $00010000; // By default, a CERT_RDN_T61_STRING X.500 key string is decoded as UTF8. If UTF8 decoding fails, the X.500 key is decoded as an 8 bit character. Use CERT_NAME_STR_DISABLE_IE4_UTF8_FLAG to skip the initial attempt to decode as UTF8.
  CERT_NAME_STR_ENABLE_PUNYCODE_FLAG = $00200000; // If the name pointed to by the pName parameter contains an email RDN, and the host name portion of the email address contains a Punycode encoded IA5String, the name is converted to the Unicode equivalent.

  CERT_TYPE_INFO_SERIAL_NUMBER = 1;

  /////////////////////////////
  // WinApi функции
  /////////////////////////////

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

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

function CertOpenSystemStoreA(hProv: HCRYPTPROV;
  szSubsystemProtocol: LPCSTR): HCERTSTORE; stdcall
external 'crypt32.dll';

function CertCloseStore(hCertStore: HCERTSTORE;
  dwFlags: DWORD = 0): BOOL; stdcall
external 'crypt32.dll';

function CertEnumCertificatesInStore(hCertStore: HCERTSTORE;
  pPrevCertContext: PCCERT_CONTEXT): PCCERT_CONTEXT; stdcall
external 'crypt32.dll';

function CertNameToStrA(
  dwCertEncodingType: DWORD;
  pName: PCERT_NAME_BLOB;
  dwStrType: DWORD;
  psz: LPSTR;
  csz: DWORD): DWORD; stdcall
external 'crypt32.dll';

function CertNameToStrW(
  dwCertEncodingType: DWORD;
  pName: PCERT_NAME_BLOB;
  dwStrType: DWORD;
  psz: LPWSTR;
  csz: DWORD): DWORD; stdcall
external 'crypt32.dll';

/////////////////////////////
// Другие функции
/////////////////////////////

// ByteArrayToStr
function ByteArrayToStr(pbData: PByte; cbData: DWORD): string;

// Получить серийный номер сертификата
function CertGetSerialNumber(aCertInfo: PCCERT_CONTEXT): string;

// Получить список сертификатов из хранилища
function CertGetList(const aCertStoreName: string): TCertRows;

// Поиск сертификата
function CertFind(const aCertRows: TCertRows; const aCertData: string; const aCertTypeInfo: Integer): Integer;

implementation

// ByteArrayToStr

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 CertGetSerialNumber(aCertInfo: PCCERT_CONTEXT): string;
begin
  Result := ByteArrayToStr(
    aCertInfo.pCertInfo.SerialNumber.pbData
    , aCertInfo.pCertInfo.SerialNumber.cbData);
end;

// Получить список сертификатов из хранилища

function CertGetList(const aCertStoreName: string): TCertRows;
var
  certStoreName: PChar;
  hwndStore: HCERTSTORE;
  cert: PCCERT_CONTEXT;
  cryptoProvider: HCRYPTPROV;
  id: Integer;
begin
  // Преобразовываю имя хранилища
  certStoreName := StrAlloc(length(aCertStoreName) + 1);
  StrPCopy(certStoreName, aCertStoreName);

  // Получаю доступ к хранилищу
  hwndStore := CertOpenSystemStoreA(cryptoProvider, certStoreName);

  // Фокус на первый сертификат
  cert := CertEnumCertificatesInStore(hwndStore, nil);

  // Инициализация переменных
  SetLength(Result, 0);

  // Перебор сертификатов
  while cert <> nil do
  begin
    id := Length(Result);
    SetLength(Result, id + 1);

    // Серийный номер
    Result[id].SerialNumber := CertGetSerialNumber(cert);

    // Следующий сертификат
    cert := CertEnumCertificatesInStore(hwndStore, cert);
  end;

  // Завершить работу с хранилищем
  CertCloseStore(hwndStore);
end;

// Поиск сертификата

function CertFind(const aCertRows: TCertRows; const aCertData: string; const aCertTypeInfo: Integer): Integer;
var
  i, len: Integer;
  certData, certRowData: string;
begin
  Result := -1;
  len := Length(aCertRows);

  // Форматирование поискового текста
  case aCertTypeInfo of
    // Серийный номер
    CERT_TYPE_INFO_SERIAL_NUMBER:
      certData := AnsiUpperCase(StringReplace(aCertData, ' ', '', [rfReplaceAll]));
  end;

  // Поиск текста
  for i := 0 to len - 1 do
  begin
    // Форматирование переменной поиска из массива
    case aCertTypeInfo of
      // Серийный номер
      CERT_TYPE_INFO_SERIAL_NUMBER:
        certRowData := AnsiUpperCase(StringReplace(aCertRows[i].SerialNumber, ' ', '', [rfReplaceAll]));
    else
      Break;
    end;

    // Поиск
    if certRowData = certData then
    begin
      Result := i;
      Break;
    end;
  end;
end;

end.