[Delphi]一个功能完备的国密SM3类(TSM3)

本软件使用Delphi 10.3.3编写和测试, 源码中用到了System.NetEncoding单元, 因此本程序仅支持Delphi XE及更新的版本.

unit uMain;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Classes, Vcl.Graphics,  Vcl.Controls, Vcl.Forms, Vcl.Dialogs,
  Vcl.StdCtrls;

type
  TFormMain = class(TForm)
    ButtonHash: TButton;
    EditSrc: TEdit;
    EditDest: TEdit;
    LabelSrc: TLabel;
    LabelDest: TLabel;
    procedure ButtonHashClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  FormMain: TFormMain;

implementation

{$R *.dfm}

uses uBuffer, uSM3;

procedure TFormMain.ButtonHashClick(Sender: TObject);
begin
  EditDest.Text := SM3Hash(EditSrc.Text);
end;

end.

object FormMain: TFormMain
  Left = 0
  Top = 0
  Caption = 'FormMain'
  ClientHeight = 230
  ClientWidth = 635
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  Position = poScreenCenter
  PixelsPerInch = 96
  TextHeight = 13
  object LabelSrc: TLabel
    Left = 25
    Top = 45
    Width = 72
    Height = 13
    Caption = #21152#23494#30340#20869#23481#65306
  end
  object LabelDest: TLabel
    Left = 28
    Top = 128
    Width = 60
    Height = 13
    Caption = #21152#23494#32467#26524#65306
  end
  object ButtonHash: TButton
    Left = 272
    Top = 104
    Width = 75
    Height = 25
    Caption = 'Hash'
    TabOrder = 0
    OnClick = ButtonHashClick
  end
  object EditSrc: TEdit
    Left = 24
    Top = 64
    Width = 585
    Height = 21
    TabOrder = 1
    Text = '1234567890123456789012345678901234567890123456789012345'
  end
  object EditDest: TEdit
    Left = 24
    Top = 146
    Width = 585
    Height = 21
    TabOrder = 2
  end
end

unit uSM3;

interface

uses
  System.SysUtils, Winapi.Windows, System.Classes, uBuffer;

type
  TSM3 = class(TObject)
  private type
    TWord   = UInt32; //长度为32的比特串, 一个字
    TBlock  = array[0..16-1] of TWord; //消息，16 UInt32、64 Bytes、512 Bits
    THash = record
              function ToHexString: String; //杂凑值，8 UInt32、32 Bytes、256 Bits
              case Byte of
                0: (A, B, C, D, E, F, G, H: TWord);
                1: (Words: array[0..8-1] of TWord);
            end;
  private
    W : array[0..68-1] of TWord; //消息扩展
    Wx: array[0..64-1] of TWord; //消息扩展
    function ReverseEndian(A: TWord): TWord; overload;
    function ReverseEndian(A: UInt64): UInt64; overload;
    function ROTL(X: TWord; N: Byte): TWord; inline;
    function T(J: Byte): TWord;  inline;
    function FF(X, Y, Z: TWord; J: Byte): TWord; inline;
    function GG(X, Y, Z: TWord; J: Byte): TWord; inline;
    function P0(X: TWord): TWord; inline;
    function P1(X: TWord): TWord; inline;
    procedure PadMessage;
    procedure ExpandMessage(var A);
  public
    Buffer: TBuffer;
    procedure Hash;
    constructor Create;
    destructor  Destroy; override;
  end;

function SM3Hash(const S: String): String;

implementation

function SM3Hash(const S: String): String;
begin
  with TSM3.Create do
  begin
    Buffer.FromString(S);
    Hash;
    Result := Buffer.ToHexString;
    Free;
  end;
end;

function TSM3.THash.ToHexString: String;
var
  I: Integer;
begin
  Result := '';
  for I := 0 to 7 do
  begin
    if I >0 then Result := Result + ', ';
    Result := Result + IntToHex(Words[I])
  end;
end;

constructor TSM3.Create;
begin
  inherited;
  Buffer := TBuffer.Create;
end;

destructor TSM3.Destroy;
begin
  Buffer.Free;
  inherited;
end;

procedure TSM3.Hash;
var
//S: String;
  I, J: UInt64;
  IV, NV: THash;
  SS1, SS2, TT1, TT2, R: TWord;
begin
  PadMessage; //填充到512bits(64Bytes)整数

  with IV do //初始值
  begin
    A := $7380166f;
    B := $4914b2b9;
    C := $172442d7;
    D := $da8a0600;
    E := $a96f30bc;
    F := $163138aa;
    G := $e38dee4d;
    H := $b0fb0e4e;
  end;

  for I := 0 to (Length(Buffer.Data) div 64)-1 do
  begin
    ExpandMessage(Buffer.Data[I*64]); //生成W, Wx: TWords
    NV := IV;
    for J := 0 to 63 do
    begin
      with NV do
      begin
        SS1 := ROTL((ROTL(A, 12) + E + ROTL(T(J), J)), 7);
        SS2 := SS1 xor ROTL(A, 12);
        TT1 := FF(A, B, C, J) + D + SS2 + Wx[J];
        TT2 := GG(E, F, G, J) + H + SS1 + W[J];
        D := C;
        C := ROTL(B, 9);
        B := A;
        A := TT1;
        H := G;
        G := ROTL(F, 19);
        F := E;
        E := P0(TT2);
      end;
      //S:= NV.ToHexString.ToLower;
    end;

    for J := 0 to 7 do
    begin
      IV.Words[J] := NV.Words[J] xor IV.Words[J];
    end;
    //S:= IV.ToHexString.ToLower;
  end;

  SetLength(Buffer.Data, 32);
  for I := 0 to 7 do
  begin
    R := ReverseEndian(IV.Words[I]);
    Move(R, Buffer.Data[4*I], 4);
  end;
end;

procedure TSM3.PadMessage; //填充到512bits(64bytes)的整数倍
var
  P: PUInt64;
  I, M, Len1, Len2: UInt64;
begin
  Len1 := Length(Buffer.Data);
  M := 64 - (Len1 mod 64);
  Len2 := Len1 + M;
  if M < 9  then  Inc(Len2, 64); //扩展的长度必须放得下$80和64bit(8byte)整数
  SetLength(Buffer.Data, Len2);
  Buffer.Data[Len1] := $80;
  for I := Len1+1 to Len2-1-8 do
  begin
    Buffer.Data[I] := $0;
  end;
  P := @(Buffer.Data[Len2-8]);
  P^ := ReverseEndian(Len1*8);  //64bit整数改为大端
end;

procedure TSM3.ExpandMessage(var A); //扩展消息，生成W和Wx
var
  J: Integer;
  Block: TBlock absolute A;
begin
  for J := 0 to 15 do
  begin
    W[J] := ReverseEndian(Block[J]); //32bit整数改为大端
  end;
  for J := 16 to 67 do
  begin
    W[J] := P1(W[J-16] xor W[J-9] xor ROTL(W[J-3], 15)) xor ROTL(W[J-13], 7) xor W[J-6];
  end;
  for J := 0 to 63 do
  begin
    Wx[J] := W[J] xor W[J+4];
  end;
end;

function TSM3.ReverseEndian(A: TWord): TWord;
begin
  Result := ( A shr 24) or
            ((A and $00FF0000) shr 8) or
            ((A and $0000FF00) shl 8) or
            ( A shl 24);
end;

function TSM3.ReverseEndian(A: UInt64): UInt64;
begin
  Result := ( A  shr 56) or
            ((A and $00FF000000000000) shr 40) or
            ((A and $0000FF0000000000) shr 24) or
            ((A and $000000FF00000000) shr 8 ) or
            ((A and $00000000FF000000) shl 8 ) or
            ((A and $0000000000FF0000) shl 24) or
            ((A and $000000000000FF00) shl 40) or
            ( A shl 56);
end;

function TSM3.ROTL(X: TWord; N: Byte): TWord;
begin
  Result := (X shl N) or (X shr (32 - N));
end;

function TSM3.T(J: Byte): TWord;
begin
  Assert(J <= 63);
  if J <= 15 then
    Result := $79cc4519
  else
    Result := $7a879d8a
end;

function TSM3.FF(X, Y, Z: TWord; J: Byte): TWord;
begin
  Assert(J <= 63);
  if J <= 15 then
    Result := X xor Y xor Z
  else
    Result := (X and Y) or (X and Z) or (Y and Z);
end;

function TSM3.GG(X, Y, Z: TWord; J: Byte): TWord;
begin
  if J < 16 then
    Result := X xor Y xor Z
  else
    Result := (X and Y) or ((not X) and Z);
end;

function TSM3.P0(X: TWord): TWord;
begin
  Result := X xor ROTL(X, 9) xor ROTL(X, 17);
end;

function TSM3.P1(X: TWord): TWord;
begin
  Result := X xor ROTL(X, 15) xor ROTL(X, 23);
end;

end.

unit uBuffer;

interface

uses
{$IF CompilerVersion <= 22}
  Forms, Classes, Windows, SysUtils, NetEncoding;
{$ELSE}
  Vcl.Forms, System.Classes, Winapi.Windows, System.SysUtils, System.NetEncoding;
{$ENDIF}

type
  TBuffer = class(TObject)
  private
    function  GetDataLength: Integer; inline;
    procedure SetDataLength(Len: Integer); inline;
    function  GetItem(Index: Integer): Byte; inline;
    procedure SetItem(Index: Integer; Value: Byte); inline;
  public
    Data: TBytes;
    procedure FromString(const S: String); overload;  //默认为utf8
    procedure FromString(const S: String; Encoding: TEncoding); overload;
    procedure FromDecimalList(const S: String; Delimitor: Char = ',');
    procedure FromHexString(const S: String);
    procedure FromDelimitedHexString(S: String; Prefix: String = '$'; Delimitor: String = ',');
    procedure FromBase64String(const S: String);
    procedure FromBytes(const Source; Len: Integer);
    procedure FromStream(const Stream: TStream; ByteLen: Integer = -1);
    procedure FromFile(const FileName: String);

    function  ToString: String; reintroduce; overload;  //默认为utf8
    function  ToString(Encoding: TEncoding): String; reintroduce; overload;
    function  ToDecimalList(Delimitor: Char = ','): String;
    function  ToHexString: String;
    function  ToDelimitedHexString(Prefix: String = '$'; Delimitor: String = ', '): String;
    function  ToBase64String: String;
    procedure ToBytes(var Dest; Len: Integer);
    procedure ToStream(const Stream: TStream);
    procedure ToFile(const FileName: String; Warning: Boolean = True);

    property  Length: Integer read GetDataLength write SetDataLength;
    property  Items[Index: Integer]: Byte read GetItem write SetItem; default;
  end;

implementation

function TBuffer.GetDataLength: Integer;
begin
  Result := System.Length(Data);
end;

procedure TBuffer.SetDataLength(Len: Integer);
begin
  System.SetLength(Data, Len);
end;

function  TBuffer.GetItem(Index: Integer): Byte;
begin
  Result := Data[Index];
end;

procedure TBuffer.SetItem(Index: Integer; Value: Byte);
begin
  Data[Index] := Value;
end;

procedure TBuffer.FromString(const S: String);
begin
  Data := TEncoding.UTF8.GetBytes(S);
end;

procedure TBuffer.FromString(const S: String; Encoding: TEncoding);
begin
  Data := Encoding.GetBytes(S);
end;

procedure TBuffer.FromDecimalList(const S: String; Delimitor: Char);
var
  I, Len: Integer;
  List: TStringList;
begin
  List := TStringList.Create;
  List.Delimiter := Delimitor;
  List.DelimitedText := S;
  Len := List.Count;
  SetLength(Data, Len);
  for I := 0 to Len-1 do
  begin
    Data[I] := StrToUInt(List[I]);
  end;
  List.Free;
end;

procedure TBuffer.FromHexString(const S: String);
var
  Len: Integer;
begin
  Len := System.Length(S) div 2;
  SetLength(Data, Len);
  HexToBin(PChar(S), @Data[0], Len)
end;

procedure TBuffer.FromDelimitedHexString(S: String; Prefix: String; Delimitor: String);
var
  Len: Integer;
begin
  S := S.Replace(Prefix   , '');
  S := S.Replace(Delimitor, '');
  S := S.Replace(' '      , '');
  Len := System.Length(S) div 2;
  SetLength(Data, Len);
  HexToBin(PChar(S), @Data[0], Len)
end;

procedure TBuffer.FromBase64String(const S: String);
var
  Base64Encoding: TBase64Encoding;
begin
//Base64Encoding := TBase64Encoding.Create; //含换行符
  Base64Encoding := TBase64Encoding.Create(0); //不含换行符
  Data := Base64Encoding.DecodeStringToBytes(S);
  Base64Encoding.Free;
end;

procedure TBuffer.FromBytes(const Source; Len: Integer);
begin
  SetLength(Data, Len);
  Move(Source, Data[0], Len);
end;

procedure TBuffer.FromStream(const Stream: TStream; ByteLen: Integer);
begin
  if (ByteLen = -1) then ByteLen := Stream.Size;
  SetLength(Data, ByteLen);
  Stream.Read(Data, ByteLen);
end;

procedure TBuffer.FromFile(const FileName: String);
var
  Stream: TFileStream;
begin
  Stream := TFileStream.Create(FileName, fmOpenRead);
  SetLength(Data, Stream.Size);
  Stream.Read(Data, Stream.Size);
  Stream.Free;
end;

function TBuffer.ToString: String;
begin
  Result := TEncoding.UTF8.GetString(Data);
end;

function TBuffer.ToString(Encoding: TEncoding): String;
begin
  Result := Encoding.GetString(Data);
end;

function TBuffer.ToDecimalList(Delimitor: Char): String;
var
  I: Integer;
begin
  Result := '';
  for I := 0 to System.Length(Data)-1 do
  begin
    if I > 0 then
    begin
      Result := Result + Delimitor + ' ';
    end;
    Result := Result +  Data[I].ToString
  end;
end;

function TBuffer.ToHexString: String;
var
  Len: Integer;
begin
  Len := System.Length(Data);
  SetLength(Result, 2*Len);
  BinToHex(@Data[0], PChar(Result), Len);
end;

function TBuffer.ToDelimitedHexString(Prefix: String; Delimitor: String): String;
var
  I, Len: Integer;
begin
  Result := '';
  Len := System.Length(Data);
  for I := 0 to Len-1 do
  begin
    Result := Result + Prefix + IntToHex(Data[I], 2);
    if I < Len-1 then
      Result := Result + Delimitor;
  end;
end;

function TBuffer.ToBase64String: String;
var
  Base64Encoding: TBase64Encoding;
begin
//Base64Encoding := TBase64Encoding.Create; //含换行符
  Base64Encoding := TBase64Encoding.Create(0); //不含换行符
  Result := Base64Encoding.EncodeBytesToString(Data);
  Base64Encoding.Free;
end;

procedure TBuffer.ToBytes(var Dest; Len: Integer);
begin
  Move(Data[0], Dest, Len);
end;

procedure TBuffer.ToStream(const Stream: TStream);
begin
  Stream.Write(Data, System.Length(Data));
end;

procedure TBuffer.ToFile(const FileName: String; Warning: Boolean);
var
  Stream: TFileStream;
begin
  if Warning and FileExists(FileName) and
     (Application.MessageBox(PChar('File ' + FileName + ' Exists, Overwrite It?'),
                  'Warning: File Exists', MB_YESNO) = IDNO)  then Exit;

  Stream := TFileStream.Create(FileName, fmCreate);
  Stream.Write(Data, System.Length(Data));
  Stream.Free;
end;

end.