dectest.dpr

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

program DECTest;

uses
  Classes,
  Windows,
  SysUtils,
  TypInfo,
  CPU,
  CRC,
  DECUtil,
  DECFmt,
  DECHash,
  DECCipher,
  DECRandom,
  Consts;

{$R *.RES}

procedure RegisterClasses;
begin
  RegisterDECClasses([TFormat_HEX, TFormat_HEXL, TFormat_MIME32, TFormat_MIME64,
                      TFormat_PGP, TFormat_UU, TFormat_XX, TFormat_ESCAPE]);

// or even in single steps
(*
  TFormat_HEX.Register;
  TFormat_HEXL.Register;
  TFormat_MIME32.Register;
  TFormat_MIME64.Register;
  TFormat_PGP.Register;
  TFormat_UU.Register;
  TFormat_XX.Register;
  TFormat_ESCAPE.Register;
*)

// prefered hashs
  THash_MD2.Register;        // 1.5Kb
  THash_MD4.Register;        // 2.0Kb                           // for fast checksums
  THash_MD5.Register;        // 2.5Kb
  THash_SHA.Register;        // 10Kb for SHA,SHA1,SHA256        // strong
  THash_SHA1.Register;
  THash_SHA256.Register;
  THash_SHA384.Register;     // 3.0Kb for SHA384,SHA512
  THash_SHA512.Register;                                        // variable digest
  THash_Sapphire.Register;   // 1.0Kb

  THash_Panama.Register;     // 2.0Kb
  THash_Tiger.Register;      // 12.0kb
  THash_RipeMD128.Register;  // 4.0Kb
  THash_RipeMD160.Register;  // 8.0Kb
  THash_RipeMD256.Register;  // 4.5Kb
  THash_RipeMD320.Register;  // 9.0Kb
  THash_Haval128.Register;   // 6.0Kb for all Haval's
  THash_Haval160.Register;
  THash_Haval192.Register;
  THash_Haval224.Register;
  THash_Haval256.Register;
  THash_Whirlpool.Register;   // 10.0Kb
  THash_Whirlpool1.Register;  // 10.0Kb
  THash_Square.Register;      // 10Kb
  THash_Snefru128.Register;   // 18Kb
  THash_Snefru256.Register;   //

//  TCipher_Null.Register;
  TCipher_Blowfish.Register;
  TCipher_Twofish.Register;
  TCipher_IDEA.Register;
  TCipher_CAST256.Register;
  TCipher_Mars.Register;
  TCipher_RC4.Register;
  TCipher_RC6.Register;
  TCipher_Rijndael.Register;
  TCipher_Square.Register;
  TCipher_SCOP.Register;
  TCipher_Sapphire.Register;
  TCipher_1DES.Register;
  TCipher_2DES.Register;
  TCipher_3DES.Register;
  TCipher_2DDES.Register;
  TCipher_3DDES.Register;
  TCipher_3TDES.Register;
  TCipher_3Way.Register;
  TCipher_Cast128.Register;
  TCipher_Gost.Register;
  TCipher_Misty.Register;
  TCipher_NewDES.Register;
  TCipher_Q128.Register;
  TCipher_RC2.Register;
  TCipher_RC5.Register;
  TCipher_SAFER.Register;
  TCipher_Shark.Register;
  TCipher_Skipjack.Register;
  TCipher_TEA.Register;
  TCipher_TEAN.Register;
end;

procedure PrintRegisteredClasses;

  function DoEnumClasses(Data: Pointer; ClassType: TDECClass): Boolean;
  begin
    Result := False;
    WriteLn(IntToHEX(ClassType.Identity, 8), ' : ', ClassType.ClassName);
  end;

begin
  WriteLn('registered classes');
  WriteLn;
  DECEnumClasses(@DoEnumClasses, nil);
  WriteLn;
end;

procedure Wait;
var
  Msg: TMsg;
begin
  WriteLn('press ESCAPE to terminate');
  while GetAsyncKeyState(vk_Escape) = 0 do
    if PeekMessage(Msg, 0, 0, 0, pm_Remove) then
    begin
      TranslateMessage(Msg);
      DispatchMessage(Msg);
    end;
end;

procedure TestCases;
// process testcases in file DECTest.vec
var
  CurChar: PChar;
  LineNo: Integer;
  Instance: TObject;
  ClassType: TDECClass;
// Cipher only special properties
  Password: Binary;
  IV: Binary;
  IFiller: Byte;

  procedure InvalidLine;
  begin
    raise Exception.CreateFmt('Invalid line format at %d', [LineNo]);
  end;

  function ExtractClassName: PChar;
  begin
    while CurChar^ in [' ', '['] do Inc(CurChar);
    Result := CurChar;
    while CurChar^ <> #0 do Inc(CurChar);
    while CurChar^ in [#0, ']', ' ', #13, #10] do Dec(CurChar);
    CurChar[1] := #0;
  end;

  procedure ExtractProperty(Instance: TObject);
  // setup property stored in Testvectors
  // format is .PropName=PropValue
  var
    PropName: PChar;
  begin
    while CurChar^ in [' ', '.'] do Inc(CurChar);
    PropName := CurChar;
    while not (CurChar^ in [#0, '=']) do Inc(CurChar);
    if CurChar^ <> #0 then
    begin
      CurChar^ := #0;
      Inc(CurChar);
      while CurChar^ in ['=', ' '] do Inc(CurChar);
      if Instance is TDECCipher then
        if AnsiCompareText(PropName, 'Password') = 0 then
        begin
          Password := TFormat_Escape.Decode(CurChar^, StrLen(CurChar));
          with TDECCipher(Instance).Context do
            if Length(Password) > KeySize then SetLength(Password, KeySize);
          Exit;
        end else
          if AnsiCompareText(PropName, 'IV') = 0 then
          begin
            IV := TFormat_Escape.Decode(CurChar^, StrLen(CurChar));
            Exit;
          end else
            if AnsiCompareText(PropName, 'IFiller') = 0 then
            begin
              IFiller := StrToInt(CurChar);
              Exit;
            end;
      try
        SetPropValue(Instance, PropName, String(CurChar));
      except
        on E: Exception do
        begin
          E.Message := E.Message + ' on ' + Instance.ClassName;
          raise;
        end;
      end;
    end else InvalidLine;
  end;

  function ExtractTestResult: Binary;
  // extract valid test result, and convertion from Escaped string
  // repositionate to testcases
  var
    R,P: PChar;
  begin
    while CurChar^ in [' ', '<'] do Inc(CurChar);
    R := CurChar;
    while not (CurChar^ in [#0, '>']) do Inc(CurChar);
    if CurChar^ <> '>' then InvalidLine;
    P := CurChar;
    while P^ in ['>', ' '] do Inc(P);
    if P^ <> '=' then InvalidLine;
    CurChar^ := #0;
    while P^ in ['=', ' ', '>'] do Inc(P);
    CurChar := P;
    Result := TFormat_Escape.Decode(R^, StrLen(R));
  end;

  function ExtractTest(var Data: Binary; var Count: Integer): Boolean;
  // extract one testcase and repetition
  var
    L: Boolean;
    T: Binary;
  begin
    Result := CurChar^ <> #0;
    if Result then
    begin
      Count := 0;
      Data := '';
      while CurChar^ = ' ' do Inc(CurChar);
      while CurChar^ in ['0'..'9'] do
      begin
        Count := Count * 10 + Ord(CurChar^) - Ord('0');
        Inc(CurChar);
      end;
      L := CurChar^ = '!';
      while not (CurChar^ in [#0, '<']) do Inc(CurChar);
      if CurChar^ = '<' then
      begin
        Inc(CurChar);
        while not (CurChar^ in [#0, '>']) do
        begin
          Data := Data + CurChar^;
          Inc(CurChar);
        end;
        if CurChar^ <> '>' then InvalidLine;
      end else InvalidLine;
      while CurChar^ in ['>',','] do Inc(CurChar);
      Data := TFormat_Escape.Decode(Data);
      if L then
      begin
        repeat
          T := T + Data;
          Dec(Count);
        until Count <= 0;
        Count := 1;
        Data := T;
      end; 
    end;
  end;

  procedure TestHash;
  // apply testcases to hash function
  var
    Digest: Binary;
    Data: Binary;
    Count: Integer;
    Hash: TDECHash absolute Instance;
  begin
    Digest := ExtractTestResult;
    Hash.Init;
    while ExtractTest(Data, Count) do
    repeat
      Hash.Calc(Data[1], Length(Data));
      Dec(Count);
    until Count <= 0;
    Hash.Done;

    Write(LineNo:5, ': ', Hash.Classname, ' ');
    if AnsiCompareText(Hash.DigestStr(TFormat_HEXL), Digest) <> 0 then WriteLn(Digest, ' != ', Hash.DigestStr(TFormat_HEXL))
      else WriteLn('test ok.');
  end;

  procedure TestCipher;
  var
    CipherText,PlainText,TestResult,PlainResult: Binary;
    Cipher: TDECCipher absolute Instance;
    Count: Integer;
  begin
    CipherText := ExtractTestResult;
    Cipher.Init(Password, IV, IFiller);
    TestResult := '';
    PlainResult := '';
    while ExtractTest(PlainText, Count) do
    begin
      PlainResult := PlainResult + PlainText;
      TestResult := TestResult + Cipher.EncodeBinary(PlainText, TFormat_Copy);
      Dec(Count);
    end;
    Cipher.Done;
    TestResult := TFormat_HEXL.Encode(TestResult);

    Write(LineNo:5, ': ', Cipher.Classname, ' ');
    if CipherText <> TestResult then
    begin