deccipher.pas

cipher 5.1。一个几乎包含了所有常见的加密算法的控件

    procedure DoDecode(Source, Dest: Pointer; Size: Integer); override;
  public
    class function Context: TCipherContext; override;
  published
    property Rounds: Integer read FRounds write SetRounds;
  end;

  TSAFERVersion = (svSK128, svSK64, svSK40, svK128, svK64, svK40);
{svK40       SAFER K-40    Keysize is 40bit  ->  5 Byte
 svK64       SAFER K-64    Keysize is 64bit  ->  8 Byte
 svK128      SAFER K-128   KeySize is 128bit -> 16 Byte
 svSK40      SAFER SK-40   stronger Version from K-40 with better Keyscheduling
 svSK64      SAFER SK-64   stronger Version from K-64 with better Keyscheduling
 svSK128     SAFER SK-128  stronger Version from K-128 with better Keyscheduling}

  TCipher_SAFER = class(TDECCipher) {SAFER = Secure And Fast Encryption Routine}
  private
    FRounds: Integer;
    FVersion: TSAFERVersion;
    procedure SetRounds(Value: Integer);
    procedure SetVersion(Value: TSAFERVersion);
  protected
    procedure DoInit(const Key; Size: Integer); override;
    procedure DoEncode(Source, Dest: Pointer; Size: Integer); override;
    procedure DoDecode(Source, Dest: Pointer; Size: Integer); override;
  public
    class function Context: TCipherContext; override;
  published
    property Rounds: Integer read FRounds write SetRounds;
    property Version: TSAFERVersion read FVersion write SetVersion;
  end;

  TCipher_Shark = class(TDECCipher)
  protected
    procedure DoInit(const Key; Size: Integer); override;
    procedure DoEncode(Source, Dest: Pointer; Size: Integer); override;
    procedure DoDecode(Source, Dest: Pointer; Size: Integer); override;
  public
    class function Context: TCipherContext; override;
  end;

  TCipher_Skipjack = class(TDECCipher)
  protected
    procedure DoInit(const Key; Size: Integer); override;
    procedure DoEncode(Source, Dest: Pointer; Size: Integer); override;
    procedure DoDecode(Source, Dest: Pointer; Size: Integer); override;
  public
    class function Context: TCipherContext; override;
  end;

  TCipher_TEA = class(TDECCipher) {Tiny Encryption Algorithm}
  private
    FRounds: Integer; {16 - 32, default 16 is sufficient, 32 is ample}
    procedure SetRounds(Value: Integer);
  protected
    procedure DoInit(const Key; Size: Integer); override;
    procedure DoEncode(Source, Dest: Pointer; Size: Integer); override;
    procedure DoDecode(Source, Dest: Pointer; Size: Integer); override;
  public
    class function Context: TCipherContext; override;
  published
    property Rounds: Integer read FRounds write SetRounds;
  end;

  TCipher_TEAN = class(TCipher_TEA) {Tiny Encryption Algorithm, extended Version}
  protected
    procedure DoEncode(Source, Dest: Pointer; Size: Integer); override;
    procedure DoDecode(Source, Dest: Pointer; Size: Integer); override;
  end;

function  ValidCipher(CipherClass: TDECCipherClass = nil): TDECCipherClass;
function  CipherByName(const Name: String): TDECCipherClass;
function  CipherByIdentity(Identity: LongWord): TDECCipherClass;
procedure SetDefaultCipherClass(CipherClass: TDECCipherClass = nil);

var
  StreamBufferSize: Integer = 8192;

implementation

uses TypInfo, DECData;

resourcestring
  sAlreadyPadded        = 'Cipher have already padded, can not process message';
  sInvalidState         = 'Cipher is not in valid state for this action';
  sInvalidMessageLength = 'Messagelength for %s must be a multiple of %d bytes';
  sKeyMaterialToLarge   = 'Keymaterial is to large as can be used, security issue';
  sIVMaterialToLarge    = 'Initvector is to large as can be used, security issue';
  sInvalidMACMode       = 'Invalid Cipher mode to compute MAC';
  sCipherNoDefault      = 'No default cipher are registered';

var
  FDefaultCipherClass: TDECCipherClass = nil;

function ValidCipher(CipherClass: TDECCipherClass): TDECCipherClass;
begin
  if CipherClass <> nil then Result := CipherClass
    else Result := FDefaultCipherClass;
  if Result = nil then raise EDECException.Create(sCipherNoDefault);
end;

function CipherByName(const Name: String): TDECCipherClass;
begin
  Result := TDECCipherClass(DECClassByName(Name, TDECCipher));
end;

function CipherByIdentity(Identity: LongWord): TDECCipherClass;
begin
  Result := TDECCipherClass(DECClassByIdentity(Identity, TDECCipher));
end;

procedure SetDefaultCipherClass(CipherClass: TDECCipherClass);
begin
  if CipherClass <> nil then CipherClass.Register;
  FDefaultCipherClass := CipherClass;
end;

procedure TDECCipher.SetMode(Value: TCipherMode);
begin
  if Value <> FMode then
  begin
    if not (FState in [csNew, csInitialized, csDone]) then Done;
    FMode := Value;
  end;
end;

procedure TDECCipher.CheckState(States: TCipherStates);
var
  S: String;
begin
  if not (FState in States) then
  begin
    if FState = csPadded then S := sAlreadyPadded
      else S := sInvalidState;
    raise EDECException.Create(S);
  end;
end;

constructor TDECCipher.Create;
var
  MustUserSaved: Boolean;
begin
  inherited Create;
  with Context do
  begin
    FBufferSize := BufferSize;
    FUserSize := UserSize;
    MustUserSaved := UserSave;
  end;
  FDataSize := FBufferSize * 3 + FUserSize;
  if MustUserSaved then Inc(FDataSize, FUserSize);
  ReallocMem(FData, FDataSize);
  FVector := @FData[0];
  FFeedback := @FVector[FBufferSize];
  FBuffer := @FFeedback[FBufferSize];
  FUser := @FBuffer[FBufferSize];
  if MustUserSaved then FUserSave := @PByteArray(FUser)[FUserSize]
    else FUserSave := nil;
  Protect;
end;

destructor TDECCipher.Destroy;
begin
  Protect;
  ReallocMem(FData, 0);
  FVector := nil;
  FFeedback := nil;
  FBuffer := nil;
  FUser := nil;
  FUserSave := nil;
  inherited Destroy;
end;

procedure TDECCipher.Init(const Key; Size: Integer; const IVector; IVectorSize: Integer; IFiller: Byte);
begin
  Protect;

  if Size > Context.KeySize then
    raise EDECException.Create(sKeyMaterialToLarge);
  if IVectorSize > FBufferSize then
    raise EDECException.Create(sIVMaterialToLarge);

  DoInit(Key, Size);
  if FUserSave <> nil then
    Move(FUser^, FUserSave^, FUserSize);

  FillChar(FVector^, FBufferSize, IFiller);
  if IVectorSize = 0 then
  begin
    DoEncode(FVector, FVector, FBufferSize);
    if FUserSave <> nil then Move(FUserSave^, FUser^, FUserSize);
  end else Move(IVector, FVector^, IVectorSize);
  Move(FVector^, FFeedback^, FBufferSize);
  FState := csInitialized;
end;

procedure TDECCipher.Init(const Key: Binary; const IVector: Binary; IFiller: Byte);
begin
  Init(Key[1], Length(Key), IVector[1], Length(IVector), IFiller);
end;

procedure TDECCipher.Done;
begin
  if FState <> csDone then
  begin
    FState := csDone;
    FBufferIndex := 0;
    DoEncode(FFeedback, FBuffer, FBufferSize);
    Move(FVector^, FFeedback^, FBufferSize);
    if FUserSave <> nil then
      Move(FUserSave^, FUser^, FUserSize);
  end;
end;

procedure TDECCipher.Protect;
begin
  FState := csNew;
  ProtectBuffer(FData[0], FDataSize);
end;

procedure InvalidMessageLength(Cipher: TDECCipher);
begin
  with Cipher do
    raise EDECException.CreateFmt(sInvalidMessageLength,
      [TypInfo.GetEnumName(TypeInfo(TCipherMode), Integer(FMode)), Context.BlockSize]);
end;

procedure TDECCipher.Encode(const Source; var Dest; DataSize: Integer);

  procedure EncodeECBx(S,D: PByteArray; Size: Integer);
  var
    I: Integer;
  begin
    if Context.BlockSize = 1 then
    begin
      DoEncode(S, D, Size);
      FState := csEncode;
    end else
    begin
      Dec(Size, FBufferSize);
      I := 0;
      while I <= Size do
      begin
        DoEncode(@S[I], @D[I], FBufferSize);
        Inc(I, FBufferSize);
      end;
      Dec(Size, I - FBufferSize);
      if Size > 0 then
        if Size mod Context.BlockSize = 0 then
        begin
          DoEncode(@S[I], @D[I], Size);
          FState := csEncode;
        end else
        begin
          FState := csPadded;
          InvalidMessageLength(Self);
        end;
    end;
  end;

  procedure EncodeCFB8(S,D: PByteArray; Size: Integer);
  // CFB-8
  var
    I: Integer;
  begin
    I := 0;
    while I < Size do
    begin
      DoEncode(FFeedback, FBuffer, FBufferSize);
      Move(FFeedback[1], FFeedback[0], FBufferSize -1);
      D[I] := S[I] xor FBuffer[0];
      FFeedback[FBufferSize -1] := D[I];
      Inc(I);
    end;
    FState := csEncode;
  end;

  procedure EncodeOFB8(S,D: PByteArray; Size: Integer);
  var
    I: Integer;
  begin
    I := 0;
    while I < Size do
    begin
      DoEncode(FFeedback, FBuffer, FBufferSize);
      Move(FFeedback[1], FFeedback[0], FBufferSize -1);
      FFeedback[FBufferSize -1] := FBuffer[0];
      D[I] := S[I] xor FBuffer[0];
      Inc(I);
    end;
    FState := csEncode;
  end;

  procedure EncodeCFS8(S,D: PByteArray; Size: Integer);
  // CFS-8, CTS as CFB
  var
    I: Integer;
  begin
    I := 0;
    while I < Size do
    begin
      DoEncode(FFeedback, FBuffer, FBufferSize);
      D[I] := S[I] xor FBuffer[0];
      Move(FFeedback[1], FFeedback[0], FBufferSize -1);
      FFeedback[FBufferSize -1] := FFeedback[FBufferSize -1] xor D[I];
      Inc(I);
    end;
    FState := csEncode;
  end;

  procedure EncodeCFBx(S,D: PByteArray; Size: Integer);
  // CFB-BlockSize
  var
    I: Integer;
    F: PByteArray;
  begin
    FState := csEncode;
    if FBufferIndex > 0 then
    begin
      I := FBufferSize - FBufferIndex;
      if I > Size then I := Size;
      XORBuffers(S[0], FBuffer[FBufferIndex], I, D[0]);
      Move(D[0], FFeedback[FBufferIndex], I);
      Inc(FBufferIndex, I);
      if FBufferIndex < FBufferSize then Exit;
      Dec(Size, I);
      S := @S[I];
      D := @D[I];
      FBufferIndex := 0
    end;
    Dec(Size, FBufferSize);
    F := FFeedback;
    I := 0;
    while I < Size do
    begin
      DoEncode(F, FBuffer, FBufferSize);
      XORBuffers(S[I], FBuffer[0], FBufferSize, D[I]);
      F := @D[I];
      Inc(I, FBufferSize);
    end;
    if F <> FFeedback then
      Move(F^, FFeedback^, FBufferSize);
    Dec(Size, I - FBufferSize);
    if Size > 0 then
    begin
      DoEncode(FFeedback, FBuffer, FBufferSize);
      XORBuffers(S[I], FBuffer[0], Size, D[I]);
      Move(D[I], FFeedback[0], Size);
      FBufferIndex := Size;
    end;
  end;

  procedure EncodeOFBx(S,D: PByteArray; Size: Integer);
  // OFB-BlockSize
  var
    I: Integer;
  begin
    FState := csEncode;
    if FBufferIndex > 0 then
    begin
      I := FBufferSize - FBufferIndex;
      if I > Size then I := Size;
      XORBuffers(S[0], FFeedback[FBufferIndex], I, D[0]);
      Inc(FBufferIndex, I);
      if FBufferIndex < FBufferSize then Exit;
      Dec(Size, I);
      S := @S[I];
      D := @D[I];
      FBufferIndex := 0
    end;
    Dec(Size, FBufferSize);
    I := 0;
    while I < Size do
    begin
      DoEncode(FFeedback, FFeedback, FBufferSize);
      XORBuffers(S[I], FFeedback[0], FBufferSize, D[I]);
      Inc(I, FBufferSize);
    end;
    Dec(Size, I - FBufferSize);
    if Size > 0 then
    begin
      DoEncode(FFeedback, FFeedback, FBufferSize);
      XORBuffers(S[I], FFeedback[0], Size, D[I]);
      FBufferIndex := Size;
    end;
  end;

  procedure EncodeCFSx(S,D: PByteArray; Size: Integer);
  // CFS-BlockSize
  var
    I: Integer;
  begin
    FState := csEncode;
    if FBufferIndex > 0 then
    begin
      I := FBufferSize - FBufferIndex;
      if I > Size then I := Size;
      XORBuffers(S[0], FBuffer[FBufferIndex], I, D[0]);
      XORBuffers(D[0], FFeedback[FBufferIndex], I, FFeedback[FBufferIndex]);
      Inc(FBufferIndex, I);
      if FBufferIndex < FBufferSize then Exit;
      Dec(Size, I);
      S := @S[I];
      D := @D[I];
      FBufferIndex := 0
    end;
    Dec(Size, FBufferSize);
    I := 0;
    while I < Size do
    begin
      DoEncode(FFeedback, FBuffer, FBufferSize);
      XORBuffers(S[I], FBuffer[0], FBufferSize, D[I]);
      XORBuffers(D[I], FFeedback[0], FBufferSize, FFeedback[0]);
      Inc(I, FBufferSize);
    end;
    Dec(Size, I - FBufferSize);
    if Size > 0 then
    begin
      DoEncode(FFeedback, FBuffer, FBufferSize);
      XORBuffers(S[I], FBuffer[0], Size, D[I]);