Delphi & CryptoAPI - how to calculate HMAC-SHA512 hash?

Question

Does anybody know how to calculate a HMAC-SHA512 hash in Delphi 2010+ using MS CryptoAPI ?

The example from MS website, https://learn.microsoft.com/en-us/windows/win32/seccrypto/example-c-program--creating-an-hmac generates incorrect results.

I have found this answer https://stackoverflow.com/a/41387095/2111514 to be somehow usefull (because it is manual rewrite from https://en.wikipedia.org/wiki/HMAC), but it is not in Pascal and my attempt to refactor it to Pascal was without luck. It works, but still calculates wrong results.

Can anybody help me, please?

Edit:: This is my code that I have problem with:

uses
  Windows,
  JwaWinCrypt,
  JwaWinError;

const
  BLOCK_SIZE = 64;

type
  EHMACError = class(Exception);

function WinError(const RetVal: BOOL; const FuncName: String): BOOL;
var
  dwResult: Integer;
begin
  Result:=RetVal;
  if not RetVal then begin
    dwResult:=GetLastError();
    raise EHMACError.CreateFmt('Error [x%x]: %s failed.'#13#10'%s', [dwResult, FuncName, SysErrorMessage(dwResult)]);
  end;
end;

function TBytesToHex(const Value: TBytes): String;
const
  dictionary: Array[0..15] of Char = ('0', '1', '2', '3', '4', '5', '6', '7', '8', '9', 'a', 'b', 'c', 'd', 'e', 'f');
var
  i: Integer;
begin
  Result:='';
  for i:=0 to High(Value) do
    Result:=Result + dictionary[Value[i] shr 4] + dictionary[Value[i] and $0F];
end;

function hmac(AKey, AMessage: TBytes; Algid: ALG_ID): TBytes;

  function hash(const hProv: HCRYPTPROV; hData: TBytes): TBytes;
  var
    len, cb: DWORD;
    hHash: HCRYPTHASH;
  begin
    SetLength(Result, 0);
    WinError(CryptCreateHash(hProv, Algid, 0, 0, hHash), 'CryptCreateHash');
    try
      len:=Length(hData);
      cb:=SizeOf(len);
      WinError(CryptHashData(hHash, @hData[0], len, 0), 'CryptHashData');
      WinError(CryptGetHashParam(hHash, HP_HASHSIZE, @len, cb, 0), 'CryptGetHashParam(HP_HASHSIZE)');
      SetLength(Result, len);
      WinError(CryptGetHashParam(hHash, HP_HASHVAL, @Result[0], len, 0), 'CryptGetHashParam(HP_HASHVAL)');
    finally
      WinError(CryptDestroyHash(hHash), 'CryptDestroyHash');
    end;
  end;

  function double_hash(const hProv: HCRYPTPROV; hData1, hData2: TBytes): TBytes;
  var
    len, len1, len2, cb: DWORD;
    hHash: HCRYPTHASH;
  begin
    SetLength(Result, 0);
    WinError(CryptCreateHash(hProv, Algid, 0, 0, hHash), 'DH_CryptCreateHash');
    try
      len1:=Length(hData1);
      len2:=Length(hData2);
      cb:=SizeOf(DWORD);
      WinError(CryptHashData(hHash, @hData1[0], len1, 0), 'DH_CryptHashData(hData1)');
      WinError(CryptHashData(hHash, @hData2[0], len2, 0), 'DH_CryptHashData(hData1)');
      WinError(CryptGetHashParam(hHash, HP_HASHSIZE, @len, cb, 0), 'DH_CryptGetHashParam(HP_HASHSIZE)');
      SetLength(Result, len);
      WinError(CryptGetHashParam(hHash, HP_HASHVAL, @Result[0], len, 0), 'DH_CryptGetHashParam(HP_HASHVAL)');
    finally
      WinError(CryptDestroyHash(hHash), 'DH_CryptDestroyHash');
    end;
  end;

var
  hProv: HCRYPTPROV;
  hHash: HCRYPTHASH;
  i_key_pad, o_key_pad: TBytes;
  data, ret: TBytes;
  len, i: Integer;
  c: Byte;
  ifree: Boolean;
begin
  ifree:=False;
  SetLength(Result, 0);
  SetLength(i_key_pad, BLOCK_SIZE);
  SetLength(o_key_pad, BLOCK_SIZE);
  WinError(CryptAcquireContext(hProv, Nil, MS_ENH_RSA_AES_PROV, PROV_RSA_AES, CRYPT_VERIFYCONTEXT), 'CryptAcquireContext');
  try
    data:=AKey;
    len:=Length(data);
    if len > BLOCK_SIZE then begin
      data:=hash(hProv, data);
      ifree:=True;
    end;
    //
    i:=BLOCK_SIZE-1;
    while i >= 0 do begin
      if i < len then
        c:=data[i]
      else
        c:=0;
      i_key_pad[i]:=$36 xor c;
      o_key_pad[i]:=$5c xor c;
      Dec(i);
    end;
    data:=double_hash(hProv, i_key_pad, AMessage);
    Result:=double_hash(hProv, o_key_pad, data);
    SetLength(data, 0);
  finally
    if ifree then
      SetLength(data, 0);
    SetLength(i_key_pad, 0);
    SetLength(o_key_pad, 0);
    WinError(CryptReleaseContext(hProv, 0), 'CryptReleaseContext');
  end;
end;

...and it is called by:

Result:=hmac(Password, InString, CALG_SHA_512);

Example:

TBytesToHex(hmac('pass', 'test', CALG_SHA_512)); produces (HEX encoded)

1319bb7baefc3fbaf07824261c240cecd04a54cd83cdf0deb68e56cadff20e7c644e2e956660ab9df47a19502173090df5ec3d0b9236d59917afc4f3607cf980

whereas online HMAC calculator produces

46beca277a5fec10beba65b0c2fb3917115f352eb8b2560e9ada0a3dbafb6c7a3fc456b1e13a07c4a9c856b633b70b2403907ca89894021772393e3f97e78684

for the same input

Answer 1

The whole working solution to my question, thanks to @whosrdaddy for helping.

//
// HMAC-SHA512 - cryptoapi hash generation
//
// based on:
//   https://en.wikipedia.org/wiki/HMAC
//   https://github.com/ogay/hmac
//
// refactored from:
//   https://stackoverflow.com/questions/41384395/wrong-result-for-base64-string-of-hmac-sha1-using-crypto-api/41387095#41387095
//
unit CryptoAPI_HMAC_SHA512;

interface

uses
  SysUtils,
  Classes;

function CryptoAPI_Hash_HmacSHA512(const InString, Password: TBytes): TBytes; overload;
function CryptoAPI_Hash_HmacSHA512(const InString, Password: String): String; overload;

implementation

uses
  Windows,
  JwaWinCrypt,
  JwaWinError;

const
  BLOCK_SIZE  = 128; // bytes for SHA512

type
  EHMACError = class(Exception);

function WinError(const RetVal: BOOL; const FuncName: String): BOOL;
var
  dwResult: Integer;
begin
  Result:=RetVal;
  if not RetVal then begin
    dwResult:=GetLastError();
    raise EHMACError.CreateFmt('Error [x%x]: %s failed.'#13#10'%s', [dwResult, FuncName, SysErrorMessage(dwResult)]);
  end;
end;

function hmac(AKey, AMessage: TBytes; Algid: ALG_ID): TBytes;

  function hash(const hProv: HCRYPTPROV; hData1, hData2: TBytes): TBytes;
  var
    len, len1, len2, cb: DWORD;
    hHash: HCRYPTHASH;
  begin
    SetLength(Result, 0);
    WinError(CryptCreateHash(hProv, Algid, 0, 0, hHash), 'CryptCreateHash');
    try
      len:=0;
      len1:=Length(hData1);
      len2:=Length(hData2);
      cb:=SizeOf(DWORD);
      WinError(CryptHashData(hHash, @hData1[0], len1, 0), 'CryptHashData(hData1)');
      if len2 > 0 then
        WinError(CryptHashData(hHash, @hData2[0], len2, 0), 'CryptHashData(hData1)');
      WinError(CryptGetHashParam(hHash, HP_HASHSIZE, @len, cb, 0), 'CryptGetHashParam(HP_HASHSIZE)');
      SetLength(Result, len);
      WinError(CryptGetHashParam(hHash, HP_HASHVAL, @Result[0], len, 0), 'CryptGetHashParam(HP_HASHVAL)');
    finally
      WinError(CryptDestroyHash(hHash), 'CryptDestroyHash');
    end;
  end;

var
  hProv: HCRYPTPROV;
  i_key_pad, o_key_pad: TBytes;
  data: TBytes;
  emptyArray: TBytes;
  len, i: Integer;
  c: Byte;
  ifree: Boolean;
begin
  ifree:=False;
  SetLength(Result, 0);
  SetLength(emptyArray, 0);
  SetLength(i_key_pad, BLOCK_SIZE);
  SetLength(o_key_pad, BLOCK_SIZE);
  WinError(CryptAcquireContext(hProv, Nil, MS_ENH_RSA_AES_PROV, PROV_RSA_AES, CRYPT_VERIFYCONTEXT), 'CryptAcquireContext');
  try
    data:=AKey;
    len:=Length(data);
    if len > BLOCK_SIZE then begin
      data:=hash(hProv, data, emptyArray);
      len:=Length(data);
      ifree:=True;
    end;
    //
    i:=BLOCK_SIZE-1;
    while i >= 0 do begin
      c:=0;
      if i < len then
        c:=data[i];
      i_key_pad[i]:=$36 xor c;
      o_key_pad[i]:=$5c xor c;
      Dec(i);
    end;
    if ifree then
      SetLength(data, 0);
    data:=hash(hProv, i_key_pad, AMessage);
    Result:=hash(hProv, o_key_pad, data);
    SetLength(data, 0);
  finally
    SetLength(i_key_pad, 0);
    SetLength(o_key_pad, 0);
    WinError(CryptReleaseContext(hProv, 0), 'CryptReleaseContext');
  end;
end;

function TBytesToHex(const Value: TBytes): String;
const
  dictionary: Array[0..15] of Char = ('0', '1', '2', '3', '4', '5', '6', '7', '8', '9', 'a', 'b', 'c', 'd', 'e', 'f');
var
  i: Integer;
begin
  Result:='';
  for i:=0 to High(Value) do
    Result:=Result + dictionary[Value[i] shr 4] + dictionary[Value[i] and $0F];
end;

// source: https://stackoverflow.com/a/26892830/2111514
function MBCSString(const s: UnicodeString; CodePage: Word): RawByteString;
var
  enc: TEncoding;
  bytes: TBytes;
begin
  enc:=TEncoding.GetEncoding(CodePage);
  try
    bytes:=enc.GetBytes(s);
    SetLength(Result, Length(bytes));
    Move(Pointer(bytes)^, Pointer(Result)^, Length(bytes));
    SetCodePage(Result, CodePage, False);
  finally
    enc.Free;
  end;
end;

function UnicodeStringToTBytes(const Value: String): TBytes;
var
  ansi: AnsiString;
begin
  ansi:=MBCSString(Value, 65001); // Unicode (UTF-8) codepage
  Result:=BytesOf(ansi);
  ansi:='';
end;

function CryptoAPI_Hash_HmacSHA512(const InString, Password: TBytes): TBytes;
begin
  SetLength(Result, 0);
  if Length(Password) = 0 then
    raise EHMACError.Create('Error: Password length must be greater then 0!');

  Result:=hmac(Password, InString, CALG_SHA_512);
end;

function CryptoAPI_Hash_HmacSHA512(const InString, Password: String): String;
var
  input_bytes, input_password: TBytes;
begin
  input_bytes:=UnicodeStringToTBytes(InString);
  input_password:=UnicodeStringToTBytes(Password);
  try
    Result:=TBytesToHex(CryptoAPI_Hash_HmacSHA512(input_bytes, input_password));
  finally
    SetLength(input_password, 0);
    SetLength(input_bytes, 0);
  end;
end;

end.