本软件使用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;
EditCompare: TEdit;
LabelCompare: TLabel;
procedure ButtonHashClick(Sender: TObject);
procedure FormCreate(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;
procedure TFormMain.FormCreate(Sender: TObject);
begin
ReportMemoryLeaksOnShutDown := True;
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
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 13
object LabelSrc: TLabel
Left = 25
Top = 63
Width = 72
Height = 13
Caption = #21152#23494#30340#20869#23481#65306
end
object LabelDest: TLabel
Left = 28
Top = 146
Width = 60
Height = 13
Caption = #21152#23494#32467#26524#65306
end
object LabelCompare: TLabel
Left = 437
Top = 29
Width = 24
Height = 13
Caption = #23545#27604
end
object ButtonHash: TButton
Left = 272
Top = 122
Width = 75
Height = 25
Caption = 'Hash'
TabOrder = 0
OnClick = ButtonHashClick
end
object EditSrc: TEdit
Left = 24
Top = 82
Width = 585
Height = 21
TabOrder = 1
Text = '12345678901234567890123456789012345678901234567890123456'
end
object EditDest: TEdit
Left = 24
Top = 164
Width = 585
Height = 21
TabOrder = 2
end
object EditCompare: TEdit
Left = 464
Top = 26
Width = 145
Height = 21
TabOrder = 3
Text = 'https://lzltool.cn/SM3'
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;
case Byte of //杂凑值,8 UInt32 = 32 Bytes = 256 Bits
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 aBlock);
public
MsgBuffer: 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 //TSM3的基本使用方法演示
begin
MsgBuffer.FromString(S); //或FromHexString, FromBase64String等等
Hash;
Result := MsgBuffer.ToHexString; //或ToBase64String, ToDelimitedDecimalString等等
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;
MsgBuffer := TBuffer.Create;
end;
destructor TSM3.Destroy;
begin
MsgBuffer.Free;
inherited;
end;
procedure TSM3.Hash;
var
//S: String;
I, J: UInt64;
IV, NV: THash;
Memory: PByte;
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;
Memory := MsgBuffer.Memory;
for I := 0 to (MsgBuffer.Length div 64)-1 do
begin
ExpandMessage(Memory^); //生成每个Block的W, Wx: TWords
Inc(Memory, 64);
NV := IV;
for J := 0 to 63 do //压缩函数, 以初始值IV为基础迭代出新值NV
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;
//第I+1轮的杂凑值
for J := 0 to 7 do
begin
IV.Words[J] := NV.Words[J] xor IV.Words[J];
end;
//S:= IV.ToHexString.ToLower; //测试用
end;
MsgBuffer.Length := 32; //把hash值拷贝到Buffer
Memory := MsgBuffer.Memory;
for I := 0 to 7 do
begin
R := ReverseEndian(IV.Words[I]);
Move(R, Memory^, 4);
Inc(Memory, 4);
end;
end;
procedure TSM3.PadMessage; //填充到512bits(64bytes)的整数倍
var
P: PUInt64;
I, M, OldLen, NewLen: UInt64;
begin
OldLen := MsgBuffer.Length;
M := 64 - (OldLen mod 64);
NewLen := OldLen + M;
if M < 9 then Inc(NewLen, 64); //扩展的长度必须放得下$80和64bit(8byte)整数
MsgBuffer.Length := NewLen;
MsgBuffer[OldLen] := $80;
for I := OldLen+1 to NewLen-1-8 do
begin
MsgBuffer[I] := $0;
end;
P := PUInt64(MsgBuffer.Memory + NewLen-8);
P^ := ReverseEndian(OldLen*8); //64bit整数改为大端(BigEndian)
end;
procedure TSM3.ExpandMessage(var aBlock); //扩展消息,生成W和Wx
var
J: Integer;
Block: TBlock absolute aBlock;
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
Data: TBytes;
function GetMemory: PByte; inline;
function GetDataLength: Integer; inline;
procedure SetDataLength(Len: Integer); inline;
function GetItem(Index: Integer): Byte; inline;
procedure SetItem(Index: Integer; Value: Byte); inline;
public
procedure FromString(const S: String); overload; //默认为utf8
procedure FromString(const S: String; Encoding: TEncoding); overload;
procedure FromDelimitedDecimalString(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 ToDelimitedDecimalString(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 Memory: PByte read GetMemory;
property Length: Integer read GetDataLength write SetDataLength;
property Items[Index: Integer]: Byte read GetItem write SetItem; default;
end;
implementation
function TBuffer.GetMemory: PByte;
begin
Result := @Data[0];
end;
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.FromDelimitedDecimalString(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.ToDelimitedDecimalString(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.