unit CryptoSigner;

interface

uses
  Windows; 

function SignFileDetached(const ThumbprintHex: string; const InFileName, OutFileName: string): Boolean;

implementation

const
  CERT_FIND_SHA1_HASH = $00010000;
  PKCS_7_ASN_ENCODING = $00010000;
  X509_ASN_ENCODING   = $00000001;
  MY_ENCODING_TYPE    = PKCS_7_ASN_ENCODING or X509_ASN_ENCODING;
  CRYPT_ACQUIRE_CACHE_FLAG = $00000001;

type
  HCERTSTORE = Pointer;
  PCCERT_CONTEXT = Pointer;
  HCRYPTPROV_OR_NCRYPT_KEY = LongWord;

  CRYPT_INTEGER_BLOB = record
    cbData: DWORD;
    pbData: Pointer; 
  end;
  CRYPT_HASH_BLOB = CRYPT_INTEGER_BLOB;

  CRYPT_ALGORITHM_IDENTIFIER = record
    pszObjId: PAnsiChar;
    Parameters: CRYPT_INTEGER_BLOB;
  end;

  CRYPT_SIGN_MESSAGE_PARA = record
    cbSize: DWORD;
    dwMsgEncodingType: DWORD;
    pSigningCert: PCCERT_CONTEXT;
    HashAlgorithm: CRYPT_ALGORITHM_IDENTIFIER;
    pvHashAuxInfo: Pointer;
    cMsgCert: DWORD;
    rgpMsgCert: Pointer;
    cMsgCrl: DWORD;
    rgpMsgCrl: Pointer;
    cAuthAttr: DWORD;
    rgAuthAttr: Pointer;
    cUnauthAttr: DWORD;
    rgUnauthAttr: Pointer;
    dwFlags: DWORD;
    dwInnerContentType: DWORD;
  end;

function CertOpenSystemStoreA(hProv: Pointer; szSubsystemProtocol: PAnsiChar): HCERTSTORE; stdcall; external 'crypt32.dll';

function CertFindCertificateInStore(hCertStore: HCERTSTORE; dwCertEncodingType: DWORD;
  dwFindFlags: DWORD; dwFindType: DWORD; pvFindPara: Pointer;
  pPrevCertContext: PCCERT_CONTEXT): PCCERT_CONTEXT; stdcall; external 'crypt32.dll';

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

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

function CryptSignMessage(pSignPara: Pointer; fDetachedSignature: BOOL;
  cToBeSigned: DWORD; rgpbToBeSigned: Pointer; rgcbToBeSigned: Pointer;
  pbSignedBlob: Pointer; pcbSignedBlob: Pointer): BOOL; stdcall; external 'crypt32.dll';

function CryptAcquireCertificatePrivateKey(pCert: PCCERT_CONTEXT; dwFlags: DWORD; pvReserved: Pointer;
  var phCryptProvOrNCryptKey: HCRYPTPROV_OR_NCRYPT_KEY; var pdwKeySpec: DWORD; var pfCallerFreeProv: BOOL): BOOL; stdcall; external 'crypt32.dll';

function HexCharToInt(C: Char): Integer;
begin
  case C of
    '0'..'9': Result := Ord(C) - Ord('0');
    'a'..'f': Result := Ord(C) - Ord('a') + 10;
    'A'..'F': Result := Ord(C) - Ord('A') + 10;
  else
    Result := 0;
  end;
end;

procedure HexToBytes(const HexStr: string; var Bytes: array of Byte);
var
  i: Integer;
begin
  for i := 0 to 19 do
  begin
    Bytes[i] := (HexCharToInt(HexStr[i * 2 + 1]) shl 4) or HexCharToInt(HexStr[i * 2 + 2]);
  end;
end;

function SignFileDetached(const ThumbprintHex: string; const InFileName, OutFileName: string): Boolean;
label 
  ggetout; 
var
  hStore: HCERTSTORE;
  pCertContext: PCCERT_CONTEXT;
  HashBlob: CRYPT_HASH_BLOB;
  ThumbBytes: array[0..19] of Byte;
  SignPara: CRYPT_SIGN_MESSAGE_PARA;
  
  hFileIn, hFileOut: THandle;
  DataPtr, SigBuffer: Pointer;
  DataSize, SigSize, BytesRead, BytesWritten: DWORD;
  
  pDataPtr: Pointer;
  pDataSize: DWORD;
  
  hCryptProv: HCRYPTPROV_OR_NCRYPT_KEY;
  dwKeySpec: DWORD;
  fCallerFreeProv: BOOL;
  
  StoreMy: array[0..2] of Char;
  OidGOST: array[0..17] of Char;
begin
  Result := False;
  hStore := nil; pCertContext := nil; DataPtr := nil; SigBuffer := nil;
  hFileIn := INVALID_HANDLE_VALUE; hFileOut := INVALID_HANDLE_VALUE;

  StoreMy := 'MY';
  OidGOST := '1.2.643.7.1.1.2.2';

  // ИСПРАВЛЕНО: Теперь берем реальную длину входящей строки ThumbprintHex со схемы HiAsm
  if Length(ThumbprintHex) <> 40 then Exit;
  HexToBytes(ThumbprintHex, ThumbBytes);
  HashBlob.cbData := 20;
  HashBlob.pbData := @ThumbBytes;

  hStore := CertOpenSystemStoreA(nil, @StoreMy);
  if hStore = nil then Exit;

  pCertContext := CertFindCertificateInStore(hStore, MY_ENCODING_TYPE, 0, CERT_FIND_SHA1_HASH, @HashBlob, nil);
  if pCertContext = nil then begin CertCloseStore(hStore, 0); Exit; end;

  hCryptProv := 0;
  if not CryptAcquireCertificatePrivateKey(pCertContext, CRYPT_ACQUIRE_CACHE_FLAG, nil, hCryptProv, dwKeySpec, fCallerFreeProv) then goto ggetout;

  // ИСПРАВЛЕНО: Открываем файл, переданный со схемы через InFileName
  hFileIn := CreateFile(PChar(InFileName), GENERIC_READ, FILE_SHARE_READ, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
  if hFileIn = INVALID_HANDLE_VALUE then goto ggetout;

  DataSize := GetFileSize(hFileIn, nil);
  
  DataPtr := VirtualAlloc(nil, DataSize, MEM_COMMIT, PAGE_READWRITE);
  if (DataPtr = nil) or not ReadFile(hFileIn, DataPtr^, DataSize, BytesRead, nil) then goto ggetout;
  CloseHandle(hFileIn); hFileIn := INVALID_HANDLE_VALUE;

  FillChar(SignPara, SizeOf(SignPara), 0);
  SignPara.cbSize := SizeOf(SignPara);
  SignPara.dwMsgEncodingType := MY_ENCODING_TYPE;
  SignPara.pSigningCert := pCertContext;
  SignPara.HashAlgorithm.pszObjId := @OidGOST;

  pDataPtr := DataPtr;
  pDataSize := DataSize;

  if CryptSignMessage(@SignPara, True, 1, @pDataPtr, @pDataSize, nil, @SigSize) then
  begin
    SigBuffer := VirtualAlloc(nil, SigSize, MEM_COMMIT, PAGE_READWRITE);
    if CryptSignMessage(@SignPara, True, 1, @pDataPtr, @pDataSize, SigBuffer, @SigSize) then
    begin
      // ИСПРАВЛЕНО: Сохраняем подпись по пути, переданному со схемы через OutFileName
      hFileOut := CreateFile(PChar(OutFileName), GENERIC_WRITE, 0, nil, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0);
      if hFileOut <> INVALID_HANDLE_VALUE then
      begin
        if WriteFile(hFileOut, SigBuffer^, SigSize, BytesWritten, nil) then Result := True;
        CloseHandle(hFileOut);
      end;
    end;
  end;

  ggetout:
  if DataPtr <> nil then VirtualFree(DataPtr, 0, $8000);
  if SigBuffer <> nil then VirtualFree(SigBuffer, 0, $8000);
  if hFileIn <> INVALID_HANDLE_VALUE then CloseHandle(hFileIn);
  if pCertContext <> nil then CertFreeCertificateContext(pCertContext);
  if hStore <> nil then CertCloseStore(hStore, 0);
end;

end.

unit HiAsmUnit;

interface

uses Windows, kol, Share, Debug, CryptoSigner;

type
 THiAsmClass = class(TDebug)
   public
     Thumbprint: THI_Event; 
     SourceFile: THI_Event; 
     SignFile:   THI_Event; 
     onSuccess: THI_Event;  
     onFail:    THI_Event;  
     procedure doSign(var dt: TData; idx: word);
 end;

implementation

procedure THiAsmClass.doSign(var dt: TData; idx: word);
var
  sThumb, sSource, sSign: string;
  ErrCode: DWORD;
begin
  sThumb  := ReadString(dt, Thumbprint, '');
  sSource := ReadString(dt, SourceFile, '');
  sSign   := ReadString(dt, SignFile, '');

  if (sThumb = '') or (sSource = '') or (sSign = '') then
  begin
    MessageBox(0, 'Ошибка: Заполните все поля на схеме!', 'КриптоПро', MB_OK or MB_ICONERROR);
    _hi_onEvent(onFail, 'Empty fields');
    Exit;
  end;

  if SignFileDetached(PChar(sThumb), PChar(sSource), PChar(sSign)) then
  begin
    MessageBox(0, 'Файл успешно подписан средствами Windows CryptoAPI!', 'КриптоПро', MB_OK or MB_ICONINFORMATION);
    _hi_onEvent(onSuccess, 'Success');
  end
  else
  begin
    // Перехватываем код последней системной ошибки Windows
    ErrCode := GetLastError;
    
    // Выводим ошибку на экран для диагностики
    MessageBox(0, PChar('Ошибка подписания!'#13#10'Код ошибки Windows (GetLastError): ' + Int2Str(ErrCode) + 
                   #13#10#13#10'Возможные причины: неверный отпечаток, закрыт доступ к файлу или нет КриптоПро.'), 
                   'КриптоПро - Диагностика', MB_OK or MB_ICONERROR);
                   
    _hi_onEvent(onFail, 'Sign error');
  end;
end;

end.