rmd160.pas

详细说明:毕业论文中关于小型宾馆管理系统的详细设计毕 业论文中关于小型宾馆...一个酒店管理系统VB+Access [学生学籍管理系统(VB+Acess).zip] - !这个是刚刚编的毕业设计,可能

{
***************************************************
* A binary compatible RIPEMD-160 implementation   *
* written by Dave Barton ([e-mail]) *
***************************************************
* 160bit hash                                     *
***************************************************
}
unit RMD160;

interface
uses
  Windows, SysUtils;

type
  TRMD160Context= record
    Hash: array[0..4] of DWord;
    Index: integer;
    LenHi, LenLo: integer;
    case integer of
      1: (Buf: array[0..63] of byte);
      2: (X: array[0..15] of DWord);
  end;
  TRMD160Digest= array[0..19] of byte;

function EncryptPassword(const Password: String): String;
function RMD160SelfTest: boolean;
procedure RMD160Init(var Context: TRMD160Context);
procedure RMD160Update(var Context: TRMD160Context; Buffer: pointer; Len: integer);
procedure RMD160Final(var Context: TRMD160Context; var Digest: TRMD160Digest);

//******************************************************************************
implementation

//
// Encrypt a string using one-way encryption. This is used for storing
// passwords in the database server and registry.
//
// Args: password (string to encrypt)
//
// Returns: encrypted string (32 characters in length),
//          else empty string on error
//
// NOTE: If password is an empty string then '$$EMPTYSTRING$$' is used
//       as the password
//
function EncryptPassword(const Password: String): String;
var Context: TRMD160Context;
    Digest: TRMD160Digest;
    i: Integer;
    use_password: String;
begin
     // Empty string?
     if Password='' then use_password:='$$EMPTYSTRING$$'
     else use_password:=Password;

     // Initialise
     RMD160Init(Context);

     // Encrypt password
     RMD160Update(Context,@use_password[1],length(use_password));
     RMD160Final(Context,Digest);

     // Convert it into an ASCII safe string - we are breaking it here
     // because the encrypted string is 20 bytes long, but we need to convert
     // it into hex which will double the size of the string to 40 chars.
     // We only have 32 characters to use, so we need to trim the length.
     Result:='';
     for i:=0 to SizeOf(Digest) do
         Result:=Result + Format('%x', [Ord(Digest[i])]);
     if Length(Result)>32 then SetLength(Result, 32);
end;

function RMD160SelfTest: boolean;
const
  s: string= '12345678901234567890123456789012345678901234567890123456789012345678901234567890';
  OutDigest: TRMD160Digest=
    ($9b,$75,$2e,$45,$57,$3d,$4b,$39,$f4,$db,$d3,$32,$3c,$ab,$82,$bf,$63,$32,$6b,$fb);
var
  Context: TRMD160Context;
  Digest: TRMD160Digest;
begin
  RMD160Init(Context);
  RMD160Update(Context,@s[1],length(s));
  RMD160Final(Context,Digest);
  if CompareMem(@Digest,@OutDigest,Sizeof(Digest)) then
    Result:= true
  else
    Result:= false;
end;

//******************************************************************************
procedure RMD160Init(var Context: TRMD160Context);
begin
  Context.Hash[0]:= $67452301;
  Context.Hash[1]:= $efcdab89;
  Context.Hash[2]:= $98badcfe;
  Context.Hash[3]:= $10325476;
  Context.Hash[4]:= $c3d2e1f0;
  Context.Index:= 0;
  Context.LenHi:= 0;
  Context.LenLo:= 0;
end;

//******************************************************************************
function ROL(x: DWord; n: DWord): DWord; assembler;
asm
  mov ecx,n
  rol &x,cl
end;

//******************************************************************************
function F1(x, y, z: DWord): DWord;
begin
  Result:= x xor y xor z;
end;
function F2(x, y, z: DWord): DWord;
begin
  Result:= (x and y) or ((x xor $FFFFFFFF) and z);
end;
function F3(x, y, z: DWord): DWord;
begin
  Result:= (x or (y xor $FFFFFFFF)) xor z;
end;
function F4(x, y,  z: DWord): DWord;
begin
  Result:= (x and z) or (y and (z xor $FFFFFFFF));
end;
function F5(x, y, z: DWord): DWord;
begin
  Result:= x xor (y or (z xor $FFFFFFFF));
end;

//******************************************************************************
procedure FF1(var a, b, c: DWord; d, e, x, s: DWord);
begin
  a:= a + F1(b, c, d) + x;
  a:= ROL(a,s) + e;
  c:= ROL(c,10);
end;
procedure FF2(var a, b, c: DWord; d, e, x, s: DWord);
begin
  a:= a + F2(b, c, d) + x + $5a827999;
  a:= ROL(a,s) + e;
  c:= ROL(c,10);
end;
procedure FF3(var a, b, c: DWord; d, e, x, s: DWord);
begin
  a:= a + F3(b, c, d) + x + $6ed9eba1;
  a:= ROL(a,s) + e;
  c:= ROL(c,10);
end;
procedure FF4(var a, b, c: DWord; d, e, x, s: DWord);
begin
  a:= a + F4(b, c, d) + x + $8f1bbcdc;
  a:= ROL(a,s) + e;
  c:= ROL(c,10);
end;
procedure FF5(var a, b, c: DWord; d, e, x, s: DWord);
begin
  a:= a + F5(b, c, d) + x + $a953fd4e;
  a:= ROL(a,s) + e;
  c:= ROL(c,10);
end;
procedure FFF1(var a, b, c: DWord; d, e, x, s: DWord);
begin
  a:= a + F1(b, c, d) + x;
  a:= ROL(a,s) + e;
  c:= ROL(c,10);
end;
procedure FFF2(var a, b, c: DWord; d, e, x, s: DWord);
begin
  a:= a + F2(b, c, d) + x + $7a6d76e9;
  a:= ROL(a,s) + e;
  c:= ROL(c,10);
end;
procedure FFF3(var a, b, c: DWord; d, e, x, s: DWord);
begin
  a:= a + F3(b, c, d) + x + $6d703ef3;
  a:= ROL(a,s) + e;
  c:= ROL(c,10);
end;
procedure FFF4(var a, b, c: DWord; d, e, x, s: DWord);
begin
  a:= a + F4(b, c, d) + x + $5c4dd124;
  a:= ROL(a,s) + e;
  c:= ROL(c,10);
end;
procedure FFF5(var a, b, c: DWord; d, e, x, s: DWord);
begin
  a:= a + F5(b, c, d) + x + $50a28be6;
  a:= ROL(a,s) + e;
  c:= ROL(c,10);
end;

//******************************************************************************
procedure RMD160Compress(var Context: TRMD160Context);
var
  aa, bb, cc, dd, ee, aaa, bbb, ccc, ddd, eee: DWord;
begin
  aa:= Context.Hash[0];
  aaa:= Context.Hash[0];
  bb:= Context.Hash[1];
  bbb:= Context.Hash[1];
  cc:= Context.Hash[2];
  ccc:= Context.Hash[2];
  dd:= Context.Hash[3];
  ddd:= Context.Hash[3];
  ee:= Context.Hash[4];
  eee:= Context.Hash[4];
  with Context do
  begin
    FF1(aa, bb, cc, dd, ee, X[ 0], 11);
    FF1(ee, aa, bb, cc, dd, X[ 1], 14);
    FF1(dd, ee, aa, bb, cc, X[ 2], 15);
    FF1(cc, dd, ee, aa, bb, X[ 3], 12);
    FF1(bb, cc, dd, ee, aa, X[ 4],  5);
    FF1(aa, bb, cc, dd, ee, X[ 5],  8);
    FF1(ee, aa, bb, cc, dd, X[ 6],  7);
    FF1(dd, ee, aa, bb, cc, X[ 7],  9);
    FF1(cc, dd, ee, aa, bb, X[ 8], 11);
    FF1(bb, cc, dd, ee, aa, X[ 9], 13);
    FF1(aa, bb, cc, dd, ee, X[10], 14);
    FF1(ee, aa, bb, cc, dd, X[11], 15);
    FF1(dd, ee, aa, bb, cc, X[12],  6);
    FF1(cc, dd, ee, aa, bb, X[13],  7);
    FF1(bb, cc, dd, ee, aa, X[14],  9);
    FF1(aa, bb, cc, dd, ee, X[15],  8);

    FF2(ee, aa, bb, cc, dd, X[ 7],  7);
    FF2(dd, ee, aa, bb, cc, X[ 4],  6);