Lazarus信创之路02：HMACSHA1签名算法

　　Lazarus下的HMACSHA1签名算法找了好久，终于在外网找到一段代码，又修改了一下，验证是可以的。

uses
  Classes, SysUtils, fphttpclient, md5, DCPsha1, dcpcrypt2, DCPbase64; 


function RPad(x: string; c: Char; s: Integer): string;
var
  i: Integer;
begin
  Result := x;
  if Length(x) < s then
    for i := 1 to s-Length(x) do
      Result := Result + c;
end;

function XorBlock(s, x: ansistring): ansistring; inline;
var
  i: Integer;
begin
  SetLength(Result, Length(s));
  for i := 1 to Length(s) do
    Result[i] := Char(Byte(s[i]) xor Byte(x[i]));
end;

function CalcDigest(text: string; dig: TDCP_hashclass): string;
var
  x: TDCP_hash;
begin
  x := dig.Create(nil);
  try
    x.Init;
    x.UpdateStr(text);
    SetLength(Result, x.GetHashSize div 8);
    x.Final(Result[1]);
  finally
    x.Free;
  end;
end;

function CalcHMAC(message, key: string; hash: TDCP_hashclass): string;
const
  blocksize = 64;
begin
  // Definition RFC 2104
  if Length(key) > blocksize then
    key := CalcDigest(key, hash);
  key := RPad(key, #0, blocksize);

  Result := CalcDigest(XorBlock(key, RPad('', #$36, blocksize)) + message, hash);
  Result := CalcDigest(XorBlock(key, RPad('', #$5c, blocksize)) + result, hash);
end;


// 签名采用HmacSHA1算法 + Base64，编码采用：UTF-8
function Sign(const sData, sKey: string): string;
begin
  Result := Base64EncodeStr(CalcHMAC(sData, sKey, TDCP_sha1));
end;