var
  g_nLastCryptError: DWORD = 0;
  g_strLastCryptErrorFunction: String = '';

function HMAC_COMMON( const K; KLen: Integer; const M; MLen: Integer; HashAlgorithm: ALG_ID; out Mac; MacLen: DWORD ): Boolean;

  procedure UpdateLastError( const SFunction: String );
  begin
    g_nLastCryptError := GetLastError;
    g_strLastCryptErrorFunction := SFunction;
  end;

const
  BLOCK_SIZE = 64;
var
  i_key_pad: Array[ 0 .. BLOCK_SIZE - 1 ] of Byte;
  o_key_pad: Array[ 0 .. BLOCK_SIZE - 1 ] of Byte;

  hProv: HCRYPTPROV;
  hHash: HCRYPTHASH;
  len, cb, i: ULONG;
  f: BOOL;
  lpkeyhash1, lpkeyhash2, lpkey: PAnsiChar;
  c: Byte;
begin
  g_nLastCryptError := 0;
  lpkeyhash1 := nil;
  lpkeyhash2 := nil;

  f := CryptAcquireContext( @hProv, nil, MS_DEF_PROV, PROV_RSA_FULL, CRYPT_VERIFYCONTEXT or CRYPT_SILENT );
  if f then begin
    len := KLen;
    if len > BLOCK_SIZE then begin
      f := CryptCreateHash( hProv, HashAlgorithm, 0, 0, @hHash );
      if f then begin
        cb := sizeof( len );
        f := CryptHashData( hHash, @K, len, 0 ) and
             CryptGetHashParam( hHash, HP_HASHSIZE, @len, @cb, 0 );
        if f then begin
          GetMem( lpkeyhash1, len );
          f := CryptGetHashParam( hHash, HP_HASHVAL, PByte( lpkeyhash1 ), @len, 0 );
          if not f then
            UpdateLastError( 'CryptGetHashParam(HP_HASHVAL) (1)' );
        end else
          UpdateLastError( 'CryptHashData/CryptGetHashParam(HP_HASHSIZE)' );

        CryptDestroyHash( hHash );
      end else
        UpdateLastError( 'CryptCreateHash (1)' );
    end;

    if f then begin
      if Assigned( lpkeyhash1 ) then
        lpkey := lpkeyhash1
      else
        lpkey := @K;

      i := BLOCK_SIZE;
      repeat
        Dec( i );
        if i < len then
          c := Byte( lpkey[ i ] )
        else
          c := 0;

        i_key_pad[ i ] := $36 xor c;
        o_key_pad[ i ] := $5c xor c;
      until i = 0;

      f := CryptCreateHash( hProv, HashAlgorithm, 0, 0, @hHash );
      if f then begin
        cb := sizeof( len );
        f := CryptHashData( hHash, @i_key_pad, sizeof(i_key_pad), 0 ) and
             CryptHashData( hHash, @M, MLen, 0 ) and
             CryptGetHashParam( hHash, HP_HASHSIZE, @len, @cb, 0 );
        if f then begin
          GetMem( lpkeyhash2, len );
          f := CryptGetHashParam( hHash, HP_HASHVAL, PByte( lpkeyhash2 ), @len, 0 );
          if not f then
            UpdateLastError( 'CryptGetHashParam(HP_HASHVAL) (2)' );
        end else
          UpdateLastError( 'CryptHashData/CryptHashData/CryptGetHashParam(HP_HASHSIZE)' );

        CryptDestroyHash(hHash);

        if f then begin
          f := CryptCreateHash( hProv, HashAlgorithm, 0, 0, @hHash );
          if f then begin
            f := CryptHashData( hHash, @o_key_pad, sizeof( o_key_pad ), 0 ) and
                 CryptHashData( hHash, PByte( lpkeyhash2 ), len, 0 ) and
                 CryptGetHashParam( hHash, HP_HASHVAL, PByte( lpkeyhash2 ), @len, 0 );
            if not f then
              UpdateLastError( 'CryptHashData/CryptHashData/CryptGetHashParam(HP_HASHVAL)' );

            CryptDestroyHash(hHash);

            if f and ( len = MacLen ) then
              Move( lpkeyhash2^, Mac, len )
            else begin
              SetLastError( ERROR_INVALID_BLOCK );
              UpdateLastError( 'len != MacLen' );
            end;
          end else
            UpdateLastError( 'CryptCreateHash (3)' );
        end;
      end else
        UpdateLastError( 'CryptCreateHash (2)' );
    end;

    CryptReleaseContext( hProv, 0 );
  end else
    UpdateLastError( 'CryptAcquireContext' );

  if Assigned( lpkeyhash1 ) then
    FreeMem( lpkeyhash1 );

  if Assigned( lpkeyhash2 ) then
    FreeMem( lpkeyhash2 );

  Result := f;
end;

function EncodeBase64( Value: AnsiString ): AnsiString;
const
  b64alphabet: PAnsiChar = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';
  pad: PAnsiChar = '====';

  function EncodeChunk(const Chunk: String): String;
  var
    W: LongWord;
    i, n: Byte;
  begin
    n := Length(Chunk); W := 0;
    for i := 0 to n - 1 do
      W := W + Ord(Chunk[i + 1]) shl ((2 - i) * 8);
    Result := b64alphabet[(W shr 18) and $3f] +
              b64alphabet[(W shr 12) and $3f] +
              b64alphabet[(W shr 06) and $3f] +
              b64alphabet[(W shr 00) and $3f];
    if n <> 3 then
      Result := Copy(Result, 0, n + 1) + Copy(pad, 0, 3 - n);   //add padding when out len isn't 24 bits
  end;

var
  i, nLen, nEndLen: Integer;

begin
  Result := '';
  while Length(Value) > 0 do
  begin
    Result := Result + EncodeChunk(Copy(Value, 0, 3));
    Delete(Value, 1, 3);
  end;
end;