icssha1.pas

BaiduMp3 search baidu mp3

// ============================================================================
// D5-implementation of "US Secure Hash Algorithm 1 (SHA1)" (RFC3174)
// Copyright (c) 2001, Juergen Haible.
//
// Permission is hereby granted, free of charge, to any person obtaining a copy
// of this software and associated documentation files (the "Software"), to
// deal in the Software without restriction, including without limitation the
// rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
// sell copies of the Software, and to permit persons to whom the Software is
// furnished to do so, subject to the following conditions:
//
// The above copyright notice and this permission notice shall be included in
// all copies or substantial portions of the Software.
//
// THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
// IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
// FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
// AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
// LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
// FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
// IN THE SOFTWARE.
// ============================================================================

{------------------------------------------------------------------------------
Update by F. Piette for ICS (http://www.overbyte.be)
Jan 10, 2004 Defined uint32_t as LongWord instead of LongInt
Jul 23, 2004 Revised SHA1Reset to check for nil reference to comply with RFC-3174
             Made the unit compatible with Delphi 2
------------------------------------------------------------------------------}


unit IcsSha1; // "US Secure Hash Algorithm 1 (SHA1)" (RFC3174)

{------------------------------------------------------------------------------

   Based on the reference implementation in RFC 3174

------------------------------------------------------------------------------}

interface
{$I ICSDEFS.INC}
{$R-}
{$Q-}

uses
   SysUtils, Classes;

const
   IcsSHA1Version     = 100;
   CopyRight : String = ' IcsSHA1 (c) 2004-2005 F. Piette V1.00 ';

const
   shaSuccess      = 0;
   shaNull         = 1;
   shaInputTooLong = 2;
   shaStateError   = 3;
   SHA1HashSize    = 20;

type
   {$IFNDEF DELPHI2_UP}
   {$IFNDEF FPC}
   Bomb('This code requires Delphi 2 or later'};
   {$ENDIF}
   {$ENDIF}
   {$IFDEF DELPHI4_UP}
   uint32_t      = LongWord; //Cardinal; // [Should be] unsigned 32 bit integer
   {$ELSE}
   uint32_t      = LongInt;
   {$ENDIF}
   uint8_t       = Byte;     // unsigned 8 bit integer (i.e., unsigned char)
   int_least16_t = LongInt;  // integer of >= 16 bits

   SHA1Digest = array[0..SHA1HashSize-1] of Char;
   SHA1DigestString = AnsiString;  // string containing 20 chars

   // This structure will hold context information for the SHA-1
   // hashing operation
   SHA1Context = record
        Intermediate_Hash: array[0..SHA1HashSize div 4-1] of uint32_t; // Message Digest
        Length_Low : uint32_t;                  // Message length in bits
        Length_High: uint32_t;                  // Message length in bits
        Message_Block_Index: int_least16_t;     // Index into message block array
        Message_Block: array[0..63] of uint8_t; // 512-bit message blocks
        Computed: Integer;                      // Is the digest computed?
        Corrupted: Integer;                     // Is the message digest corrupted?
   end;

function SHA1Reset ( var context       : SHA1Context ): Integer;
function SHA1Input ( var context       : SHA1Context;
                     message_array     : PChar;
                     length            : Cardinal ): Integer;
function SHA1Result( var context       : SHA1Context;
                     var Message_Digest: SHA1Digest ): Integer;

function SHA1ofStr   ( const s: String            ): SHA1DigestString;
function SHA1ofBuf   ( const buf; buflen: Integer ): SHA1DigestString;
function SHA1ofStream( const strm: TStream        ): SHA1DigestString;

function SHA1toHex( const digest: SHA1DigestString ): String;

procedure HMAC_SHA1( const Data; DataLen: Integer;
                     const Key;  KeyLen : Integer;
                     {$IFDEF DELPHI3_UP}out
                     {$ELSE}var{$ENDIF} Digest : SHA1Digest );
function  HMAC_SHA1_EX( const Data: String;
                     const Key : String ): String; //overload;

implementation

// Define the SHA1 circular left shift macro
function SHA1CircularShift( const bits, word: uint32_t ): uint32_t;
begin
   Result := (((word) shl (bits)) or ((word) shr (32-(bits))));
end;

// This function will process the next 512 bits of the message
// stored in the Message_Block array.
procedure SHA1ProcessMessageBlock( var context: SHA1Context );
const K: array[0..3] of uint32_t = (  //* Constants defined in SHA-1   */
                                      $5A827999,
                                      $6ED9EBA1,
                                      $8F1BBCDC,
                                      $CA62C1D6
                                   );
var
    t: Integer;                  //* Loop counter                */
    temp: uint32_t;              //* Temporary word value        */
    W: array[0..79] of uint32_t; //* Word sequence               */
    A, B, C, D, E: uint32_t;     //* Word buffers                */
begin

    // Initialize the first 16 words in the array W
    for t := 0 to 15 do begin
        W[t] := context.Message_Block[t * 4    ] shl 24
             or context.Message_Block[t * 4 + 1] shl 16
             or context.Message_Block[t * 4 + 2] shl 8
             or context.Message_Block[t * 4 + 3];
    end;

    for t := 16 to 79 do begin
       W[t] := SHA1CircularShift(1,W[t-3] xor W[t-8] xor W[t-14] xor W[t-16]);
    end;

    A := context.Intermediate_Hash[0];
    B := context.Intermediate_Hash[1];
    C := context.Intermediate_Hash[2];
    D := context.Intermediate_Hash[3];
    E := context.Intermediate_Hash[4];

    for t := 0 to 19 do begin
        temp :=  SHA1CircularShift(5,A) +
                 ((B and C) or ((not B) and D)) + E + W[t] + K[0];
        E := D;
        D := C;
        C := SHA1CircularShift(30,B);
        B := A;
        A := temp;
    end;

    for t := 20 to 39 do begin
        temp := SHA1CircularShift(5,A) + (B xor C xor D) + E + W[t] + K[1];
        E := D;
        D := C;
        C := SHA1CircularShift(30,B);
        B := A;
        A := temp;
    end;

    for t := 40 to 59 do begin
        temp := SHA1CircularShift(5,A) +
                ((B and C) or (B and D) or (C and D)) + E + W[t] + K[2];
        E := D;
        D := C;
        C := SHA1CircularShift(30,B);
        B := A;
        A := temp;
    end;

    for t := 60 to 79 do begin
        temp := SHA1CircularShift(5,A) + (B xor C xor D) + E + W[t] + K[3];
        E := D;
        D := C;
        C := SHA1CircularShift(30,B);
        B := A;
        A := temp;
    end;

    inc( context.Intermediate_Hash[0], A );
    inc( context.Intermediate_Hash[1], B );
    inc( context.Intermediate_Hash[2], C );
    inc( context.Intermediate_Hash[3], D );
    inc( context.Intermediate_Hash[4], E );

    context.Message_Block_Index := 0;
end;

// According to the standard, the message must be padded to an even
// 512 bits.  The first padding bit must be a '1'.  The last 64
// bits represent the length of the original message.  All bits in
// between should be 0.  This function will pad the message
// according to those rules by filling the Message_Block array
// accordingly.  It will also call the ProcessMessageBlock function
// provided appropriately.  When it returns, it can be assumed that
// the message digest has been computed.
procedure SHA1PadMessage( var context: SHA1Context );
begin
   (*
    *  Check to see if the current message block is too small to hold
    *  the initial padding bits and length.  If so, we will pad the
    *  block, process it, and then continue padding into a second
    *  block.
    *)
    if (context.Message_Block_Index > 55) then begin
        context.Message_Block[context.Message_Block_Index] := $80;
        inc( context.Message_Block_Index );
        while (context.Message_Block_Index < 64) do begin
            context.Message_Block[context.Message_Block_Index] := 0;
            inc( context.Message_Block_Index );
        end;

        SHA1ProcessMessageBlock( context );

        while (context.Message_Block_Index < 56) do begin
            context.Message_Block[context.Message_Block_Index] := 0;
            inc( context.Message_Block_Index );
        end;
    end else begin
        context.Message_Block[context.Message_Block_Index] := $80;
        inc( context.Message_Block_Index );
        while (context.Message_Block_Index < 56) do begin
            context.Message_Block[context.Message_Block_Index] := 0;
            inc( context.Message_Block_Index );
        end;
    end;

    // Store the message length as the last 8 octets
    context.Message_Block[56] := context.Length_High shr 24;
    context.Message_Block[57] := context.Length_High shr 16;
    context.Message_Block[58] := context.Length_High shr 8;
    context.Message_Block[59] := context.Length_High;
    context.Message_Block[60] := context.Length_Low shr 24;
    context.Message_Block[61] := context.Length_Low shr 16;
    context.Message_Block[62] := context.Length_Low shr 8;
    context.Message_Block[63] := context.Length_Low;

    SHA1ProcessMessageBlock(context);
end;

// This function will initialize the SHA1Context in preparation
// for computing a new SHA1 message digest.
function SHA1Reset( var context: SHA1Context ): Integer;
begin
   //FPiette
   if @context = nil then begin
       Result := shaNull;
       Exit;
   end;

   context.Length_Low           := 0;
   context.Length_High          := 0;
   context.Message_Block_Index  := 0;

   context.Intermediate_Hash[0] := $67452301;
   context.Intermediate_Hash[1] := $EFCDAB89;
   context.Intermediate_Hash[2] := $98BADCFE;
   context.Intermediate_Hash[3] := $10325476;