Delphi / 算法 · 2025年6月3日

Delphi实现SM4国密算法

从网上找到的算法,但是忘记了出处~ 如果作者看到了请联系我~

2025.06.03 使用该算法进行CTR加解密的时候, 与JAVA算法不兼容;但很奇怪的是,开头一点解密出来是正确的,所以确认算法问题不大,经过2天仔细阅读SM4 CTR算法文档和查资料,基本确定是随机数自增的地方出现了问题;然后在网上又搜索了一圈,发现了下面的代码不同

//之前的代码
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;
Pascal
//后面的代码
procedure TSM4.IncBlock(var A: TBlock); //Block值加1
var
  I: Integer;
  B: array[0..15] of Byte absolute A;
begin
  for I := 15 downto 0 do
  begin
    Inc(B[I]);
    if B[I] <> 0 then Break;
  end;
end;
Pascal

下面是完整的修复后的代码;目前使用了CBC和CTR,有对通讯数据加解密的,也有对较大文件(几十M)加解密的,使用还是非常不错~~

unit uSM4;

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;
  B: array[0..15] of Byte absolute A;
begin
  for I := 15 downto 0 do
  begin
    Inc(B[I]);
    if B[I] <> 0 then Break;
  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.
JavaScript
//调用
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;
JavaScript