(****************************************************************************)
(*                                                                          *)
(*   This file is part of the SXC Extractor project code.                   *)
(*   Created 2019 by Madman.                                                *)
(*   Code algorithm Copyright (c) 2002 by SCS Software.                     *)
(*                                                                          *)
(*   See the file LICENSE.TXT included in this distribution, for details    *)
(*   about the copyright.                                                   *)
(*                                                                          *)
(*   This program is distributed in the hope that it will be useful, but    *)
(*   WITHOUT ANY WARRANTY; without even the implied warranty of             *)
(*   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                   *)
(*                                                                          *)
(****************************************************************************)
unit sxc_hashgen;

interface

type
	HASH_STRING	= AnsiString;
	HASH_SZSTR	= PAnsiChar;
	HASH_CHAR	= AnsiChar;
	HASH_CODE	= UInt64;

function sxc_getHash(st: HASH_STRING): HASH_CODE;

(****************************************************************************)

implementation

type
	PHASH128	= ^HASH128;
	HASH128		= packed array[0..1] of HASH_CODE;

	PHASH256	= ^HASH256;
	HASH256		= packed array[0..3] of HASH_CODE;

	PDWORD		= ^DWORD;
	DWORD		= Longword;

	PQWORD		= ^QWORD;
	QWORD		= UInt64;


(****************************************************************************)
(*   helper functions                                                       *)
(****************************************************************************)

function hash_MULXOR( hash1, hash2: HASH_CODE ): HASH_CODE;
begin
	result	:= (hash1 xor hash2) * HASH_CODE($9DDFEA08EB382D69);
	result	:= ((result shr $2F) xor result xor hash2) * HASH_CODE($9DDFEA08EB382D69);
	result	:= ((result shr $2F) xor result) * HASH_CODE($9DDFEA08EB382D69);
end;

procedure hash_ADDINV( var hh: HASH128; hash1, hash2, hash3, hash4, hash5, hash6: HASH_CODE );
var
	temp1, temp2, temp3: HASH_CODE;
begin
	temp1	:= hash1 + hash5;
	temp2	:= hash4 + temp1 + hash6;
	temp3	:= (temp2 shl $2B) or (temp2 shr $15);
	temp2	:= hash2 + hash3 + temp1;
	hh[0]	:= temp2 + hash4;
	hh[1]	:= ((temp2 shr $2C) or (temp2 shl $14)) + temp1 + temp3;
end;

procedure hash_ADDINVBUF( hashx4: HASH256; var hh: HASH128; hash1, hash2: HASH_CODE );
begin
	hash_ADDINV(
		hh,
		hashx4[0],
		hashx4[1],
		hashx4[2],
		hashx4[3],
		hash1,
		hash2
	);
end;


(****************************************************************************)
(*   hash generation                                                        *)
(****************************************************************************)

function getHash_default: HASH_CODE;
begin
	result := HASH_CODE($9AE16A3B2F90404F);
end;

function getHash_1_3( lpsz: HASH_SZSTR; chlen: integer ): HASH_CODE;
var
	temp: DWORD;
	hash: HASH_CODE;
begin
	if( (lpsz <> nil) and (chlen > 0) and (chlen < 4) ) then
	begin
		temp	:= DWORD(lpsz[0]) + DWORD(lpsz[DWORD(chlen) shr 1]) * $0100;
		hash	:= HASH_CODE(temp) * HASH_CODE($9AE16A3B2F90404F);
		temp	:= DWORD(chlen) + DWORD(lpsz[DWORD(chlen) - 1]) * 4;
		hash	:= hash xor (HASH_CODE(temp) * HASH_CODE($C949D7C7509E6557));
		result	:= ((hash shr $2F) xor hash) * HASH_CODE($9AE16A3B2F90404F);
	end
	else result := 0;
end;

function getHash_4_8( lpsz: HASH_SZSTR; chlen: integer ): HASH_CODE;
begin
	if( (lpsz <> nil) and (chlen >= 4) and (chlen <= 8) ) then
	begin
		result := hash_MULXOR
		(
			HASH_CODE(PDWORD(@lpsz[0])^) * 8 + DWORD(chlen),
			HASH_CODE(PDWORD(@lpsz[DWORD(chlen) - 4])^)
		);
	end
	else result := 0;
end;

function getHash_9_16( lpsz: HASH_SZSTR; chlen: integer ): HASH_CODE;
var
	hash1, hash2, hash3: HASH_CODE;
	temp: DWORD;
begin
	if( (lpsz <> nil) and (chlen > 8) and (chlen <= 16) ) then
	begin
		hash1	:= PQWORD(@lpsz[0])^;
		hash2	:= PQWORD(@lpsz[DWORD(chlen) - 8])^;
		temp	:= DWORD(chlen) and $3F;
		hash3	:= hash2 + HASH_CODE(chlen);
		result	:= hash_MULXOR(hash1, (hash3 shl ($40 - temp)) or (hash3 shr temp)) xor hash2;
	end
	else result := 0;
end;

function getHash_17_32( lpsz: HASH_SZSTR; chlen: integer ): HASH_CODE;
var
	hash1, hash2, hash3, hash4, hash5, hash6: HASH_CODE;
begin
	if( (lpsz <> nil) and (chlen > 16) and (chlen <= 32) ) then
	begin
		hash1	:= PQWORD(@lpsz[0])^ * HASH_CODE($B492B66FBE98F273);
		hash2	:= PQWORD(@lpsz[8])^ xor HASH_CODE($C949D7C7509E6557);
		hash3	:= PQWORD(@lpsz[DWORD(chlen) - $08])^ * HASH_CODE($9AE16A3B2F90404F);
		hash4	:= PQWORD(@lpsz[DWORD(chlen) - $10])^ * HASH_CODE($C3A5C85C97CB3127);
		hash5	:= (hash2 shr $14) or (hash2 shl $2C);
		hash2	:= hash1 - PQWORD(@lpsz[8])^;
		hash6	:= (hash2 shl $15) or (hash2 shr $2B);
		result	:= hash_MULXOR(((hash3 shr $1E) or (hash3 shl $22)) + hash6 + hash4, HASH_CODE(chlen) - hash3 + hash5 + hash1);
	end
	else result := 0;
end;

function getHash_33_64( lpsz: HASH_SZSTR; chlen: integer ): HASH_CODE;
var
	hash1, hash2, hash3, hash4, hash5, hash6, hash7, hash8, hash9: HASH_CODE;
begin
	if( (lpsz <> nil) and (chlen > 32) and (chlen <= 64) ) then
	begin
		hash1	:= PQWORD(@lpsz[$18])^;
		hash2	:= PQWORD(@lpsz[DWORD(chlen) - $10])^;
		hash3	:= (hash2 + HASH_CODE(chlen)) * HASH_CODE($C3A5C85C97CB3127) + PQWORD(@lpsz[0])^;
		result	:= hash3 + hash1;
		hash4	:= (result shl $0C) or (result shr $34);
		hash5	:= (hash3 shl $1B) or (hash3 shr $25);
		hash3	:= hash3 + PQWORD(@lpsz[8])^;
		hash6	:= hash3 shl $39;
		hash5	:= hash5 + ((hash3 shr $07) or hash6);
		result	:= PQWORD(@lpsz[$10])^ + hash3;
		hash6	:= result + PQWORD(@lpsz[$18])^;
		hash7	:= ((result shr $1F) or (result shl $21)) + hash5 + hash4;
		hash8	:= PQWORD(@lpsz[DWORD(chlen) - 8])^;
		result	:= PQWORD(@lpsz[DWORD(chlen) - $20])^ + PQWORD(@lpsz[$10])^;
		hash4	:= result + hash8;
		hash4	:= (hash4 shl $0C) or (hash4 shr $34);
		hash5	:= (result shl $1B) or (result shr $25);
		result	:= result + PQWORD(@lpsz[DWORD(chlen) - $18])^;
		hash5	:= hash5 + ((result shr $07) or (result shl $39));
		result	:= result + hash2;
		hash9	:= (((result shr $1F) or (result shl $21)) + hash6 + hash5 + hash4) * HASH_CODE($9AE16A3B2F90404F);
		result	:= (result + hash8 + hash7) * HASH_CODE($C3A5C85C97CB3127) + hash9;
		result	:= ((result shr $2F) xor result) * HASH_CODE($C3A5C85C97CB3127) + hash7;
		result	:= ((result shr $2F) xor result) * HASH_CODE($9AE16A3B2F90404F);
	end
	else result := 0;
end;

function getHash_65_up( lpsz: HASH_SZSTR; chlen: integer ): HASH_CODE;
var
	hash1, hash2, hash3, hash4: HASH_CODE;
	hh1, hh2: HASH128;
	counter: integer;
	cidx: DWORD;
begin
	if( (lpsz <> nil) and (chlen > 64) ) then
	begin
		hash1	:= PQWORD(@lpsz[DWORD(chlen) - $38])^ + PQWORD(@lpsz[DWORD(chlen) - $10])^;
		hash2	:= hash_MULXOR(PQWORD(@lpsz[DWORD(chlen) - $30])^ + HASH_CODE(chlen), PQWORD(@lpsz[DWORD(chlen) - $18])^);

		hash_ADDINVBUF(
			PHASH256(@lpsz[DWORD(chlen) - $40])^,
			hh1,
			HASH_CODE(chlen),
			hash2
		);

		hash_ADDINVBUF(
			PHASH256(@lpsz[DWORD(chlen) - $20])^,
			hh2,
			hash1 + HASH_CODE($B492B66FBE98F273),
			PQWORD(@lpsz[DWORD(chlen) - $28])^
		);

		hash3	:= PQWORD(@lpsz[DWORD(chlen) - $28])^ * HASH_CODE($B492B66FBE98F273) + PQWORD(@lpsz[0])^;
		counter	:= (chlen - 1) shr $06;
		cidx	:= $30;

		while( counter > 0 ) do
		begin
			hash4	:= PQWORD(@lpsz[cidx - $28])^ + hh1[0] + hash1 + hash3;
			hash3	:= ((hash4 shl $1B) or (hash4 shr $25)) * HASH_CODE($B492B66FBE98F273);
			hash4	:= PQWORD(@lpsz[cidx])^ + hh1[1] + hash1;
			hash1	:= ((hash4 shl $16) or (hash4 shr $2A)) * HASH_CODE($B492B66FBE98F273) + PQWORD(@lpsz[cidx - $08])^ + hh1[0];
			hash3	:= hash3 xor hh2[1];
			hash4	:= hh2[0] + hash2;
			hash2	:= ((hash4 shl $1F) or (hash4 shr $21)) * HASH_CODE($B492B66FBE98F273);

			hash_ADDINV(
				hh1,
				PQWORD(@lpsz[cidx - $30])^,
				PQWORD(@lpsz[cidx - $28])^,
				PQWORD(@lpsz[cidx - $20])^,
				PQWORD(@lpsz[cidx - $18])^,
				hh1[1] * HASH_CODE($B492B66FBE98F273),
				hh2[0] + hash3
			);

			hash_ADDINV(
				hh2,
				PQWORD(@lpsz[cidx - $10])^,
				PQWORD(@lpsz[cidx - $08])^,
				PQWORD(@lpsz[cidx])^,
				PQWORD(@lpsz[cidx + $08])^,
				hh2[1] + hash2,
				PQWORD(@lpsz[cidx - $20])^ + hash1
			);

			hash4	:= hash3;
			hash3	:= hash2;
			hash2	:= hash4;
			cidx	:= cidx + $40;

			Dec(counter);
		end;

		hash4	:= hash_MULXOR(hh1[0], hh2[0]);
		result	:= ((hash1 shr $2F) xor hash1) * HASH_CODE($B492B66FBE98F273) + hash4 + hash2;
		result	:= hash_MULXOR(result, hash_MULXOR(hh1[1], hh2[1]) + hash3);
	end
	else result := 0;
end;


(****************************************************************************)
(*   exported functions                                                     *)
(****************************************************************************)

function sxc_getHash( st: HASH_STRING ): HASH_CODE;
var
	lpsz: HASH_SZSTR;
	slen: integer;
begin
	slen := length(st);
	if( slen > 0 ) then
	begin
		lpsz := HASH_SZSTR(st);
		if( slen < $04 ) then result := getHash_1_3( lpsz, slen )
		else if( slen <= $08 ) then result := getHash_4_8( lpsz, slen )
		else if( slen <= $10 ) then result := getHash_9_16( lpsz, slen )
		else if( slen <= $20 ) then result := getHash_17_32( lpsz, slen )
		else if( slen <= $40 ) then result := getHash_33_64( lpsz, slen )
		else result := getHash_65_up(lpsz, slen);
	end
	else result := getHash_default;
end;


end.