Como validar pin de certificado digtial com wincrypt

[Marcos Fernando Barbosa]

Estou desenvolvendo uma função onde ao selecionar um determinado certificado digital é necessário checar o pin do mesmo.

unit ANMsg;

interface

Uses SysUtils, WinTypes, Vcl.Forms, Vcl.Dialogs, System.UITypes;

procedure Mostrar(const s: string);
procedure MsgAdverte(const Msg: String);
procedure MsgInforma(const Msg: String);
procedure MsgErro(const Msg: String);
function  MsgConfirma(const Msg: String): Boolean;
function  Confirm(const Msg: String): Boolean;

implementation

procedure Mostrar(const s: string);
begin
  Application.MessageBox(pchar(s), '', 0);
end;

procedure MsgErro(const Msg: String);
begin
  Application.MessageBox(PChar(Msg), 'Erro', MB_OK + MB_ICONERROR);
end;

procedure MsgInforma(const Msg: String);
begin
  Application.MessageBox(PChar(Msg), 'Informação', MB_OK + MB_ICONINFORMATION);
end;

procedure MsgAdverte(const Msg: String);
begin
  Application.MessageBox(PChar(Msg), 'Advertência', MB_OK + MB_ICONWARNING);
end;

function MsgConfirma(const Msg: String): Boolean;
begin
  Result := MessageDlg(Msg, mtConfirmation, [mbYes, mbNo], 0) = mrYes;
end;

function Confirm(const Msg: String): Boolean;
begin
  Result := MessageDlg(Msg, mtConfirmation, [mbYes, mbNo], 0) = mrYes;
end;

end.
-----------------------------------------------------------------------------------------------------------------
unit AnCryptUtil;

interface

uses
  Windows, Messages, SysUtils, Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms,
  Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls, Vcl.ComCtrls, Vcl.Buttons, ShellApi,
  WinCrypt, NCrypt, BCrypt;

function GetCSPProviderParamDWord(ACryptProvider: HCRYPTPROV; dwParam: DWORD): DWORD;
function GetCNGProviderParamDWord(ACryptHandle: NCRYPT_HANDLE; dwParam: LPCWSTR): DWORD;
function GetCNGProviderIsHardware(ACryptHandle: NCRYPT_HANDLE): Boolean;
function GetCSPProviderIsHardware(ACryptProvider: HCRYPTPROV): Boolean;
function GetProviderOrKeyIsHardware(ProviderOrKeyHandle: HCRYPTPROV_OR_NCRYPT_KEY_HANDLE; dwKeySpec: DWORD): Boolean;
function GetCertIsHardware(ACertContext: PCCERT_CONTEXT): Boolean;
function CheckPINError(WinErro: Integer; RaiseUnknown: Boolean): Boolean;

implementation

function GetCSPProviderParamDWord(ACryptProvider: HCRYPTPROV; dwParam: DWORD): DWORD;
var
  pdwDataLen: DWORD;
begin
  pdwDataLen := SizeOf(DWORD);
  if not CryptGetProvParam(ACryptProvider, dwParam, @Result, pdwDataLen, 0) then
    raise Exception.Create('GetCSPProviderParamDWord. Erro: criptografia');
end;

function GetCNGProviderParamDWord(ACryptHandle: NCRYPT_HANDLE; dwParam: LPCWSTR): DWORD;
var
  pdwDataLen, pcbResult: DWORD;
  Ret: SECURITY_STATUS;
begin
  Result     := 0;
  pdwDataLen := SizeOf(DWORD);
  pcbResult  := 0;
  Ret := NCryptGetProperty(ACryptHandle, dwParam, @Result, pdwDataLen, pcbResult, 0);
  if (Ret <> ERROR_SUCCESS) then
    raise Exception.Create('GetCNGProviderParamDWord. Erro: '+IntToHex(Ret, 8));
end;

function GetCNGProviderIsHardware(ACryptHandle: NCRYPT_HANDLE): Boolean;
var
  ImpType: DWORD;
begin
  try
    ImpType := GetCNGProviderParamDWord(ACryptHandle, NCRYPT_IMPL_TYPE_PROPERTY);
    Result := ((ImpType and NCRYPT_IMPL_HARDWARE_FLAG) = NCRYPT_IMPL_HARDWARE_FLAG);
  except
    Result := True;  // TODO: Assumindo que todos certificados CNG são A3
  end;
end;

function GetCSPProviderIsHardware(ACryptProvider: HCRYPTPROV): Boolean;
var
  ImpType: DWORD;
begin
  ImpType := GetCSPProviderParamDWord(ACryptProvider, PP_IMPTYPE);
  Result := ((ImpType and CRYPT_IMPL_HARDWARE) = CRYPT_IMPL_HARDWARE);
end;

function GetProviderOrKeyIsHardware(ProviderOrKeyHandle: HCRYPTPROV_OR_NCRYPT_KEY_HANDLE; dwKeySpec: DWORD): Boolean;
begin
  if dwKeySpec = CERT_NCRYPT_KEY_SPEC then
    Result := GetCNGProviderIsHardware(ProviderOrKeyHandle)
  else
    Result := GetCSPProviderIsHardware(ProviderOrKeyHandle);
end;

function GetCertIsHardware(ACertContext: PCCERT_CONTEXT): Boolean;
var
  dwKeySpec: DWORD;
  pfCallerFreeProv: LongBool;
  ProviderOrKeyHandle: HCRYPTPROV_OR_NCRYPT_KEY_HANDLE;
begin
  Result := False;
  ProviderOrKeyHandle := 0;
  dwKeySpec := 0;
  pfCallerFreeProv := False;

  // Obtendo o Contexto do Provedor de Criptografia do Certificado //
  if not CryptAcquireCertificatePrivateKey( ACertContext,
                                            CRYPT_ACQUIRE_ALLOW_NCRYPT_KEY_FLAG,
                                            Nil,
                                            ProviderOrKeyHandle,
                                            dwKeySpec,
                                            pfCallerFreeProv) then
    raise Exception.Create('Erro do provedor de criptografia');

  try
    Result := GetProviderOrKeyIsHardware(ProviderOrKeyHandle, dwKeySpec);
  finally
    if pfCallerFreeProv then
      Result := CryptReleaseContext(ProviderOrKeyHandle, 0);
    if not Result then
      raise Exception.Create('Erro do contexto do certificado');
  end;
end;

function CheckPINError(WinErro: Integer; RaiseUnknown: Boolean) :Boolean;
begin
  Result := true;

  if WinErro = NO_ERROR then Result := False
  else if WinErro = ERROR_NO_TOKEN then
  begin
     raise Exception.Create('Token ou cartão inteligente não encontrado.');
  end
  else if WinErro = SCARD_W_WRONG_CHV then
  begin
     raise Exception.Create('O cartão não pode ser acessado porque o PIN errado foi apresentado.');
  end
  else if WinErro = SCARD_W_CHV_BLOCKED then
  begin
     raise Exception.Create('O cartão não pode ser acessado porque o número máximo de tentativas de entrada de PIN foi atingido');
  end
  else if (WinErro > 0) and ((WinErro <> ERROR_NO_TOKEN) and (WinErro = SCARD_W_WRONG_CHV) and (WinErro = SCARD_W_CHV_BLOCKED)) then
  begin
    if RaiseUnknown then
    begin
      raise Exception.Create('Falha ao Definir PIN do Certificado');
    end;
  end;
end;

end.
--------------------------------------------------------------------------------------------------------------------------------------------
unit CheckCertificado2;

interface

uses
  Windows, Messages, SysUtils, Classes, ShellApi, WinCrypt, NCrypt, BCrypt, 
  AnCryptUtil, AnMsg;

function CheckCertificado: boolean;

implementation

function GetCertificado: boolean;
var
  hStore: HCERTSTORE;
  ACertContext: PCCERT_CONTEXT;
  inUse : PCERT_RDN;
  LKeyHandle: HCRYPTPROV_OR_NCRYPT_KEY_HANDLE;
  j, k: DWORD;
  n: Pointer;
  b: BOOL;
  ProviderOrKeyHandle: HCRYPTPROV_OR_NCRYPT_KEY_HANDLE;
  Ret: Integer;
  Reader: PByte;
  ReaderSize: DWORD;
begin
  Result := False;
  hStore := nil;

  try
    hStore := CertOpenSystemStore(0, 'My');

    ACertContext := CryptUIDlgSelectCertificateFromStore(hStore, 0,
      'Selecione um Certificado',
      'Selecione o Certificado que deseja utilizar:',
      CRYPTUI_SELECT_LOCATION_COLUMN or CRYPTUI_SELECT_ISSUEDBY_COLUMN or
      CRYPTUI_SELECT_INTENDEDUSE_COLUMN, 0, Nil);

    if (Assigned(ACertContext)) and (ACertContext <> nil) and (GetCertIsHardware(ACertContext)) then
    begin
      //checa se certificado digital tem chave privada
  	  if CryptAcquireCertificatePrivateKey(ACertContext, j, n, LKeyHandle, k, b) then
      begin
        MsgAdverte('Certificado foi selecionado. Certificado tem chave privada. Drivers do certificados encontrados');

        if not GetCNGProviderIsHardware(ProviderOrKeyHandle) then
          Exit;

        MsgAdverte('provedor do serviços de criptografia recuperado com sucesso');

        //não identifiquei qual função usar para validar o pin do usuario nas libs WinCrypt, NCrypt, BCrypt, tentei usar a função abaiaxo sem sucesso

//        Ret := NCryptSetProperty(ProviderOrKeyHandle, NCRYPT_PIN_PROPERTY, Reader, ReaderSize, 0);

//        MsgAdverte(Ret.ToString);

//        if CheckPINError(Ret, true) then
//          Exit;
      end
      else
        RegUsuario.Mensagem := 'Drivers do certificado não encontrados';
    end
    else
    begin
      RegUsuario.Mensagem := 'Operação cancelada pelo usuário';
    end;

  finally
    CertCloseStore(hStore, 0);
  end;
end;

Alguém ai poderia dar um help

 

[Juliomar Marchetti]

Olha o código do ACBr que tem lá o que tu quer. abre os fontes e leia tá lá

[Marcos Fernando Barbosa]

8 minutos atrás, Juliomar Marchetti disse:

Olha o código do ACBr que tem lá o que tu quer. abre os fontes e leia tá lá

Bom dia, lá em nenhum momento não consegui identificar a validação do pin do usuário.

[Marcos Fernando Barbosa]

2 horas atrás, Marcos Fernando Barbosa disse:

Bom dia, lá em nenhum momento não consegui identificar a validação do pin do usuário.

Nem exemplo de como validar o pin do certificado com wincrypt consegui encontrar.

[Juliomar Marchetti]

e qual o objetivo?

[Marcos Fernando Barbosa]

Bom dia. 

Primeiro passo é validar se usuário que está usando certificado é o próprio. Como o certificado é pessoal na nossa concepção outro usuário não emprestaria o mesmo para um outro usuário.

Segundo passo é validar o certificado do usuário em uma base de dados remota com autenticação de duas pontas, para segurança do sistema através de web service.

Já tinha feito esta validação antes com a CAPICOM, mas como a mesma não suporta aplicação de windows 64 bits estamos migrando para wincrypt.

 

function GetCertificado: boolean;
var
  Store: TStore;
  iStore: IStore3;
  CertsLista, CertsSelecionado: ICertificates2;
  CertDados: ICertificate;
  lSigner: TSigner;
  lSignedData: TSignedData;
  Cert: TCertificate;
  Ov: OleVariant;
  Certificado: TCertificado;
  xml, s, sFilename: string;
  ClaWSCertificado: TClaWSCertificadoMG;
  Arquivo: TStringList;
  ok: boolean;
  Read : TLOGINRead;
begin
  Result := false;
  if not IsInternetConnected then
  begin
    MsgErro('Rede indisponível.');
    Exit;
  end;

  SetBusy(true);

  Store := CreateComObject as IStore3;

  try
    Store.Open(CAPICOM_CURRENT_USER_STORE, 'root', CAPICOM_STORE_OPEN_READ_ONLY);
  except
    On E: Exception do
    begin
      MsgErro('Erro ao tentar realizar leitura do Certificado Digital'#13
             +'Verifique se as cadeias referente ao Certificado Digital'#13
             +'estão instaladas de forma correta no PC/NOTEBOOK.'#13
             +'Caso a mensagem apresentada abaixo seja erro de registro'#13
             +'da dll Capicom.dll entre em contato com suporte'#13
             +e.Message);
      SetBusy(false);
      Exit;
    end;
  end;

  try
    CertsLista := Store.Certificates as ICertificates2;
    CertsSelecionado := CertsLista.Select
      ('Certificado(s) Digital(is) disponível(is)',
      'Selecione o Certificado Digital para uso no aplicativo', False);
  except
    On E: Exception do
    begin
      RegUsuario.Mensagem := 'Operação cancelada pelo usuário!';
      SetBusy(false);
      Exit;
    end;
  end;

  if not(CertsSelecionado.Count = 0) then
  begin
    CertDados := IInterface(CertsSelecionado.Item[1]) as ICertificate2;

    lSigner := TSigner.Create(nil);
    lSigner.Certificate := CertDados;

    lSignedData := TSignedData.Create(nil);
    lSignedData.Content := ' ';

    try
      lSignedData.Sign(lSigner.DefaultInterface, false, CAPICOM_ENCODE_BINARY);
    except
      On E : Exception do
      begin
        RegUsuario.Mensagem := 'Erro na autenticação do Certificado Digital!';
        SetBusy(false);
        Exit;
      end;
    end;

    Cert := TCertificate.Create(nil);
    Ov := IInterface(CertsSelecionado.Item[1]) as ICertificate2;
    Cert.ConnectTo(IDispatch(Ov) as ICertificate2);

    Certificado.IssuerName := Cert.IssuerName;
    Certificado.ChaveEncode := Cert.Export(CAPICOM_ENCODE_BASE64);

    xml := '';
    s := '<DADOS>' +
            '<X509Certificate>' + Certificado.ChaveEncode + '</X509Certificate>' +
            '<IP>' + GetLocalIP + '</IP>' +
         '</DADOS>';

    //AUTENTICAÇÃO DO CERTIFICADO NO WEB SERVICE DE DUAS PONTAS
	ClaWSCertificado := TClaWSCertificado.Create;
    ClaWSCertificado.Texto := s;
    ok := ClaWSCertificado.Execute;
    if ok then
    begin
      Arquivo := ClaWSCertificado.Xml;
      Arquivo.SaveToFile(sFilename);
      Read := TLOGINRead.Create;
      Read.XML := sFilename;
      ok := Read.LerXml;
      if (ok) and (RegUsuario.Status = 'SUCESSO') then
      begin
        Result := True;
      end;
      DeleteFile(Read.XML);
      Read.Free;
    end;

    ClaWSCertificado.Free;
    lSignedData.Free;
    lSigner.Free;
  end;
  Store.Close;
  SetBusy(false);
end;