[Delphi]一个功能完备的国密SM4类(TSM4)[20230329更新]

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

支持6种加密模式: ECB, CBC, CFB, OFB, PCBC, CTR; 默认为ECB;

支持7种填充模式(ZERO, PKCS5, PKCS7, ISO10126, ANSIX923, OneAndZero); 默认为PKCS7;

SM4要求密码长度的长度为16个字节(128bit), 如果长度不足, 程序就填充0x00来补足

SM4要求初始向量的长度为16个字节(128bit), 如果长度不足, 程序就填充0x00来补足

SrcBuffer, KeyBuffer, IVBuffer, DestBuffer: TBuffer 说明:

SrcBuffer存放待加密/解密的数据,

KeyBuffer存放密码数据,

IVBuffer存放初始向量数据,

DestBuffer存放已加密/解密的数据

TBuffer本身带有各种数据转换函数, 数据转换非常方便,不需要另外再写代码,例如:

function ToString: String;

function ToString(Encoding: TEncoding): String;

function ToHexString: String;

function ToDelimitedHexString(Prefix: String; Delimitor: String): String;

function ToBase64String: String;

procedure ToBytes(var Dest; Len: Integer); overload;

procedure FromString(const Str: String);

procedure FromString(const Str: String; Encoding: TEncoding);

procedure FromHexString(const Str: String);

procedure FromDelimitedHexString(HexStr: String; Prefix: String; Delimitor: String');

procedure FromBase64String(const Str: String);

procedure FromBytes(const Source; Len: Integer); overload;

最简单的TSM4使用示范代码:

//最简单的使用示范
procedure TMainForm.Test;
var
  S1, S2: String;
begin
  with TSM4.Create(cmCBC, pmPKCS5) do
  begin
    SrcBuffer.FromString('先学着让自己值钱');
    KeyBuffer.FromBase64String('MTIzNDU2Nzg5MDEyMzQ1Ng=='); //1234567890123456
//或KeyBuffer.FromString('1234567890123456');
    IVBuffer.FromHexString('6162636465666768696A6B6C6D6E6F70'); //abcdefghijklmnop
    Encrypt;  //加密
    S1 := DestBuffer.ToHexString; //6C19FEC30147DBDE9539DC1DF0F3ACF09B6E6210F0F220D3D923F200DC5A44C4
    
    SrcBuffer.FromHexString(S1);
    Decrypt;  //解密
    S2 := DestBuffer.ToString; //'先学着让自己值钱'
    Free;
  end;
end;

完整的TSM4代码(包括测试代码)

unit uMain;

interface

uses
{$IF CompilerVersion <= 22}
  Windows, Messages, Generics.Collections, SysUtils,
  Variants, Classes, Graphics, Controls, Forms,
  Dialogs, NetEncoding, StdCtrls, uSM4;
{$ELSE}
  Winapi.Windows, Winapi.Messages, Generics.Collections, System.SysUtils,
  System.Variants, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms,
  Vcl.Dialogs, System.NetEncoding, Vcl.StdCtrls, uSM4;
{$ENDIF}

type
  TMainForm = class(TForm)
    LabelBlockMode: TLabel;
    LabelPaddingmode: TLabel;
    ComboBoxCipherMode: TComboBox;
    ComboBoxPaddingmode: TComboBox;
    LabelStr: TLabel;
    LabelIV: TLabel;
    LabelEnc: TLabel;
    LabelDec: TLabel;
    EditKey: TEdit;
    EditIV : TEdit;
    EditDec: TEdit;
    EditEnc: TEdit;
    EditStr: TEdit;
    LabelKey: TLabel;
    ButtonEncrypt: TButton;
    ButtonDecrypt: TButton;
    ComboBoxStr: TComboBox;
    ComboBoxKey: TComboBox;
    ComboBoxIV: TComboBox;
    ComboBoxEnc: TComboBox;
    ComboBoxDec: TComboBox;
    LabelStrCnt: TLabel;
    LabelKeyCnt: TLabel;
    LabelIVCnt : TLabel;
    LabelEncCnt: TLabel;
    LabelDecCnt: TLabel;
    EditSrc: TEdit;
    ButtonToHex: TButton;
    ButtonToBase64: TButton;
    EditDest: TEdit;
    RzEdit1: TEdit;
    Label1: TLabel;
    ButtonFromHex: TButton;
    ButtonFramBase64: TButton;
    Label2: TLabel;
    Label3: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure EditChange(Sender: TObject);
    procedure ButtonClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure ButtonConvertClick(Sender: TObject);
    procedure ButtonFromClick(Sender: TObject);
  private type
    TProc = procedure(const S: String) of object;
    Tfunc = function(): String of object;
    TFromDict = TDictionary;
    TToDict   = TDictionary;
    TCountDict = TDictionary;
  private
    DIctCm: TDictionary;
    DIctPm: TDictionary;
    DictFromStr, DictFromKey, DictFromIV, DictFromEnc: TFromDict;
    DictToEnc, DictToDec: TToDict;
    DictCount: TCountDict;
    procedure FillDicts(SM4: TSM4);
  public
    procedure SimpleDemo;
  end;

var
  MainForm: TMainForm;

implementation

{$R *.dfm}

procedure TMainForm.SimpleDemo;  //最简单使用示范代码
var
  S1, S2: String;
begin
  with TSM4.Create(cmCBC, pmPKCS5) do
  begin
    DataBuffer.FromString('先学着让自己值钱');
    KeyBuffer.FromBase64String('MTIzNDU2Nzg5MDEyMzQ1Ng=='); //1234567890123456
//或KeyBuffer.FromString('1234567890123456');
    IVBuffer.FromHexString('6162636465666768696A6B6C6D6E6F70'); //abcdefghijklmnop
    Encrypt;
    S1 := DataBuffer.ToHexString; //6C19FEC30147DBDE9539DC1DF0F3ACF09B6E6210F0F220D3D923F200DC5A44C4
    DataBuffer.FromHexString(S1);
    Decrypt;
    S2 := DataBuffer.ToString; //'先学着让自己值钱'
    Free;
  end;
end;

procedure TMainForm.FormCreate(Sender: TObject);
begin
  ReportMemoryLeaksOnShutDown := True;

  DIctCm := TDictionary.Create;
  DIctPm := TDictionary.Create;

  DictFromStr := TFromDict.Create;
  DictFromKey := TFromDict.Create;
  DictFromIV  := TFromDict.Create;
  DictFromEnc := TFromDict.Create;

  DictToEnc := TToDict.Create;
  DictToDec := TToDict.Create;

  DictCount := TCountDict.Create;

  with DIctCm do
  begin
    Add('ECB' , cmECB);
    Add('CBC' , cmCBC);
    Add('CFB' , cmCFB);
    Add('OFB' , cmOFB);
    Add('PCBC', cmPCBC);
    Add('CTR' , cmCTR);
  end;

  with DIctPm do
  begin
    Add('ZERO'      , pmZERO);
    Add('PKCS5'     , pmPKCS5);
    Add('PKCS7'     , pmPKCS7);
    Add('ISO10126'  , pmISO10126);
    Add('ANSIX923'  , pmANSIX923);
    Add('OneAndZero', pmOneAndZero);
  end;

  with DictCount do
  begin
    Add(EditStr, LabelStrCnt);
    Add(EditKey, LabelKeyCnt);
    Add(EditIV , LabelIVCnt );
    Add(EditEnc, LabelEncCnt);
    Add(EditDec, LabelDecCnt);
  end;

  EditChange(nil);
end;

procedure TMainForm.FormDestroy(Sender: TObject);
begin
  DIctCm.Free;
  DIctPm.Free;

  DictFromStr.Free;
  DictFromKey.Free;
  DictFromIV.Free;
  DictFromEnc.Free;

  DictToEnc.Free;
  DictToDec.Free;

  DictCount.Free;
end;

procedure TMainForm.FillDicts(SM4: TSM4);
var
  DataBuffer, KeyBuffer, IVBuffer: TBuffer;
begin
  DataBuffer := SM4.DataBuffer;
  KeyBuffer := SM4.KeyBuffer;
  IVBuffer  := SM4.IVBuffer;

  with DictFromStr do
  begin
    Clear;
    Add('String', DataBuffer.FromString);
    Add('Hex'   , DataBuffer.FromHexString);
    Add('Base64', DataBuffer.FromBase64String);
  end;

  with DictFromKey do
  begin
    Clear;
    Add('String', KeyBuffer.FromString);
    Add('Hex'   , KeyBuffer.FromHexString);
    Add('Base64', KeyBuffer.FromBase64String);
  end;

  with DictFromIV do
  begin
    Clear;
    Add('String', IVBuffer.FromString);
    Add('Hex'   , IVBuffer.FromHexString);
    Add('Base64', IVBuffer.FromBase64String);
  end;

  with DictFromEnc do
  begin
    Clear;
    Add('Hex'   , DataBuffer.FromHexString);
    Add('Base64', DataBuffer.FromBase64String);
  end;

  with DictToEnc do
  begin
    Clear;
    Add('Hex'   , DataBuffer.ToHexString);
    Add('Base64', DataBuffer.ToBase64String);
  end;

  with DictToDec do
  begin
    Clear;
    Add('String', DataBuffer.ToString);
    Add('Hex'   , DataBuffer.ToHexString);
    Add('Base64', DataBuffer.ToBase64String);
  end;

end;

procedure TMainForm.ButtonConvertClick(Sender: TObject);
begin
  with TBuffer.Create do
  begin
    FromString(EditSrc.Text);
    if Sender = ButtonToHex then
      EditDest.Text := ToHexString
    else
      EditDest.Text := ToBase64String;
    Free;
  end;
end;

procedure TMainForm.ButtonFromClick(Sender: TObject);
begin
  with TBuffer.Create do
  begin
    if Sender = ButtonFromHex then
      FromHexString(EditDest.Text)
    else
      FromBase64String(EditDest.Text);
    EditSrc.Text := ToString;
    Free;
  end;
end;

procedure TMainForm.ButtonClick(Sender: TObject);
var
  SM4: TSM4;
begin
  SM4 := TSM4.Create(DIctCm.Items[ComboBoxCipherMode.Text],
                     DIctPm.Items[ComboBoxPaddingMode.Text]);
  try
    FillDicts(SM4);
    DictFromKey.Items[ComboBoxKey.Text](EditKey.Text);
    DictFromIV.Items[ComboBoxIV.Text](EditIV.Text);
    if Sender = ButtonEncrypt then
    begin
      DictFromStr.Items[ComboBoxStr.Text](EditStr.Text);
      SM4.Encrypt;
      EditEnc.Text := DictToEnc.Items[ComboBoxEnc.Text]();
    end
    else
    begin
      DictFromEnc.Items[ComboBoxEnc.Text](EditEnc.Text);
      SM4.Decrypt;
      EditDec.Text := DictToDec.Items[ComboBoxDec.Text]();
    end;
  except
  end;
  SM4.Free;
end;

procedure TMainForm.EditChange(Sender: TObject);
var
  Edit: TEdit;
begin
  if Sender <> nil then
  begin
    Edit := TEdit(Sender);
    DictCount.Items[Edit].Caption := Length(Edit.Text).ToString;
  end
  else
  begin
    for Edit in DictCount.Keys do
    begin
      DictCount.Items[Edit].Caption := Length(Edit.Text).ToString;
    end;
  end;
end;

end.

object MainForm: TMainForm
  Left = 0
  Top = 0
  Caption = 'SM4'#21152#23494#35299#23494#27979#35797
  ClientHeight = 452
  ClientWidth = 788
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  Position = poScreenCenter
  OnCreate = FormCreate
  OnDestroy = FormDestroy
  DesignSize = (
    788
    452)
  PixelsPerInch = 96
  TextHeight = 13
  object LabelBlockMode: TLabel
    Left = 5
    Top = 108
    Width = 48
    Height = 13
    Caption = #21152#23494#27169#24335
  end
  object LabelPaddingmode: TLabel
    Left = 132
    Top = 108
    Width = 48
    Height = 13
    Caption = #22635#20805#27169#24335
  end
  object LabelStr: TLabel
    Left = 28
    Top = 149
    Width = 24
    Height = 13
    Caption = #26126#25991
  end
  object LabelIV: TLabel
    Left = 4
    Top = 234
    Width = 48
    Height = 13
    Caption = #21021#22987#21521#37327
  end
  object LabelEnc: TLabel
    Left = 26
    Top = 314
    Width = 24
    Height = 13
    Caption = #23494#25991
  end
  object LabelDec: TLabel
    Left = 26
    Top = 402
    Width = 24
    Height = 13
    Caption = #26126#25991
  end
  object LabelKey: TLabel
    Left = 26
    Top = 193
    Width = 24
    Height = 13
    Caption = #23494#30721
  end
  object LabelStrCnt: TLabel
    Left = 758
    Top = 150
    Width = 24
    Height = 13
    Anchors = [akTop, akRight]
    Caption = #23383#25968
  end
  object LabelKeyCnt: TLabel
    Left = 758
    Top = 192
    Width = 24
    Height = 13
    Anchors = [akTop, akRight]
    Caption = #23383#25968
  end
  object LabelIVCnt: TLabel
    Left = 758
    Top = 234
    Width = 24
    Height = 13
    Anchors = [akTop, akRight]
    Caption = #23383#25968
  end
  object LabelEncCnt: TLabel
    Left = 758
    Top = 314
    Width = 24
    Height = 13
    Anchors = [akTop, akRight]
    Caption = #23383#25968
  end
  object LabelDecCnt: TLabel
    Left = 758
    Top = 400
    Width = 24
    Height = 13
    Anchors = [akTop, akRight]
    Caption = #23383#25968
  end
  object Label1: TLabel
    Left = 5
    Top = 35
    Width = 48
    Height = 13
    Caption = #23545#27604#32467#26524
  end
  object Label2: TLabel
    Left = 512
    Top = 1
    Width = 28
    Height = 13
    Caption = 'String'
  end
  object Label3: TLabel
    Left = 494
    Top = 64
    Width = 89
    Height = 13
    Caption = 'Hex/Base64 [utf8]'
  end
  object ComboBoxCipherMode: TComboBox
    Left = 59
    Top = 105
    Width = 54
    Height = 21
    TabOrder = 0
    Text = 'ECB'
    Items.Strings = (
      'ECB'
      'CBC'
      'PCBC'
      'CFB'
      'OFB'
      'CTR')
  end
  object ComboBoxPaddingmode: TComboBox
    Left = 185
    Top = 105
    Width = 68
    Height = 21
    TabOrder = 1
    Text = 'PKCS7'
    Items.Strings = (
      'ZERO'
      'PKCS5'
      'PKCS7'
      'ANSIX923'
      'OneAndZero'
      'ISO10126'
      '')
  end
  object EditKey: TEdit
    Left = 119
    Top = 188
    Width = 633
    Height = 21
    Anchors = [akLeft, akTop, akRight]
    TabOrder = 2
    Text = '1234567890123456'
    OnChange = EditChange
  end
  object EditIV: TEdit
    Left = 119
    Top = 230
    Width = 633
    Height = 21
    Anchors = [akLeft, akTop, akRight]
    TabOrder = 3
    Text = 'abcdefghijklmnop'
    OnChange = EditChange
  end
  object EditDec: TEdit
    Left = 119
    Top = 396
    Width = 633
    Height = 21
    Anchors = [akLeft, akTop, akRight]
    TabOrder = 4
    OnChange = EditChange
  end
  object EditEnc: TEdit
    Left = 119
    Top = 310
    Width = 633
    Height = 21
    Anchors = [akLeft, akTop, akRight]
    TabOrder = 5
    OnChange = EditChange
  end
  object EditStr: TEdit
    Left = 119
    Top = 146
    Width = 633
    Height = 21
    Anchors = [akLeft, akTop, akRight]
    TabOrder = 6
    Text = #20808#23398#30528#35753#33258#24049#20540#38065
    OnChange = EditChange
  end
  object ButtonEncrypt: TButton
    Left = 329
    Top = 268
    Width = 137
    Height = 24
    Caption = #21152#23494
    TabOrder = 7
    OnClick = ButtonClick
  end
  object ButtonDecrypt: TButton
    Left = 329
    Top = 351
    Width = 137
    Height = 24
    Caption = #35299#23494
    TabOrder = 8
    OnClick = ButtonClick
  end
  object ComboBoxStr: TComboBox
    Left = 57
    Top = 146
    Width = 58
    Height = 21
    TabOrder = 9
    Text = 'String'
    Items.Strings = (
      'String'
      'Hex'
      'Base64')
  end
  object ComboBoxKey: TComboBox
    Left = 57
    Top = 188
    Width = 58
    Height = 21
    TabOrder = 10
    Text = 'String'
    Items.Strings = (
      'String'
      'Hex'
      'Base64')
  end
  object ComboBoxIV: TComboBox
    Left = 57
    Top = 230
    Width = 58
    Height = 21
    TabOrder = 11
    Text = 'String'
    Items.Strings = (
      'String'
      'Hex'
      'Base64')
  end
  object ComboBoxEnc: TComboBox
    Left = 57
    Top = 310
    Width = 58
    Height = 21
    TabOrder = 12
    Text = 'Hex'
    Items.Strings = (
      'Hex'
      'Base64')
  end
  object ComboBoxDec: TComboBox
    Left = 57
    Top = 396
    Width = 58
    Height = 21
    TabOrder = 13
    Text = 'String'
    Items.Strings = (
      'String'
      'Hex'
      'Base64')
  end
  object EditSrc: TEdit
    Left = 361
    Top = 16
    Width = 345
    Height = 21
    Anchors = [akLeft, akTop, akRight]
    TabOrder = 14
    Text = #20808#23398#30528#35753#33258#24049#20540#38065
  end
  object ButtonToHex: TButton
    Left = 293
    Top = 41
    Width = 62
    Height = 22
    Caption = 'ToHex'
    TabOrder = 15
    OnClick = ButtonConvertClick
  end
  object ButtonToBase64: TButton
    Left = 713
    Top = 41
    Width = 65
    Height = 22
    Anchors = [akTop, akRight]
    Caption = 'ToBase64'
    TabOrder = 16
    OnClick = ButtonConvertClick
  end
  object EditDest: TEdit
    Left = 361
    Top = 41
    Width = 345
    Height = 21
    Anchors = [akLeft, akTop, akRight]
    TabOrder = 17
  end
  object RzEdit1: TEdit
    Left = 57
    Top = 32
    Width = 196
    Height = 21
    TabOrder = 18
    Text = 'https://javalang.cn/crypto/sm4.html'
  end
  object ButtonFromHex: TButton
    Left = 294
    Top = 16
    Width = 61
    Height = 22
    Caption = 'FromHex'
    TabOrder = 19
    OnClick = ButtonFromClick
  end
  object ButtonFramBase64: TButton
    Left = 713
    Top = 15
    Width = 65
    Height = 22
    Anchors = [akTop, akRight]
    Caption = 'FromBase64'
    TabOrder = 20
    OnClick = ButtonFromClick
  end
end

unit uSM4;

{procedure SimpleDemo;  //最简单使用示范代码
var
  S1, S2: String;
begin
  with TSM4.Create(cmCBC, pmPKCS5) do
  begin
    DataBuffer.FromString('先学着让自己值钱');
    KeyBuffer.FromBase64String('MTIzNDU2Nzg5MDEyMzQ1Ng=='); //1234567890123456
    IVBuffer.FromHexString('6162636465666768696A6B6C6D6E6F70'); //abcdefghijklmnop
    Encrypt;
    S1 := DataBuffer.ToHexString; //6C19FEC30147DBDE9539DC1DF0F3ACF09B6E6210F0F220D3D923F200DC5A44C4

    DataBuffer.FromHexString(S1);
    Decrypt;
    S2 := DataBuffer.ToString; //'先学着让自己值钱'
    Free;
  end;
end;}

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;
    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 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  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  Bytes[Index: Integer]: Byte read GetItem write SetItem; default;
  end;

  TCipherMode  = (cmECB, cmCBC, cmPCBC, cmCFB, cmOFB, cmCTR);
  TPaddingMode = (pmZERO, pmPKCS5, pmPKCS7, pmISO10126, pmANSIX923, pmOneAndZero);

  TSM4 = class(TObject)
  private type
    TWord = UInt32; //4 Bytes
    TBlock = array[0..4-1] of TWord;
    TRoundKey = array[0..32-1] of TWord;
    TCryptType = (ctEncrypt, ctDecrypt);
  private const
    BlockSize = 4 * SizeOf(TWord); //16 Bytes
  private
    RoundKey: TRoundKey;
    KeyBlock, IVBlock, InBlock: TBlock;
    CipherMode : TCipherMode;
    PaddingMode: TPaddingMode;
    CryptType: TCryptType;
    procedure AppendPadding;
    procedure RemovePadding;
    procedure Crypt;
    procedure CipherBlock(var aDataBlock);
    procedure CheckKeyBufferAndIVBuffer;
    procedure ExpandKey;
    procedure CryptBlock(const aCryptType: TCryptType; var A: TBlock);
    function  SBoxMap(A: TWord): TWord;
    function  ROTL(A: TWord; N: Byte): TWord;
    procedure ReverseEndian(var A: TBlock);
    procedure XorBlock(var A: TBlock; const B: TBlock); overload;
    procedure XorBlock(var A: TBlock; const B, C: TBlock); overload;
    procedure IncBlock(Var A: TBlock);
  public
    DataBuffer, KeyBuffer, IVBuffer: TBuffer;
    procedure Encrypt;
    procedure Decrypt;
    constructor Create(aCipherMode: TCipherMode  = cmECB;
                      aPaddingMode: TPaddingMode = pmPKCS7);
    destructor Destroy; override;
  end;

implementation

const
// S盒
  Sbox: array[0..255] of Byte = (
    $d6,$90,$e9,$fe,$cc,$e1,$3d,$b7,$16,$b6,$14,$c2,$28,$fb,$2c,$05,
    $2b,$67,$9a,$76,$2a,$be,$04,$c3,$aa,$44,$13,$26,$49,$86,$06,$99,
    $9c,$42,$50,$f4,$91,$ef,$98,$7a,$33,$54,$0b,$43,$ed,$cf,$ac,$62,
    $e4,$b3,$1c,$a9,$c9,$08,$e8,$95,$80,$df,$94,$fa,$75,$8f,$3f,$a6,
    $47,$07,$a7,$fc,$f3,$73,$17,$ba,$83,$59,$3c,$19,$e6,$85,$4f,$a8,
    $68,$6b,$81,$b2,$71,$64,$da,$8b,$f8,$eb,$0f,$4b,$70,$56,$9d,$35,
    $1e,$24,$0e,$5e,$63,$58,$d1,$a2,$25,$22,$7c,$3b,$01,$21,$78,$87,
    $d4,$00,$46,$57,$9f,$d3,$27,$52,$4c,$36,$02,$e7,$a0,$c4,$c8,$9e,
    $ea,$bf,$8a,$d2,$40,$c7,$38,$b5,$a3,$f7,$f2,$ce,$f9,$61,$15,$a1,
    $e0,$ae,$5d,$a4,$9b,$34,$1a,$55,$ad,$93,$32,$30,$f5,$8c,$b1,$e3,
    $1d,$f6,$e2,$2e,$82,$66,$ca,$60,$c0,$29,$23,$ab,$0d,$53,$4e,$6f,
    $d5,$db,$37,$45,$de,$fd,$8e,$2f,$03,$ff,$6a,$72,$6d,$6c,$5b,$51,
    $8d,$1b,$af,$92,$bb,$dd,$bc,$7f,$11,$d9,$5c,$41,$1f,$10,$5a,$d8,
    $0a,$c1,$31,$88,$a5,$cd,$7b,$bd,$2d,$74,$d0,$12,$b8,$e5,$b4,$b0,
    $89,$69,$97,$4a,$0c,$96,$77,$7e,$65,$b9,$f1,$09,$c5,$6e,$c6,$84,
    $18,$f0,$7d,$ec,$3a,$dc,$4d,$20,$79,$ee,$5f,$3e,$d7,$cb,$39,$48
  );

// 密钥扩展算法的常数FK
  FK: array[0..3] of UInt32 = ($a3b1bac6, $56aa3350, $677d9197, $b27022dc);

// 密钥扩展算法的固定参数CK
  CK: array[0..31] of UInt32 = (
    $00070e15, $1c232a31, $383f464d, $545b6269,
    $70777e85, $8c939aa1, $a8afb6bd, $c4cbd2d9,
    $e0e7eef5, $fc030a11, $181f262d, $343b4249,
    $50575e65, $6c737a81, $888f969d, $a4abb2b9,
    $c0c7ced5, $dce3eaf1, $f8ff060d, $141b2229,
    $30373e45, $4c535a61, $686f767d, $848b9299,
    $a0a7aeb5, $bcc3cad1, $d8dfe6ed, $f4fb0209,
    $10171e25, $2c333a41, $484f565d, $646b7279
);

constructor TSM4.Create(aCipherMode: TCipherMode; aPaddingMode: TPaddingMode);
begin
  inherited Create;
  CipherMode  := aCipherMode;
  PaddingMode := aPaddingMode;
  DataBuffer := TBuffer.Create;
  KeyBuffer  := TBuffer.Create;
  IVBuffer   := TBuffer.Create;
end;

destructor TSM4.Destroy;
begin
  DataBuffer.Free;
  KeyBuffer.Free;
  IVBuffer.Free;
  inherited;
end;

procedure TSM4.Encrypt;
begin
  AppendPadding;
  CryptType := ctEncrypt;
  Crypt;
end;

procedure TSM4.Decrypt;
begin
  CryptType := ctDecrypt;
  Crypt;;
  RemovePadding;
end;

procedure TSM4.AppendPadding; //添加填充
var
  I, M, N, Len, NewLen: Integer;
begin
  Len := DataBuffer.Length;
  M := (Len mod BlockSize);
  if  (PaddingMode = pmZERO) and (M = 0) then
    N := 0
  else
    N := BlockSize - M;
  NewLen := Len + N;
  DataBuffer.Length := NewLen;

  case PaddingMode of
    pmPKCS5, pmPKCS7:
    begin
      for I := Len to NewLen-1 do DataBuffer[I] := N;
    end;
    pmANSIX923:
    begin
      for I := Len to NewLen-1 do
      begin
        if I < NewLen-1 then
          DataBuffer[I] := 0
        else
          DataBuffer[I] := N;
      end;
    end;
    pmISO10126:
    begin
      Randomize;
      for I := Len to NewLen-1 do
      begin
        if I < NewLen-1 then
          DataBuffer[I] := Random(255)
        else
          DataBuffer[I] := N;
      end;
    end;
    pmZERO:
    begin
      for I := Len to NewLen-1 do DataBuffer[I] := 0;
    end;
    pmOneAndZero:
    begin
      for I := Len to NewLen-1 do
      begin
        if I = Len then
          DataBuffer[I] := $80
        else
          DataBuffer[I] := 0;
      end;
    end;
  end;
end;

procedure TSM4.RemovePadding; //移除填充
var
  I, M, Len: Integer;
begin
  Len := DataBuffer.Length;
  case PaddingMode of
    pmPKCS5, pmPKCS7, pmANSIX923, pmISO10126:
    begin
      M := DataBuffer[Len-1];
      DataBuffer.Length := Len-M;
    end;
    pmZERO:
    begin
      for I := Len-1 downto 0 do
      begin
        if DataBuffer[I] = 0 then
          Dec(Len)
        else
          Break;
      end;
      DataBuffer.Length := Len;
    end;
    pmOneAndZero:
    begin
      for I := Len-1 downto 0 do
      begin
        if DataBuffer[I] <> $80 then
          Dec(Len)
        else
          Break;
      end;
      DataBuffer.Length := Len-1;
    end;
  end;
end;

procedure TSM4.CheckKeyBufferAndIVBuffer; //对Key和IV不足16Bytes的情况以0填足
var
  I, Len: Integer;
begin
  Len := KeyBuffer.Length;
  KeyBuffer.Length := BlockSize;
  for I := Len to BlockSize - 1 do
  begin
    KeyBuffer[I] := 0;
  end;

  if CipherMode <> cmECB then //ECB模式不需要初始向量IV
  begin
    Len := IVBuffer.Length;
    IVBuffer.Length := BlockSize;
    for I := Len to BlockSize - 1 do
    begin
      IVBuffer[I] := 0;
    end;
  end;
end;

procedure TSM4.Crypt;
var
  I: Integer;
  Memory: PByte;
begin
  CheckKeyBufferAndIVBuffer;

  KeyBuffer.ToBytes(KeyBlock, BlockSize);
  ExpandKey;

  if CipherMode <> cmECB then
  begin
    IVBuffer.ToBytes(IVBlock, BlockSize);
  end;

  Memory := DataBuffer.Memory;
  for I := 0 to (DataBuffer.Length div BlockSize)-1 do
  begin
    CipherBlock(Memory^);  //为提高效率, 加密过程直接使用了DataBuffer的内存
    Inc(Memory, BlockSize);    //以减少内存来回拷贝的操作
  end;
end;

procedure TSM4.CipherBlock(var aDataBlock);
var
  DataBlock: TBlock absolute aDataBlock;   //16 bytes -> 1 Block
begin
  case CipherMode of
    cmECB: //Electronic Codebook (ECB)
      begin
        CryptBlock(CryptType, DataBlock);
      end;
    cmCBC: //Cipher Block Chaining (CBC)
      begin
        if CryptType = ctEncrypt then
        begin
          XorBlock(DataBlock, IVBlock);
          CryptBlock(CryptType, DataBlock);
          IVBlock := DataBlock;
        end
        else
        begin
          InBlock := DataBlock;
          CryptBlock(CryptType, DataBlock);
          XorBlock(DataBlock, IVBlock);
          IVBlock := InBlock;
        end;
      end;
    cmPCBC: //Propagating Cipher Block Chaining (PCBC)
      begin
        InBlock := DataBlock;
        if CryptType = ctEncrypt then
        begin
          XorBlock(DataBlock, IVBlock);
          CryptBlock(CryptType, DataBlock);
        end
        else
        begin
          CryptBlock(CryptType, DataBlock);
          XorBlock(DataBlock, IVBlock);
        end;
        XorBlock(IVBlock, DataBlock, InBlock);
      end;
    cmCFB: //Cipher Feedback (CFB)
      begin
        InBlock := DataBlock;
        CryptBlock(ctEncrypt, IVBlock); //不管是加密还是解密，这里都是用Encrypt对IV进行操作
        XorBlock(DataBlock, IVBlock);
        if CryptType = ctEncrypt then
          IVBlock := DataBlock
        else
          IVBlock  := InBlock;
      end;
    cmOFB: //Output Feedback (OFB)
      begin
        CryptBlock(ctEncrypt, IVBlock); //不管是加密还是解密，这里都是用Encrypt对IV进行操作
        XorBlock(DataBlock, IVBlock);
      end;
    cmCTR: //Counter (CTR)
      begin
        InBlock := IVBlock;
        CryptBlock(ctEncrypt, InBlock); //不管是加密还是解密，这里都是用Encrypt对IV进行操作
        XorBlock(DataBlock, InBlock);
        IncBlock(IVBlock);
      end;
  end;
end;

procedure TSM4.ExpandKey;
  function Transform(A: TWord): TWord; //合成置换
  begin
    A := SBoxMap(A); //非线性变换
    Result := A xor ROTL(A, 13) xor ROTL(A, 23); //线性变换
  end;
var
  K: TBlock;
  I: Integer;
  M0, M1, M2, M3: TWord;
begin
  ReverseEndian(KeyBlock); //32整数转换为大端(Big Endian)格式

  for I := 0 to 3 do
  begin
    K[I] := KeyBlock[I] xor FK[I];
  end;

  for I := 0 to 31 do //32次迭代运算
  begin
    M0 := (I  ) mod 4;
    M1 := (I+1) mod 4;
    M2 := (I+2) mod 4;
    M3 := (I+3) mod 4;
    K[M0] := K[M0] xor Transform(K[M1] xor K[M2] xor K[M3] xor CK[I]); //迭代运算
    RoundKey[I] := K[M0];
  end;
end;

procedure TSM4.CryptBlock(const aCryptType: TCryptType; var A: TBlock);
  function TransForm(A: TWord): TWord; //合成置换
  begin
    A := SBoxMap(A); //非线性变换
    Result := A xor ROTL(A, 2) xor ROTL(A, 10) xor ROTL(A, 18) xor ROTL(A, 24); //线性变换
  end;
var
  T: TBlock;
  I,  R: Integer;
  M0, M1, M2, M3: TWord;
begin
  ReverseEndian(A); //32整数转换为大端(Big Endian)格式

  for I := 0 to 31 do  //32次迭代运算
  begin
    if aCryptType = ctEncrypt then
      R := I
    else
      R := 31 - I;  //解密时使用反序的RK

    M0 := (I  ) mod 4;
    M1 := (I+1) mod 4;
    M2 := (I+2) mod 4;
    M3 := (I+3) mod 4;

    A[M0] := A[M0] xor TransForm(A[M1] xor A[M2] xor A[M3] xor RoundKey[R]); //迭代运算
  end;

  ReverseEndian(A); //32整数转换为小端(Little Endian)格式

  T := A;
  for I := 0 to 3 do //Block内部的4个32位整数的位置做反序变换
  begin
    A[I] := T[3 - I];
  end;
end;

function TSM4.SBoxMap(A: TWord): TWord; //S盒非线性变换(Byte to Byte的固定映射}
var
  I: Integer;
  B: array[0..3] of Byte absolute A;
  R: array[0..3] of Byte absolute Result;
begin
  for I := 0 to 3 do
  begin
    R[I] := SBox[B[I]];
  end;
end;

procedure TSM4.ReverseEndian(var A: TBlock); //32位整数大小端(Endian)变换
var
  I: Integer;
begin
  for I := 0 to 3 do
  begin
    A[I] := ( A[I] shr 24) or
            ((A[I] and $00FF0000) shr 8 ) or
            ((A[I] and $0000FF00) shl 8 ) or
            ( A[I] shl 24);
  end;
end;

function TSM4.ROTL(A: TWord; N: Byte): TWord; //32位循环左移N位
begin
  Result := (A shl N) or (A shr (32-N));
end;

procedure TSM4.XorBlock(var A: TBlock; const B: TBlock); //两个Block异或
var
  I: Integer;
begin
  for I := 0 to 3 do
  begin
    A[I] := A[I] xor B[I];
  end;
end;

procedure TSM4.XorBlock(var A: TBlock; const B, C: TBlock); //两个Block异或
var
  I: Integer;
begin
  for I := 0 to 3 do
  begin
    A[I] := B[I] xor C[I];
  end;
end;

procedure TSM4.IncBlock(var A: TBlock); //Block值加1
var
  I: Integer;
begin
  for I := 0 to 3 do
  begin
    if I > 0 then
    begin
      A[I-1] := 0;
    end;
    if (I = 3) or (A[I] < $FFFFFFFF) then
    begin
      Inc(A[0]);
      Exit;
    end;
  end;
end;

//---------------------------------------------------------------------------//

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.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.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.