dectest.dpr

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

      WriteLn(CipherText, ' != ', TestResult);
      Exit;
    end;
    TestResult := Cipher.DecodeBinary(TestResult, TFormat_HEXL);
    if TestResult <> PlainResult then
    begin
      WriteLn('decode error');
      Exit;
    end;
    WriteLn('test ok.');
  end;

  procedure TestFormat;
  // apply testcases to conversions function
  var
    Test,Output,Data: Binary;
    Count: Integer;
    Format: TDECFormatClass absolute ClassType;
  begin
    Test := ExtractTestResult;
    ExtractTest(Data, Count);
    Output := Format.Encode(Data);

    Write(LineNo:5, ': ', Format.Classname, ' ');
    if Test <> Output then WriteLn(Test, ' != ', Output)
      else WriteLn('test ok.');
  end;

var
  VectorFile: Text;
  Line: String;
  TestProc: procedure;
begin
  WriteLn('processing test cases');
  WriteLn;

  Instance := nil;
  ClassType := nil;
  TestProc := nil;
  LineNo := 0;
  Assign(VectorFile, ExtractFilePath(ParamStr(0)) + 'DECTest.vec');
  try
    Reset(VectorFile);
    while not EOF(VectorFile) do
    begin
      ReadLn(VectorFile, Line);
      CurChar := PChar(Line);
      while (CurChar^ <> #0) and (CurChar^ = ' ') do Inc(CurChar);
      Inc(LineNo);
      case CurChar^ of
         #0: ;
        '#': ; // remark
        '[': begin // class
               FreeAndNil(Instance);
               TestProc := nil;
               ClassType := nil;
               if CurChar[1] <> '#' then
               try
                 ClassType := DECClassByName(ExtractClassName, TDECObject);
                 if ClassType.InheritsFrom(TDECHash) then
                 begin
                   Instance := ClassType.Create;
                   TestProc := @TestHash;
                 end else
                   if ClassType.InheritsFrom(TDECFormat) then
                   begin
                     TestProc := @TestFormat;
                   end else
                     if ClassType.InheritsFrom(TDECCipher) then
                     begin
                       Password := '';
                       IV := '';
                       IFiller := $FF;
                       Instance := ClassType.Create;
                       TestProc := @TestCipher;
                     end;
               except
                 on E: Exception do
                 begin
                   WriteLn(E.Message);
                 end;
               end;
             end;
        '.': if Instance <> nil then
               ExtractProperty(Instance);
        '<': if Assigned(TestProc) then // testcase
             begin
               asm
                   PUSH  EBP
                   CALL  TestProc
                   POP   ECX
               end;
             end;
      else
        if ClassType <> nil then
          InvalidLine;
      end;
    end;
  finally
    Close(VectorFile);
    FreeAndNil(Instance);
  end;
  WriteLn;
end;

procedure SpeedTestHashs;
const
  BufferSize = 1024 * 16;

  function DoSpeed(Buffer: PByteArray; HashClass: TDECHashClass): Boolean;
  var
    Start,Stop: Int64;
    ThreadPriority: Cardinal;
    ProcessPriority: Cardinal;
    I: Integer;
  begin
    Result := False;
    ProcessPriority := GetPriorityClass(GetCurrentProcess);
    ThreadPriority := GetThreadPriority(GetCurrentThread);
    with HashClass.Create do
    try
      SetPriorityClass(GetCurrentProcess, REALTIME_PRIORITY_CLASS);
      SetThreadPriority(GetCurrentThread, THREAD_PRIORITY_TIME_CRITICAL);
      Sleep(0);
      Start := CPU.RDTSC;
      for I := 0 to 4 do
      begin
        Init;
        Calc(Buffer[0], BufferSize);
        Done;
      end;
      Stop := (CPU.RDTSC - Start) div 5;
      WriteLn(ClassName, StringOfChar(' ', 20 - Length(ClassName)), ': ',
              Stop/BufferSize:10:1, ' cycles/byte ',
              CPUSpeed/Stop*BufferSize:10:2, ' Mb/sec');
    finally
      Free;
      SetThreadPriority(GetCurrentThread, ThreadPriority);
      SetPriorityClass(GetCurrentProcess, ProcessPriority);
    end;
    Sleep(0);
  end;

var
  Buffer: String;
begin
  WriteLn('compute hash performances');
  WriteLn;
  SetLength(Buffer, BufferSize);
  RandomBuffer(Buffer[1], BufferSize);
  DECEnumClasses(@DoSpeed, Pointer(Buffer), TDECHash);
  WriteLn;
end;

function TestVector: PChar; assembler; register;
asm
         MOV   EAX,OFFSET @Vector
         RET
@Vector: DB    030h,044h,0EDh,06Eh,045h,0A4h,096h,0F5h
         DB    0F6h,035h,0A2h,0EBh,03Dh,01Ah,05Dh,0D6h
         DB    0CBh,01Dh,009h,082h,02Dh,0BDh,0F5h,060h
         DB    0C2h,0B8h,058h,0A1h,091h,0F9h,081h,0B1h
         DB    000h,000h,000h,000h,000h,000h,000h,000h
end;

procedure TestCipher;

  function DoTest(Dummy: Pointer; CipherClass: TDECCipherClass): Boolean;
  var
    Buffer: array[0..31] of Byte;
    Key: Binary;
    I: Integer;
  begin
    Result := False;
    Key := CipherClass.ClassName;
    I := Length(Key);
    with CipherClass.Context do
      if I > KeySize then I := KeySize;
    SetLength(Key, I);

    with CipherClass.Create do
    try
      Mode := cmCTSx;
      Init(Key);

      Encode(TestVector^, Buffer, SizeOf(Buffer));
      Done;

      Decode(Buffer, Buffer, SizeOf(Buffer));
      Done;
      if not CompareMem(TestVector, @Buffer, SizeOf(Buffer)) then
        WriteLn(ClassName + StringOfChar(' ', 18 - Length(ClassName)), 'selftest fails');
    finally
      Free;
    end;
  end;

begin
  DECEnumClasses(@DoTest, nil, TDECCipher);
end;

procedure SpeedTestCiphers;
const
  BufferSize = 1024 * 16 * 2;

  function DoSpeed(Buffer: PByteArray; CipherClass: TDECCipherClass): Boolean;
  var
    Start,Stop: Int64;
    ThreadPriority: Cardinal;
    ProcessPriority: Cardinal;
    I,S: Integer;
  begin
    Result := False;
    ProcessPriority := GetPriorityClass(GetCurrentProcess);
    ThreadPriority := GetThreadPriority(GetCurrentThread);
    with CipherClass.Create do
    try
      Mode := cmECBx;
      Init(StringOfChar('x', Context.KeySize));

      S := BufferSize shr 1;
      I := S mod Context.BufferSize;
      Dec(S, I);

      SetPriorityClass(GetCurrentProcess, REALTIME_PRIORITY_CLASS);
      SetThreadPriority(GetCurrentThread, THREAD_PRIORITY_TIME_CRITICAL);
      Sleep(0);
      Start := CPU.RDTSC;
      for I := 0 to 2 do
      begin
        Encode(Buffer[0], Buffer[S], S);
        Done;
        Decode(Buffer[0], Buffer[S], S);
        Done;
      end;
      Stop := (CPU.RDTSC - Start) div 6;
      WriteLn(ClassName, StringOfChar(' ', 20 - Length(ClassName)), ': ',
              Stop/S:10:1, ' cycles/byte ',
              CPUSpeed/Stop*S:10:2, ' Mb/sec');
    finally
      Free;
      SetThreadPriority(GetCurrentThread, ThreadPriority);
      SetPriorityClass(GetCurrentProcess, ProcessPriority);
    end;
    Sleep(0);
  end;

var
  Buffer: Binary;
begin
  WriteLn('compute cipher performances');
  WriteLn;
  SetLength(Buffer, BufferSize);
  RandomBuffer(Buffer[1], BufferSize);
  DECEnumClasses(@DoSpeed, Pointer(Buffer), TDECCipher);
  WriteLn;
end;

procedure DemoCipher(Index: Integer);
// demonstrate en/decryption with cipher Blowfish and use of a
// secure Hash based random KDF -> Key Derivation Function
var
  Seed, Encoded, Decoded: Binary;
begin
  Seed := RandomBinary(16);

  with TCipher_Blowfish.Create do
  try
    Init(THash_SHA1.KDFx('Password here', Seed, Context.KeySize));
    Encoded := EncodeBinary('Secret data here', TFormat_MIME64);
  finally
    Free;
  end;

  with TCipher_Blowfish.Create do
  try
    Init(THash_SHA1.KDFx('Password here', Seed, Context.KeySize));
    Decoded := DecodeBinary(Encoded, TFormat_MIME64);
  finally
    Free;
  end;

  WriteLn(#13#10'Demo Cipher #', Index);
  WriteLn('encoded: ', Encoded);
  WriteLn('decoded: ', Decoded);
end;

procedure DemoCipherFile;
// demonstriert eine sehr sichere Anwendung von Verschl黶selungen, Hashfunktionen,
// Key Derivation Functions und Zufallsdaten.


  procedure EncodeFile(const AFileName: String; const APassword: Binary;
                       ACipher: TDECCipherClass = nil; AMode: TCipherMode = cmCTSx;
                       AHash: TDECHashClass = nil);
  // Die Datei wird verschl黶selt danach 黚erschrieben und gel鰏cht.
  // Die verschl黶selte Datei wurde mit einem Session Passwort verschl黶selt das mit Hilfe
  // einer KDF = Key Derivation Funktion und einem Zufallswert erzeugt wurde.
  // Der Zufallswert == Seed ist 128 Bits gro