home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The World of Computer Software
/
World_Of_Computer_Software-02-385-Vol-1of3.iso
/
t
/
tcsel003.zip
/
HASH.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1992-10-16
|
3KB
|
100 lines
UNIT Hash;
{***************************************************************************
* *
* Copyright 1989 Trevor J Carlsen *
* All rights reserved *
* Rovert Software Consulting Services *
* PO Box 568 *
* Port Hedland Western Australia 6721 *
* Telephone (091) 732026 or (091) 732569 *
* *
***************************************************************************}
interface
uses strings,
sundry;
function hashcode(st : string; var nwd : word): word;
implementation
function MakeCodeStr(key : longint; st : string): string;
var
x : word;
len : byte absolute st;
begin
RandSeed := (key * len) DIV ord(st[len]);
MakeCodeStr[0] := st[0];
for x := 1 to len do
MakeCodeStr[x] := chr(Random(255));
end;
function Key(st: string): longint;
var
len : byte absolute st;
x,y : byte;
temp : longint;
tempst : array[0..3] of byte;
procedure makekey(var k; var s : longint);
var t : longint absolute k;
rec : record
case byte of
1 :(b : longint; c : word);
2 :(d : word ; e : longint);
3 :(r : real);
end;
begin
RandSeed := t;
rec.r := random;
s := s xor rec.b xor rec.e;
end;
begin
temp := 0;
for x := 1 to len-3 do begin
for y := 0 to 3 do
tempst[y] := byte(st[x + y]);
makekey(tempst,temp);
end;
Key := temp;
end;
function EncryptStr(key : longint; st : string): string;
var
len : byte absolute st;
cnt,x : byte;
temp,CodeStr : string;
begin
CodeStr := MakeCodeStr(key,st);
temp[0] := st[0];
temp[len] := st[len];
for x := 1 to len-1 do begin
cnt := ord(st[x]) xor ord(CodeStr[x]);
temp[x] := chr(cnt);
end;
cnt := ord(st[len]) xor len;
temp[len] := chr(cnt);
EncryptStr := temp;
end;
function hashcode(st : string; var nwd : word): word;
var k : longint;
len : byte absolute st;
s : string;
begin
k := key(st) * nwd;
st := StUpCase(st);
s := CompressStr(st);
move(s[1],nwd,2);
if len < 4 then st := st + '!@#$';
{-force string to a minimum length}
st := EncryptStr(k,st);
st := EncryptStr(Key(st),st);
hashcode := key(st) shr 16;
end; {hash}
end.