icssha1.pas

ics Internet 控件

   context.Computed   := 0;
   context.Corrupted  := 0;

   Result := shaSuccess;
end;

// This function will return the 160-bit message digest into the
// Message_Digest array  provided by the caller.
function SHA1Result( var context: SHA1Context;
                     var Message_Digest: SHA1Digest ): Integer;
var  i: Integer;
begin
   // if (!context || !Message_Digest) then begin Result:=shaNull; exit end;

   if (context.Corrupted<>0) then begin Result:=context.Corrupted; exit end;

   if (context.Computed=0) then begin
      SHA1PadMessage( context );
      for i:=0 to 63 do begin
          //* message may be sensitive, clear it out */
          context.Message_Block[i] := 0;
      end;
      context.Length_Low  := 0;    //* and clear length */
      context.Length_High := 0;
      context.Computed := 1;
   end;

   for i := 0 to SHA1HashSize-1 do begin
        Message_Digest[i] := chr( context.Intermediate_Hash[i shr 2]
                             shr ( 8 * ( 3 - ( uint32_t(i) and $03 ) ) ) );
   end;

   Result := shaSuccess;
end;

// This function accepts an array of octets as the next portion
// of the message.
function SHA1Input( var context: SHA1Context;
                    message_array: PChar;
                    length: Cardinal ): Integer;
begin
    if (length=0) then begin Result:=shaSuccess; exit end;
    // if (!context || !message_array) then begin Result:=shaNull; exit end;
    if (message_array=nil) then begin Result:=shaNull; exit end;

    if (context.Computed<>0) then begin
        context.Corrupted := shaStateError;
        Result := shaStateError;
        exit;
    end;

    if (context.Corrupted<>0) then begin
         Result := context.Corrupted;
         exit;
    end;

    while (length>0) and (context.Corrupted=0) do begin
       context.Message_Block[context.Message_Block_Index] := (ord(message_array^) and $FF);
       inc( context.Message_Block_Index );

       inc( context.Length_Low, 8 );
       if (context.Length_Low = 0) then begin
           inc( context.Length_High );
           if (context.Length_High = 0) then begin
               // Message is too long
               context.Corrupted := 1;
           end;
       end;

       if (context.Message_Block_Index = 64) then begin
           SHA1ProcessMessageBlock(context);
       end;

       inc( message_array );
       dec( length );
    end;

    Result := shaSuccess;
end;

// ----------------------------------------------------------------------------

// returns SHA1 digest of given string
function SHA1ofStr( const s: String ): SHA1DigestString;
var  context: SHA1Context;
     digest : SHA1Digest;
begin
   SHA1Reset ( context);
   SHA1Input ( context, PChar( @s[1] ), length(s) );
   SHA1Result( context, digest );
   SetLength( Result, sizeof(digest) );
   Move( digest, Result[1], sizeof(digest) );
end;


// returns SHA1 digest of given buffer
function SHA1ofBuf( const buf; buflen: Integer ): SHA1DigestString;
var  context: SHA1Context;
     digest : SHA1Digest;
begin
   SHA1Reset ( context);
   SHA1Input ( context, PChar( buf ), buflen );
   SHA1Result( context, digest );
   SetLength( Result, sizeof(digest) );
   Move( digest, Result[1], sizeof(digest) );
end;


// returns SHA1 digest of given stream
function SHA1ofStream( const strm: TStream ): SHA1DigestString;
var  context: SHA1Context;
     digest : SHA1Digest;
     buf: array[0..4095] of char;
     buflen: Integer;
begin
   SHA1Reset ( context);
   strm.Position := 0;
   repeat
      buflen := strm.Read( buf[0], 4096 );
      if buflen>0 then SHA1Input ( context, buf, buflen );
   until buflen<4096;
   SHA1Result( context, digest );
   SetLength( Result, sizeof(digest) );
   Move( digest, Result[1], sizeof(digest) );
end;


// converts SHA1 digest into a hex-string

function SHA1toHex( const digest: SHA1DigestString ): String;
var  i: Integer;
begin
   Result := '';
   for i:=1 to length(digest) do Result := Result + inttohex( ord( digest[i] ), 2 );
   Result := LowerCase( Result );
end;

// ----------------------------------------------------------------------------

// Keyed SHA1 (HMAC-SHA1), RFC 2104


procedure HMAC_SHA1( const Data; DataLen: Integer;
                     const Key;  KeyLen : Integer;
                     {$IFDEF DELPHI3_UP}out
                     {$ELSE}var{$ENDIF} Digest : SHA1Digest );
var  k_ipad, k_opad: array[0..64] of Byte;
     Context: SHA1Context;
     i      : Integer;
begin
   // clear pads
   FillChar( k_ipad, sizeof(k_ipad), 0 );
   FillChar( k_opad, sizeof(k_ipad), 0 );

   if KeyLen > 64 then begin
        // if key is longer than 64 bytes reset it to key=SHA1(key)
        SHA1Reset ( Context);
        SHA1Input ( Context, PChar(@Key), KeyLen );
        SHA1Result( Context, Digest );
        // store key in pads
        Move( Digest, k_ipad, SHA1HashSize );
        Move( Digest, k_opad, SHA1HashSize );
   end else begin
        // store key in pads
        Move( Key, k_ipad, KeyLen );
        Move( Key, k_opad, KeyLen );
   end;

   // XOR key with ipad and opad values
   for i:=0 to 63 do begin
        k_ipad[i] := k_ipad[i] xor $36;
        k_opad[i] := k_opad[i] xor $5c;
   end;

   // perform inner SHA1
   SHA1Reset ( Context );
   SHA1Input ( Context, PChar(@k_ipad[0]), 64 );
   SHA1Input ( Context, PChar(@Data), DataLen );
   SHA1Result( Context, Digest );

   // perform outer SHA1
   SHA1Reset ( Context );
   SHA1Input ( Context, PChar(@k_opad[0]), 64 );
   SHA1Input ( Context, Digest, SHA1HashSize );
   SHA1Result( Context, Digest );
end;

function HMAC_SHA1_EX( const Data: String;
			 const Key : String ): String;
var  Digest: SHA1Digest;
begin
   HMAC_SHA1( Data[1], length(Data), Key[1], length(Key), Digest );
   SetLength( Result, SHA1HashSize );
   Move( digest[0], Result[1], SHA1HashSize );
end;

// ----------------------------------------------------------------------------

{
SHA1 test suit:
procedure TForm1.Button1Click(Sender: TObject);
const TEST1   = 'abc';
      TEST2a  = 'abcdbcdecdefdefgefghfghighijhi';
      TEST2b  = 'jkijkljklmklmnlmnomnopnopq';
      TEST2   = TEST2a + TEST2b;
      TEST3   = 'a';
      TEST4a  = '01234567012345670123456701234567';
      TEST4b  = '01234567012345670123456701234567';
      TEST4   = TEST4a + TEST4b;
      testarray: array[0..3] of String = ( TEST1, TEST2, TEST3, TEST4 );
      repeatcount: array[0..3] of Integer = ( 1, 1, 1000000, 10 );
      resultarray: array [0..3] of String = (
             'A9 99 3E 36 47 06 81 6A BA 3E 25 71 78 50 C2 6C 9C D0 D8 9D',
             '84 98 3E 44 1C 3B D2 6E BA AE 4A A1 F9 51 29 E5 E5 46 70 F1',
             '34 AA 97 3C D4 C4 DA A4 F6 1E EB 2B DB AD 27 31 65 34 01 6F',
             'DE A3 56 A2 CD DD 90 C7 A7 EC ED C5 EB B5 63 93 4F 46 04 52' );
var   sha: SHA1Context;
      i, j, err: Integer;
      Message_Digest: SHA1Digest;
      s: String;
begin
    for j := 0 to 3 do begin
        ListBox1.Items.Add( Format( 'Test %d: %d, "%s"',
                            [ j+1, repeatcount[j], testarray[j] ] ) );

        err := SHA1Reset(sha);
        if (err<>0) then begin
            ListBox1.Items.Add( Format( 'SHA1Reset Error %d.', [err] ) );
            break;    //* out of for j loop */
        end;

        for i := 0 to repeatcount[j]-1 do begin
            err := SHA1Input( sha, @testarray[j][1], length(testarray[j]) );
            if (err<>0) then begin
               ListBox1.Items.Add( Format('SHA1Input Error %d.', [err] ) );
               break;    //* out of for i loop */
            end;
        end;

        err := SHA1Result(sha, Message_Digest);
        if (err<>0) then begin
            ListBox1.Items.Add( Format(
            'SHA1Result Error %d, could not compute message digest.', [err] ) );
        end else begin
              s := '';
              for i := 0 to 19 do begin
                  s := s + Format('%02X ', [ ord(Message_Digest[i]) ] );
              end;
              ListBox1.Items.Add( 'Result: ' + s );
        end;

        ListBox1.Items.Add( 'Wanted: ' + Format('%s', [resultarray[j]] ) );
    end;
end;

HMAC-SHA1 test suite of RFC 2202:
procedure TForm1.Button3Click(Sender: TObject);
end;
}

end.