messagedigests.pas

分析torrent的东西是拿别人的

unit MessageDigests;

(*$J-*) { Don't need modifiable typed constants. }

(*$IFDEF Ver80*)
  (*$DEFINE PreDelphi4*)
  (*$DEFINE PreDelphi3*)
(*$ENDIF*)
(*$IFDEF Ver90*)
  (*$DEFINE PreDelphi4*)
  (*$DEFINE PreDelphi3*)
(*$ENDIF*)
(*$IFDEF Ver100*)
  (*$DEFINE PreDelphi4*)
(*$ENDIF*)

interface

uses Classes, SysUtils;

const
  BitsPerByte = 8;
  
type
  PDWORD = ^DWORD;
  DWORD = (*$IFDEF PreDelphi4*) Longint (*$ELSE*) Longword (*$ENDIF*) ;
  
{
  Copyright (c) 1998-1999 Dave Shapiro, Professional Software, Inc.
  Use and modify freely.
  
                    MessageDigests class hierarchy:


                            TMessageDigest
                              (abstract)
                                  |
           ----------------------------------------
           |                                      |
         TMD2                                 TMD4Family
      (16-byte)                               (abstract)
                                                  |
                             -------------------------------------------
                             |             |             |             |
                            TMD4         TMD5          TSHA1       TRIPEMD160
                         (16-byte)    (16-byte)      (20-byte)      (20-byte)
}


type
  TMessageDigest = class(TObject)
  protected
    PDigest: Pointer;
    PLastBlock: Pointer;
    NumLastBlockBytes: Integer;
    FBlockSize: Integer;
    FDigestSize: Integer;
    FBlocksDigested: Longint;
    FCompleted: Boolean;
    constructor CreateInternal(const BlockSize, DigestSize: Integer);
    procedure TransformBlocks(const Blocks;
                              const BlockCount: Longint); virtual;
    procedure RequireCompletion;
    procedure RequireIncompletion;
  public
    constructor Create; virtual; abstract;
    destructor Destroy; override;
    procedure Transform(const M; NumBytes: Longint);
    procedure TransformStream(const Stream: TStream);
    procedure TransformString(const S: string);
    procedure Complete; virtual;
    procedure Clear; virtual;
    function HashValue: string;
    function HashValueBytes: Pointer;
    function NumBytesDigested: Longint;
    class function AsString: string; virtual; abstract;
    property BlockSize: Integer read FBlockSize;
    property DigestSize: Integer read FDigestSize;
    property BlocksDigested: Longint read FBlocksDigested;
    property Completed: Boolean read FCompleted;
  end;

  TMessageDigestClass = class of TMessageDigest;

type
  PMD2Block = ^TMD2Block;
  TMD2Block = array [0..15] of Byte;
  TMD2Buffer = array [1..48] of Byte;
  TMD2Digest = array [1..16] of Byte;

const
  MD2BlockSize = SizeOf(TMD2Block);
  MD2DigestSize = SizeOf(TMD2Digest);

type
  TMD2 = class(TMessageDigest)
  private
    Checksum: TMD2Block;
    ChecksumL: Byte;
    Buffer: TMD2Buffer;
  protected
    procedure TransformBlocks(const Blocks; const BlockCount: Longint); override;
  public
    constructor Create; override;
    destructor Destroy; override;
    procedure Complete; override;
    procedure Clear; override;
    class function AsString: string; override;
  end;

  TMD2Class = class of TMD2;
  
type
  TChainingVar = DWORD;

type
  TMD4Family = class(TMessageDigest)
  protected
    PInitialChainingValues: Pointer;
    PChainingVars: Pointer;
    FIsBigEndian: Boolean;
    constructor CreateInternal(const BlockSize, DigestSize: Integer;
                               const InitialChainingValues;
                               const IsBigEndian: Boolean); 
  public
    destructor Destroy; override;
    procedure Complete; override;
    procedure Clear; override;
  end;

  TMD4FamilyClass = class of TMD4Family;

type
  TMDxChainingVarRange = (mdA, mdB, mdC, mdD);
  PMD4ChainingVarArray = ^TMD4ChainingVarArray;
  TMD4ChainingVarArray = array [TMDxChainingVarRange] of TChainingVar;
  TMD4Digest = array [1..4] of DWORD;
  PMD4Block = ^TMD4Block;
  TMD4Block = array [0..15] of DWORD;

const
  MD4BlockSize = SizeOf(TMD4Block);
  MD4DigestSize = SizeOf(TMD4Digest);

type
  TMD4 = class(TMD4Family)
  private
  protected
    procedure TransformBlocks(const Blocks; const BlockCount: Longint); override;
  public
    constructor Create; override;
    destructor Destroy; override;
    class function AsString: string; override;
  end;

  TMD4Class = class of TMD4;

type
  PMD5ChainingVarArray = ^TMD5ChainingVarArray;
  TMD5ChainingVarArray = array [TMDxChainingVarRange] of TChainingVar;
  TMD5Digest = array [1..4] of DWORD;
  PMD5Block = ^TMD5Block;
  TMD5Block = array [0..15] of DWORD;

const
  MD5BlockSize = SizeOf(TMD5Block);
  MD5DigestSize = SizeOf(TMD5Digest);

type
  TMD5 = class(TMD4Family)
  private
  protected
    procedure TransformBlocks(const Blocks; const BlockCount: Longint); override;
  public
    constructor Create; override;
    destructor Destroy; override;
    class function AsString: string; override;
  end;

  TMD5Class = class of TMD5;

type
  TSHAChainingVarRange = (shaA, shaB, shaC, shaD, shaE);
  PSHAChainingVarArray = ^TSHAChainingVarArray;
  TSHAChainingVarArray = array [TSHAChainingVarRange] of TChainingVar;
  TSHADigest = array [1..5] of DWORD;
  PSHABlock = ^TSHABlock;
  TSHABlock = array [0..15] of DWORD;

const
  SHABlockSize = SizeOf(TSHABlock);
  SHADigestSize = SizeOf(TSHADigest);

type
  TSHA1 = class(TMD4Family)
  private
  protected
    procedure TransformBlocks(const Blocks; const BlockCount: Longint); override;
  public
    constructor Create; override;
    destructor Destroy; override;
    class function AsString: string; override;
  end;

  TSHA1Class = class of TSHA1;

type
  TRIPEMD160ChainingVarRange = (ripA, ripB, ripC, ripD, ripE);
  PRIPEMD160ChainingVarArray = ^TRIPEMD160ChainingVarArray;
  TRIPEMD160ChainingVarArray = array [TRIPEMD160ChainingVarRange] of TChainingVar;
  TRIPEMD160Digest = array [1..5] of DWORD;
  PRIPEMD160Block = ^TRIPEMD160Block;
  TRIPEMD160Block = array [0..15] of DWORD;

const
  RIPEMD160BlockSize = SizeOf(TRIPEMD160Block);
  RIPEMD160DigestSize = SizeOf(TRIPEMD160Digest);

type
  TRIPEMD160 = class(TMD4Family)
  private
  protected
    procedure TransformBlocks(const Blocks; const BlockCount: Longint); override;
  public
    constructor Create; override;
    destructor Destroy; override;
    class function AsString: string; override;
  end;

  TRIPEMD160Class = class of TRIPEMD160;
  

implementation

type
  TDoubleDWORD = record
    L, H: DWORD;
  end;
  TFourByte = packed record
    B1, B2, B3, B4: Byte;
  end;

function CircularSHL(const X: DWORD; const Amount: Byte): DWORD;
{
  Pre: Amount < BitsInX.
  Post: Result is an unsigned circular left shift of X by Amount bytes.
}
const
  BitsInX = SizeOf(X) * BitsPerByte;
begin
  Result := X shl Amount or X shr (BitsInX - Amount);
end;

{--------------------------TMessageDigest--------------------------------------}


constructor TMessageDigest.CreateInternal(const BlockSize, DigestSize: Integer);
{
  Pre: BlockSize > 0 and DigestSize > 0.
  Post: Self.FBlockSize = BlockSize and Self.FDigestSize = DigestSize.
        Returns a message digest with LastBlock and Digest space allocated.
}
begin
  (*$IFNDEF PreDelphi3*)
    Assert(BlockSize > 0, 'TMessageDigest.CreateInternal: BlockSize <= 0.');
    Assert(DigestSize > 0, 'TMessageDigest.CreateInternal: DigestSize <= 0.');
  (*$ENDIF*)
  inherited Create;
  FBlockSize := BlockSize;
  PLastBlock := nil;
  FDigestSize := DigestSize;
  PDigest := nil;
  Clear;
end;

destructor TMessageDigest.Destroy;
begin
  if Assigned(PDigest) then FreeMem(PDigest);
  if Assigned(PLastBlock) then FreeMem(PLastBlock);
  inherited;
end;

procedure TMessageDigest.Complete;
begin
  FCompleted := True;
end;

procedure TMessageDigest.Clear;
begin
  if not Assigned(PLastBlock) then GetMem(PLastBlock, FBlockSize);
  if not Assigned(PDigest) then GetMem(PDigest, FDigestSize);
  FillChar(PLastBlock^, FBlockSize, 0);
  FillChar(PDigest^, FDigestSize, 0);
  NumLastBlockBytes := 0;
  FBlocksDigested := 0;
  FCompleted := False;
end;

procedure TMessageDigest.Transform(const M; NumBytes: Longint);
{
  Pre: Addr(M) <> nil and NumBytes >= 0.
  Post: Instance's state will be updated to include the contents of M in
        the message digest. If not enough bytes are given to fill a block,
        no calculations are made, but the bytes are saved for future
        transformations.
}
var
  NumBlocks: Longint;
  P, PLB: ^Byte;
  NumBytesNeeded: Integer;
begin
  RequireIncompletion;
  P := Addr(M);
  (*$IFNDEF PreDelphi3*)
    Assert(Assigned(P), 'Transform: M not assigned.');
  (*$ENDIF*)
  if NumLastBlockBytes > 0 then begin
    PLB := PLastBlock;
    Inc(PLB, NumLastBlockBytes);
    NumBytesNeeded := FBlockSize - NumLastBlockBytes;
    if NumBytes < NumBytesNeeded then begin
      Move(M, PLB^, NumBytes);
      Inc(NumLastBlockBytes, NumBytes);
      Exit;
    end;
    Move(M, PLB^, NumBytesNeeded);
    Dec(NumBytes, NumBytesNeeded);
    Inc(P, NumBytesNeeded);
    TransformBlocks(PLastBlock^, 1);
  end;
  NumBlocks := NumBytes div FBlockSize;
  TransformBlocks(P^, NumBlocks);
  NumLastBlockBytes := NumBytes mod FBlockSize;
  Inc(P, NumBytes - NumLastBlockBytes);
  Move(P^, PLastBlock^, NumLastBlockBytes);
end;

procedure TMessageDigest.TransformStream(const Stream: TStream);
{
  Pre: Stream <> nil
  Post: Instance's state will be updated to include the contents of Stream
        in the message digest. This routine starts at Stream.Position and
        goes to the end of the stream. The Stream's position will be at the
        end upon termination of this routine, i.e.
        Stream.Position = Stream.Size.
}
var
  Buffer: array [1..1024] of Byte;
  NumBytes: Longint;
begin
  (*$IFNDEF PreDelphi3*)
    Assert(Assigned(Stream), 'TransformStream: Stream not assigned.');
  (*$ENDIF*)
  repeat
    NumBytes := Stream.Read(Buffer, SizeOf(Buffer));
    Transform(Buffer, NumBytes);
  until NumBytes < SizeOf(Buffer);
end;

procedure TMessageDigest.TransformString(const S: string);
{
  Pre: None.
  Post: Instance's state will be updated to include the contents of S
        in the message digest. This routine starts at S[1] and goes to
        the end of the string.
}
begin
  Transform(S[1], Length(S));
end;

procedure TMessageDigest.TransformBlocks(const Blocks;
                                         const BlockCount: Longint);
begin
  Inc(FBlocksDigested, BlockCount);
end;

function TMessageDigest.HashValueBytes: Pointer;
begin
  RequireCompletion;
  Result := PDigest;
end;

function TMessageDigest.HashValue: string;
{
  Pre: Technically, none. However, the digest is meaningless until Complete
       has been called on the instance, and thus this function will return
       a blank string unless it has been completed.
  Post: A string of 2 * FDigestSize bytes representing the hex value of the
        message digest. The left-most two characters of the resulting string
        represent the first byte of the message digest, and the right-most
        two characters of the resulting string represent the last byte of the
        message digest.
}
const
  DigitToHex: array [0..$0F] of Char = (
   '0', '1', '2', '3', '4', '5', '6', '7', '8', '9',
   'a', 'b', 'c', 'd', 'e', 'f'
  );
var
  I: Integer;
  PD: ^Byte;
  PR: ^Char;
begin
  RequireCompletion;
  SetLength(Result, 2 * FDigestSize);
  PD := PDigest;
  PR := Addr(Result[1]);
  for I := 1 to FDigestSize do begin
    PR^ := DigitToHex[PD^ shr 4];
    Inc(PR);
    PR^ := DigitToHex[PD^ and $0F];
    Inc(PR);
    Inc(PD);
  end;
end;

function TMessageDigest.NumBytesDigested: Longint;
begin
  Result := FBlocksDigested * FBlockSize;
end;