restemplate/indy/Protocols/IdHash.pas

{
  $Project$
  $Workfile$
  $Revision$
  $DateUTC$
  $Id$

  This file is part of the Indy (Internet Direct) project, and is offered
  under the dual-licensing agreement described on the Indy website.
  (http://www.indyproject.org/)

  Copyright:
   (c) 1993-2005, Chad Z. Hower and the Indy Pit Crew. All rights reserved.
}
{
  $Log$
}
{
  Rev 1.10    7/24/04 12:54:32 PM  RLebeau
  Compiler fix for TIdHash128.HashValue()

  Rev 1.9    7/23/04 7:09:12 PM  RLebeau
  Added extra exception handling to various HashValue() methods

  Rev 1.8    2004.05.20 11:37:06 AM  czhower
  IdStreamVCL

  Rev 1.7    2004.03.03 11:54:30 AM  czhower
  IdStream change

  Rev 1.6    2004.02.03 5:44:48 PM  czhower
  Name changes

  Rev 1.5    1/27/2004 4:00:08 PM  SPerry
  StringStream ->IdStringStream

  Rev 1.4    11/10/2003 7:39:22 PM  BGooijen
  Did all todo's ( TStream to TIdStream mainly )

  Rev 1.3    2003.10.24 10:43:08 AM  czhower
  TIdSTream to dos

  Rev 1.2    10/18/2003 4:28:30 PM  BGooijen
  Removed the pchar for DotNet

  Rev 1.1    10/8/2003 10:15:10 PM  GGrieve
  replace TIdReadMemoryStream (might be fast, but not compatible with DotNet)

  Rev 1.0    11/13/2002 08:30:24 AM  JPMugaas
  Initial import from FTP VC.
}

unit IdHash;

interface

{$i IdCompilerDefines.inc}

uses
  Classes,
  IdFIPS,
  IdGlobal;

type
  TIdHash = class(TObject)
  protected
    function GetHashBytes(AStream: TStream; ASize: TIdStreamSize): TIdBytes; virtual; abstract;
    function HashToHex(const AHash: TIdBytes): String; virtual; abstract;
    function WordHashToHex(const AHash: TIdBytes; const ACount: Integer): String;
    function LongWordHashToHex(const AHash: TIdBytes; const ACount: Integer): String;
  public
    constructor Create; virtual;
    class function IsAvailable : Boolean; virtual;
    function HashString(const ASrc: string; ADestEncoding: IIdTextEncoding = nil{$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}): TIdBytes;
    function HashStringAsHex(const AStr: String; ADestEncoding: IIdTextEncoding = nil{$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}): String;
    function HashBytes(const ASrc: TIdBytes): TIdBytes;
    function HashBytesAsHex(const ASrc: TIdBytes): String;
    function HashStream(AStream: TStream): TIdBytes; overload;
    function HashStreamAsHex(AStream: TStream): String; overload;
    function HashStream(AStream: TStream; const AStartPos, ASize: TIdStreamSize): TIdBytes; overload;
    function HashStreamAsHex(AStream: TStream; const AStartPos, ASize: TIdStreamSize): String; overload;
  end;

  TIdHash16 = class(TIdHash)
  protected
    function GetHashBytes(AStream: TStream; ASize: TIdStreamSize): TIdBytes; override;
    function HashToHex(const AHash: TIdBytes): String; override;
  public
    function HashValue(const ASrc: string; ADestEncoding: IIdTextEncoding = nil{$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}): UInt16; overload;
    function HashValue(const ASrc: TIdBytes): UInt16; overload;
    function HashValue(AStream: TStream): UInt16; overload;
    function HashValue(AStream: TStream; const AStartPos, ASize: TIdStreamSize): UInt16; overload;
    procedure HashStart(var VRunningHash : UInt16); virtual; abstract;
    procedure HashEnd(var VRunningHash : UInt16); virtual;
    procedure HashByte(var VRunningHash : UInt16; const AByte : Byte); virtual; abstract;
  end;

  TIdHash32 = class(TIdHash)
  protected
    function GetHashBytes(AStream: TStream; ASize: TIdStreamSize): TIdBytes; override;
    function HashToHex(const AHash: TIdBytes): String; override;
  public
    function HashValue(const ASrc: string; ADestEncoding: IIdTextEncoding = nil{$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}): UInt32; overload;
    function HashValue(const ASrc: TIdBytes): UInt32; overload;
    function HashValue(AStream: TStream): UInt32; overload;
    function HashValue(AStream: TStream; const AStartPos, ASize: TIdStreamSize): UInt32; overload;
    procedure HashStart(var VRunningHash : UInt32); virtual; abstract;
    procedure HashEnd(var VRunningHash : UInt32); virtual;
    procedure HashByte(var VRunningHash : UInt32; const AByte : Byte); virtual; abstract;
  end;

  TIdHashClass = class of TIdHash;

  TIdHashIntF = class(TIdHash)
  protected
    function HashToHex(const AHash: TIdBytes): String; override;
    function InitHash : TIdHashIntCtx; virtual; abstract;
    procedure UpdateHash(ACtx : TIdHashIntCtx; const AIn : TIdBytes);
    function FinalHash(ACtx : TIdHashIntCtx) : TIdBytes;
    function GetHashBytes(AStream: TStream; ASize: TIdStreamSize): TIdBytes; override;
  public
    class function IsAvailable : Boolean; override;
    class function IsIntfAvailable : Boolean; virtual;
  end;
  TIdHashNativeAndIntF = class(TIdHashIntF)
  protected
    function NativeGetHashBytes(AStream: TStream; ASize: TIdStreamSize): TIdBytes; virtual;
    function GetHashBytes(AStream: TStream; ASize: TIdStreamSize): TIdBytes; override;

  end;

  {$IFDEF DOTNET}
  EIdSecurityAPIException = class(EIdException);
  EIdSHA224NotSupported = class(EIdSecurityAPIException);
  {$ENDIF}

implementation

uses
  {$IFDEF DOTNET}
  IdStreamNET,
  {$ELSE}
  IdStreamVCL,
  {$ENDIF}
  IdGlobalProtocols, SysUtils;

{ TIdHash }

constructor TIdHash.Create;
begin
  inherited Create;
end;

function TIdHash.HashString(const ASrc: string; ADestEncoding: IIdTextEncoding = nil
  {$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
  ): TIdBytes;
var
  LStream: TStream;  // not TIdStringStream -  Unicode on DotNet!
begin
  LStream := TMemoryStream.Create; try
    WriteStringToStream(LStream, ASrc, ADestEncoding{$IFDEF STRING_IS_ANSI}, ASrcEncoding{$ENDIF});
    LStream.Position := 0;
    Result := HashStream(LStream);
  finally FreeAndNil(LStream); end;
end;

function TIdHash.HashStringAsHex(const AStr: String; ADestEncoding: IIdTextEncoding = nil
  {$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
  ): String;
begin
  Result := HashToHex(HashString(AStr, ADestEncoding{$IFDEF STRING_IS_ANSI}, ASrcEncoding{$ENDIF}));
end;

function TIdHash.HashBytes(const ASrc: TIdBytes): TIdBytes;
var
  LStream: TStream;
begin
  // TODO: use TBytesStream on versions that support it
  LStream := TMemoryStream.Create; try
    WriteTIdBytesToStream(LStream, ASrc);
    LStream.Position := 0;
    Result := HashStream(LStream);
  finally FreeAndNil(LStream); end;
end;

function TIdHash.HashBytesAsHex(const ASrc: TIdBytes): String;
begin
  Result := HashToHex(HashBytes(ASrc));
end;

function TIdHash.HashStream(AStream: TStream): TIdBytes;
begin
  Result := HashStream(AStream, -1, -1);
end;

function TIdHash.HashStreamAsHex(AStream: TStream): String;
begin
  Result := HashToHex(HashStream(AStream));
end;

function TIdHash.HashStream(AStream: TStream; const AStartPos, ASize: TIdStreamSize): TIdBytes;
var
  LSize, LAvailable: TIdStreamSize;
begin
  if AStartPos >= 0 then begin
    AStream.Position := AStartPos;
  end;
  LAvailable := AStream.Size - AStream.Position;
  if ASize < 0 then begin
    LSize := LAvailable;
  end else begin
    LSize := IndyMin(LAvailable, ASize);
  end;
  Result := GetHashBytes(AStream, LSize);
end;

function TIdHash.HashStreamAsHex(AStream: TStream; const AStartPos, ASize: TIdStreamSize): String;
begin
  Result := HashToHex(HashStream(AStream, AStartPos, ASize));
end;

function TIdHash.WordHashToHex(const AHash: TIdBytes; const ACount: Integer): String;
var
  LValue: UInt16;
  I: Integer;
begin
  Result := '';
  for I := 0 to ACount-1 do begin
    LValue := BytesToUInt16(AHash, SizeOf(UInt16)*I);
    Result := Result + IntToHex(LValue, 4);
  end;
end;

function TIdHash.LongWordHashToHex(const AHash: TIdBytes; const ACount: Integer): String;
begin
  Result := ToHex(AHash, ACount*SizeOf(UInt32));
end;

class function TIdHash.IsAvailable : Boolean;
begin
  Result := True;
end;

{ TIdHash16 }

function TIdHash16.GetHashBytes(AStream: TStream; ASize: TIdStreamSize): TIdBytes;
const
  cBufSize = 1024; // Keep it small for dotNet
var
  I: Integer;
  LBuffer: TIdBytes;
  LSize: Integer;
  LHash: UInt16;
begin
  Result := nil;
  HashStart(LHash);

  SetLength(LBuffer, cBufSize);

  while ASize > 0 do
  begin
    LSize := ReadTIdBytesFromStream(AStream, LBuffer, IndyMin(cBufSize, ASize));
    if LSize < 1 then begin
      Break; // TODO: throw a stream read exception instead?
    end;
    for i := 0 to LSize - 1 do begin
      HashByte(LHash, LBuffer[i]);
    end;
    Dec(ASize, LSize);
  end;

  HashEnd(LHash);

  SetLength(Result, SizeOf(UInt16));
  CopyTIdUInt16(LHash, Result, 0);
end;

function TIdHash16.HashToHex(const AHash: TIdBytes): String;
begin
  Result := IntToHex(BytesToUInt16(AHash), 4);
end;

procedure TIdHash16.HashEnd(var VRunningHash : UInt16);
begin
end;

function TIdHash16.HashValue(const ASrc: string; ADestEncoding: IIdTextEncoding = nil
  {$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
  ): UInt16;
begin
  Result := BytesToUInt16(HashString(ASrc, ADestEncoding{$IFDEF STRING_IS_ANSI}, ASrcEncoding{$ENDIF}));
end;

function TIdHash16.HashValue(const ASrc: TIdBytes): UInt16;
begin
  Result := BytesToUInt16(HashBytes(ASrc));
end;

function TIdHash16.HashValue(AStream: TStream): UInt16;
begin
  Result := BytesToUInt16(HashStream(AStream));
end;

function TIdHash16.HashValue(AStream: TStream; const AStartPos, ASize: TIdStreamSize): UInt16;
begin
  Result := BytesToUInt16(HashStream(AStream, AStartPos, ASize));
end;

{ TIdHash32 }

function TIdHash32.GetHashBytes(AStream: TStream; ASize: TIdStreamSize): TIdBytes;
const
  cBufSize = 1024; // Keep it small for dotNet
var
  I: Integer;
  LBuffer: TIdBytes;
  LSize: Integer;
  LHash: UInt32;
begin
  Result := nil;
  HashStart(LHash);

  SetLength(LBuffer, cBufSize);

  while ASize > 0 do
  begin
    LSize := ReadTIdBytesFromStream(AStream, LBuffer, IndyMin(cBufSize, ASize));
    if LSize < 1 then begin
      Break;  // TODO: throw a stream read exception instead?
    end;
    for i := 0 to LSize - 1 do begin
      HashByte(LHash, LBuffer[i]);
    end;
    Dec(ASize, LSize);
  end;

  HashEnd(LHash); // RLebeau: TIdHashCRC32 uses this to XOR the hash with $FFFFFFFF

  SetLength(Result, SizeOf(UInt32));
  CopyTIdUInt32(LHash, Result, 0);
end;

function TIdHash32.HashToHex(const AHash: TIdBytes): String;
begin
  Result := UInt32ToHex(BytesToUInt32(AHash));
end;

procedure TIdHash32.HashEnd(var VRunningHash : UInt32);
begin
end;

function TIdHash32.HashValue(const ASrc: string; ADestEncoding: IIdTextEncoding = nil
  {$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF}
  ): UInt32;
begin
  Result := BytesToUInt32(HashString(ASrc, ADestEncoding{$IFDEF STRING_IS_ANSI}, ASrcEncoding{$ENDIF}));
end;

function TIdHash32.HashValue(const ASrc: TIdBytes): UInt32;
begin
  Result := BytesToUInt32(HashBytes(ASrc));
end;

function TIdHash32.HashValue(AStream: TStream) : UInt32;
begin
  Result := BytesToUInt32(HashStream(AStream));
end;

function TIdHash32.HashValue(AStream: TStream; const AStartPos, ASize: TIdStreamSize) : UInt32;
begin
  Result := BytesToUInt32(HashStream(AStream, AStartPos, ASize));
end;


{ TIdHashIntf }

function TIdHashIntf.FinalHash(ACtx: TIdHashIntCtx): TIdBytes;
{$IFDEF DOTNET}
var
  LDummy : TIdBytes;
{$ENDIF}
begin
  {$IFDEF DOTNET}
  //This is a funny way of coding.  I have to pass a dummy value to
  //TransformFinalBlock so that things can work similarly to the OpenSSL
  //Crypto API.  You can't pass nul to TransformFinalBlock without an exception.
  SetLength(LDummy,0);
  ACtx.TransformFinalBlock(LDummy,0,0);
  Result := ACtx.Hash;
  {$ELSE}
  Result := IdFIPS.FinalHashInst(ACtx);
  {$ENDIF}
end;

function TIdHashIntf.GetHashBytes(AStream: TStream; ASize: TIdStreamSize): TIdBytes;
var
  LBuf : TIdBytes;
  LSize : Int64;
  LCtx : TIdHashIntCtx;
begin
  LCtx := InitHash;
  try
    if ASize > 0 then begin
      SetLength(LBuf, 2048);
      repeat
        LSize := ReadTIdBytesFromStream(AStream,LBuf,IndyMin(ASize, 2048));
        if LSize < 1 then begin
          break;
        end;
        if LSize < 2048 then begin
          SetLength(LBuf,LSize);
          UpdateHash(LCtx,LBuf);
          break;
        end;
        UpdateHash(LCtx,LBuf);
        Dec(ASize, LSize);
      until ASize = 0;
    end;
  finally
    Result := FinalHash(LCtx);
  end;
end;

function TIdHashIntf.HashToHex(const AHash: TIdBytes): String;
begin
  Result := ToHex(AHash);
end;

{$IFDEF DOTNET}
class function TIdHashIntf.IsAvailable: Boolean;
begin
  Result := True;
end;

class function TIdHashIntF.IsIntfAvailable: Boolean;
begin
   Result := False;
end;
{$ELSE}
//done this way so we can override IsAvailble if there is a native
//implementation.


class function TIdHashIntf.IsAvailable: Boolean;
begin
  Result := IsIntfAvailable;
end;

class function TIdHashIntF.IsIntfAvailable: Boolean;
begin
   Result := IsHashingIntfAvail;
end;
{$ENDIF}

procedure TIdHashIntf.UpdateHash(ACtx: TIdHashIntCtx; const AIn: TIdBytes);
begin
  UpdateHashInst(ACtx,AIn);
  {$IFDEF DOTNET}
  ACtx.TransformBlock(AIn,0,Length(AIn),AIn,0);
  {$ELSE}
  {$ENDIF}
end;

{ TIdHashNativeAndIntF }

function TIdHashNativeAndIntF.GetHashBytes(AStream: TStream;
  ASize: TIdStreamSize): TIdBytes;
begin
  if IsIntfAvailable then begin
    Result := inherited GetHashBytes(AStream, ASize);
  end else begin
    Result := NativeGetHashBytes(AStream, ASize);
  end;
end;

function TIdHashNativeAndIntF.NativeGetHashBytes(AStream: TStream;
  ASize: TIdStreamSize): TIdBytes;
begin
  Result := nil;
end;

end.