{*******************************************************}
{                                                       }
{       Tocsg.Hash                                      }
{                                                       }
{       Copyright (C) 2020 kku                          }
{                                                       }
{*******************************************************}

unit Tocsg.Hash;

interface

uses
//  EM.SHA1, // 11.1 에서 제대로 동작 하지 않음 22_0419 08:29:50 kku
  Windows, SysUtils, System.Classes, EM.MD5, EM.Tocsg.Sha1,
  EM.Tocsg.hash, Tocsg.Obj;

type
  THashStreamBase = class(TTgObject)
  protected
    bInit_: Boolean;
  public
    Constructor Create(bInit: Boolean = true);
    procedure WorkInit; virtual; abstract;
    procedure SetBuffer(buf: Pointer; nCount: Integer); virtual; abstract;

    function WorkFinalToStr: String; virtual; abstract;
  end;

  TSHA1Hash = class(THashStreamBase)
  private
    ctx_: TTgHashContext; // TSHA1Context;
  public
    procedure WorkInit; override;
    procedure SetBuffer(buf: Pointer; nCount: Integer); override;
    function WorkFinalToStr: String; override;
    function WorkFinalToDigest(var SHA1Digest: TSHA1Digest): Boolean;
  end;

  TSHA256Hash = class(THashStreamBase)
  private
    ctx_: TTgHashContext; // TSHA1Context;
  public
    procedure WorkInit; override;
    procedure SetBuffer(buf: Pointer; nCount: Integer); override;
    function WorkFinalToStr: String; override;
    function WorkFinalToDigest(var SHA256Digest: TSHA256Digest): Boolean;
  end;

  TMD5Hash = class(THashStreamBase)
  private
    ctx_: TMD5Context;
  public
    procedure WorkInit; override;
    procedure SetBuffer(buf: Pointer; nCount: Integer); override;
    function WorkFinalToStr: String; override;
  end;

  TTgHashProgress = reference to function(s: TStream; nPercent: Integer): Boolean;

function GetStreamToSha1Str(aStream: TStream; aProgress: TTgHashProgress = nil): String;
function GetFileToSha1Str(const sPath: String; aProgress: TTgHashProgress = nil): String;

function GetStreamToHash(aStream: TStream; var sSHA1, sMD5, sSHA256: AnsiString;
            aProgress: TTgHashProgress = nil; llUntilSize: LONGLONG = 0): Boolean;
function GetFileToHash(const sPath: String; var sSHA1, sMD5, sSHA256: AnsiString;
            aProgress: TTgHashProgress = nil; llUntilSize: LONGLONG = 0): Boolean; overload;

function GetStreamToSha256(aStream: TStream; aProgress: TTgHashProgress = nil; llUntilSize: LONGLONG = 0): AnsiString;
function GetFileToSha256(const sPath: String; aProgress: TTgHashProgress = nil; llUntilSize: LONGLONG = 0): AnsiString;

function ConvStrToSha1A(str: AnsiString): String;
function ConvStrToSha1A_Bin(str: AnsiString): TBytes;
function ConvStrToSha1W(str: WideString): String;
function ConvStrToSha256A_Bin(str: AnsiString): TBytes;
function ConvStrToSha256A(str: AnsiString): String;
function ConvStrToSha256W(str: WideString): String;
function ConvStrToHash(str: String): DWORD;

// By .. https://helloacm.com/simple-and-fast-hash-functions-in-delphi/
type
  HashFunction = function(aData: Pointer; aDataLength: Integer): DWORD;

function Hash_djb2(aData: Pointer; aDataLength: Integer): NativeUInt;
function Hash_djb2a(aData: Pointer; aDataLength: Integer): NativeUInt;
function Hash_fnv(aData: Pointer; aDataLength: Integer): NativeUInt;
function Hash_fnv1a(aData: Pointer; aDataLength: Integer): NativeUInt;
function Hash_sdbm(aData: Pointer; aDataLength: Integer): NativeUInt;
function Hash_jenkis(aData: Pointer; aDataLength: Integer): NativeUInt;

implementation

uses
  EM.CRC32, EM.Tocsg.sha256, Tocsg.Binary, Tocsg.Safe, Tocsg.Exception;

const
//  BUF_SIZE = 65536; // 이거 쓰면 Range 오류남 25_0911 17:38:13 kku
  BUF_SIZE = 32768;

function ConvStrToSha1A(str: AnsiString): String;
var
  nRead : Integer;
  ctx: TTgHashContext; //TSHA1Context;
  sd: TSHA1Digest;
begin
  try
    SHA1Init(ctx);
    nRead := Length(str);
    SHA1Update(ctx, @str[1], nRead);

    SHA1Final(ctx, sd);
    Result := ConvBytesToHexStr(PByte(@sd), SizeOf(sd));
  finally

  end;
end;

function ConvStrToSha1A_Bin(str: AnsiString): TBytes;
var
  nRead : Integer;
  ctx: TTgHashContext; //TSHA1Context;
  sd: TSHA1Digest;
begin
  try
    SHA1Init(ctx);
    nRead := Length(str);
    SHA1Update(ctx, @str[1], nRead);

    SHA1Final(ctx, sd);
    SetLength(Result, Length(sd));
    CopyMemory(Result, @sd[0], SizeOf(sd));
  finally

  end;
end;

function ConvStrToSha1W(str: WideString): String;
var
  nRead: Integer;
  ctx: TTgHashContext; //TSHA1Context;
  sd: TSHA1Digest;
begin
  try
    if str = '' then
    begin
      Result := '';
      exit;
    end;

    SHA1Init(ctx);
    nRead := Length(str);
    SHA1Update(ctx, @str[1], nRead*2);

    SHA1Final(ctx, sd);
    Result := ConvBytesToHexStr(PByte(@sd), SizeOf(sd));
  except
    on E: Exception do
      ETgException.TraceException(E, 'Fail .. ConvStrToSha1W()');
  end;
end;

function ConvStrToSha256A_Bin(str: AnsiString): TBytes;
var
  nRead : Integer;
  ctx: TTgHashContext;
  sd: TSHA256Digest;
begin
  try
    SHA256Init(ctx);
    nRead := Length(str);
    SHA256Update(ctx, @str[1], nRead);

    SHA256Final(ctx, sd);
    SetLength(Result, Length(sd));
    CopyMemory(Result, @sd[0], SizeOf(sd));
  finally

  end;
end;

function ConvStrToSha256A(str: AnsiString): String;
var
  nRead: Integer;
  ctx: TTgHashContext;
  sd: TSHA256Digest;
begin
  Result := '';
  try
    if str = '' then
      exit;

    SHA256Init(ctx);
    nRead := Length(str);
    SHA256Update(ctx, @str[1], nRead);

    SHA256Final(ctx, sd);
    Result := ConvBytesToHexStr(PByte(@sd), SizeOf(sd));
  except
    on E: Exception do
      ETgException.TraceException(E, 'Fail .. ConvStrToSha256A()');
  end;
end;

function ConvStrToSha256W(str: WideString): String;
var
  nRead: Integer;
  ctx: TTgHashContext;
  sd: TSHA256Digest;
begin
  Result := '';
  try
    if str = '' then
      exit;

    SHA256Init(ctx);
    nRead := Length(str);
    SHA256Update(ctx, @str[1], nRead*2);

    SHA256Final(ctx, sd);
    Result := ConvBytesToHexStr(PByte(@sd), SizeOf(sd));
  except
    on E: Exception do
      ETgException.TraceException(E, 'Fail .. ConvStrToSha256W()');
  end;
end;

function GetStreamToSha1Str(aStream: TStream; aProgress: TTgHashProgress = nil): String;
var
  nRead: Integer;
  pBuf: array [0..BUF_SIZE] of AnsiChar;
  ctx: TTgHashContext; //TSHA1Context;
  sd: TSHA1Digest;
begin
  Result := '';

  SHA1Init(ctx);
  Repeat
    nRead := aStream.Read(pBuf, BUF_SIZE);
    SHA1Update(ctx, @pBuf, nRead);

    if Assigned(aProgress) then
      if not aProgress(aStream, (aStream.Position * 100) div aStream.Size) then
        exit;
  Until nRead <> BUF_SIZE;

  SHA1Final(ctx, sd);
  Result := ConvBytesToHexStr(PByte(@sd), SizeOf(sd));
end;

function GetFileToSha1Str(const sPath: String; aProgress: TTgHashProgress = nil): String;
var
  fs: TFileStream;
begin
  Result := '';
  try
    if FileExists(sPath) then
    begin
      Guard(fs, TFileStream.Create(sPath, fmOpenRead or fmShareDenyNone));
      Result := GetStreamToSha1Str(fs, aProgress);
    end;
  except
    exit;
  end;
end;

function GetFileToHash(const sPath: String; var sSHA1, sMD5, sSHA256: AnsiString;
            aProgress: TTgHashProgress = nil; llUntilSize: LONGLONG = 0): Boolean;
var
  fs: TFileStream;
begin
  try
    Guard(fs, TFileStream.Create(sPath, fmOpenRead or fmShareDenyNone));
    Result := GetStreamToHash(fs, sSHA1, sMD5, sSHA256, aProgress, llUntilSize);
  except
    Result := false;
    exit;
  end;
end;

function GetStreamToHash(aStream: TStream; var sSHA1, sMD5, sSHA256: AnsiString;
            aProgress: TTgHashProgress = nil; llUntilSize: LONGLONG = 0): Boolean;
var
  nRead: Integer;
  pBuf: array [0..BUF_SIZE-1] of AnsiChar;
  SHA1Ctx: TTgHashContext; //TSHA1Context;
  MD5Ctx: TMD5Context;
  SHA256Ctx: TTgHashContext;
  sd: TSHA1Digest;
  md: EM.MD5.TMD5Digest;
  s256d: TSHA256Digest;
  llTotalRead: LONGLONG;
begin
  Result := false;

  if aStream.Size > 0 then
  begin
    llTotalRead := 0;
    sSHA1 := '';
    sMD5  := '';
    sSHA256 := '';

    MD5Init(MD5Ctx);
    SHA1Init(SHA1Ctx);
    SHA256Init(SHA256Ctx);
    Repeat
      nRead := aStream.Read(pBuf, BUF_SIZE);
      MD5Update(MD5Ctx, @pBuf, nRead);
      SHA1Update(SHA1Ctx, @pBuf, nRead);
      SHA256Update(SHA256Ctx, @pBuf, nRead);

      if Assigned(aProgress) then
        if not aProgress(aStream, (aStream.Position * 100) div aStream.Size) then
          exit;

      Inc(llTotalRead, nRead);
      if (llUntilSize > 0) and (llUntilSize <= llTotalRead) then // 추가 15_0921 11:43:31 kku
        break;
    Until (nRead <> BUF_SIZE) or (aStream.Size <= llTotalRead);

    MD5Final(MD5Ctx, md);
    SHA1Final(SHA1Ctx, sd);
    SHA256Final(SHA256Ctx, s256d);

    sMD5  := ConvBytesToHexStr(PByte(@md), SizeOf(md));
    sSHA1 := ConvBytesToHexStr(PByte(@sd), SizeOf(sd));
    sSHA256 := ConvBytesToHexStr(PByte(@s256d), SizeOf(s256d));

    Result := true;
  end;
end;

function GetStreamToSha256(aStream: TStream; aProgress: TTgHashProgress = nil; llUntilSize: LONGLONG = 0): AnsiString;
//const
//  BUF_SIZE2 = 32768; // BUF_SIZE(65536) 사용하면 Range 오류난다 25_0728 18:20:37 kku
var
  nRead: Integer;
  pBuf: array [0..BUF_SIZE-1] of AnsiChar;
  SHA256Ctx: TTgHashContext;
  s256d: TSHA256Digest;
  llTotalRead: LONGLONG;
begin
  Result := '';

  if aStream.Size > 0 then
  begin
    llTotalRead := 0;

    SHA256Init(SHA256Ctx);
    Repeat
      nRead := aStream.Read(pBuf, BUF_SIZE);
      SHA256Update(SHA256Ctx, @pBuf, nRead);

      if Assigned(aProgress) then
        if not aProgress(aStream, (aStream.Position * 100) div aStream.Size) then
          exit;

      Inc(llTotalRead, nRead);
      if (llUntilSize > 0) and (llUntilSize <= llTotalRead) then // 추가 15_0921 11:43:31 kku
        break;
    Until (nRead <> BUF_SIZE) or (aStream.Size <= llTotalRead);

    SHA256Final(SHA256Ctx, s256d);

    Result := ConvBytesToHexStr(PByte(@s256d), SizeOf(s256d));
  end;
end;

function GetFileToSha256(const sPath: String; aProgress: TTgHashProgress = nil; llUntilSize: LONGLONG = 0): AnsiString;
var
  fs: TFileStream;
begin
  try
    Guard(fs, TFileStream.Create(sPath, fmOpenRead or fmShareDenyNone));
    Result := GetStreamToSha256(fs, aProgress, llUntilSize);
  except
    Result := '';
    exit;
  end;
end;

// IniFiles.pas 에서 TStringHash.HashOf 가져옴 2010-11-04 kku
function ConvStrToHash(str: String): DWORD;
var
  i: Integer;
begin
  Result := 0;
  for i := 1 to Length(str) do
    Result := ((Result shl 2) or
               (Result shr (SizeOf(Result) * 8 - 2))) xor
               Ord(str[i]);
end;

{ THashStreamBase }

Constructor THashStreamBase.Create(bInit: Boolean = true);
begin
  Inherited Create;

  bInit_ := false;

  if bInit then
    WorkInit;
end;

{ TSHA1Hash }

procedure TSHA1Hash.WorkInit;
begin
  SHA1Init(ctx_);
  bInit_ := true;
end;

procedure TSHA1Hash.SetBuffer(buf: Pointer; nCount: Integer);
begin
  if bInit_ then
    SHA1Update(ctx_, buf, nCount);
end;

function TSHA1Hash.WorkFinalToStr: String;
var
  sd : TSHA1Digest;
begin
  Result := '';
  if bInit_ then
  begin
    SHA1Final(ctx_, sd);
    Result := ConvBytesToHexStr(PByte(@sd), SizeOf(sd));
    bInit_ := false;
  end;
end;

function TSHA1Hash.WorkFinalToDigest(var SHA1Digest: TSHA1Digest): Boolean;
begin
  Result := false;
  ZeroMemory(@SHA1Digest, SizeOf(SHA1Digest));
  if bInit_ then
  begin
    SHA1Final(ctx_, SHA1Digest);
    bInit_ := false;
    Result := true;
  end;
end;

{ TSHA256Hash }

procedure TSHA256Hash.WorkInit;
begin
  SHA256Init(ctx_);
  bInit_ := true;
end;

procedure TSHA256Hash.SetBuffer(buf: Pointer; nCount: Integer);
begin
  if bInit_ then
    SHA256Update(ctx_, buf, nCount);
end;

function TSHA256Hash.WorkFinalToStr: String;
var
  sd : TSHA256Digest;
begin
  Result := '';
  if bInit_ then
  begin
    SHA256Final(ctx_, sd);
    Result := ConvBytesToHexStr(PByte(@sd), SizeOf(sd));
    bInit_ := false;
  end;
end;

function TSHA256Hash.WorkFinalToDigest(var SHA256Digest: TSHA256Digest): Boolean;
begin
  Result := false;
  ZeroMemory(@SHA256Digest, SizeOf(SHA256Digest));
  if bInit_ then
  begin
    SHA256Final(ctx_, SHA256Digest);
    bInit_ := false;
    Result := true;
  end;
end;

{ TMD5Hash }

procedure TMD5Hash.SetBuffer(buf: Pointer; nCount: Integer);
begin
  if bInit_ then
    MD5Update(ctx_, buf, nCount);
end;

function TMD5Hash.WorkFinalToStr: String;
var
  sd : EM.MD5.TMD5Digest;
begin
  Result := '';
  if bInit_ then
  begin
    MD5Final(ctx_, sd);
    Result := ConvBytesToHexStr(PByte(@sd), SizeOf(sd));
    bInit_ := false;
  end;
end;

procedure TMD5Hash.WorkInit;
begin
  MD5Init(ctx_);
  bInit_ := true;
end;

// By .. https://helloacm.com/simple-and-fast-hash-functions-in-delphi/

// HASH_DJB2
function Hash_djb2(aData: Pointer; aDataLength: Integer): NativeUInt;
var
  i: integer;
begin
  Result := 5381;
  for i := 1 to aDataLength do
  begin
    Result := ((Result shl 5) + Result) + PByte(aData)^;
    aData  := Pointer(NativeUInt(aData) + 1);
  end;
end;

// HASH_DJB2A
// A Slight variation of Hash_djb2
function Hash_djb2a(aData: Pointer; aDataLength: Integer): NativeUInt;
var
  i: integer;
begin
  Result := 5381;
  for i := 1 to aDataLength do
  begin
    Result := ((Result shl 5) xor Result) xor PByte(aData)^;
    aData  := Pointer(NativeUInt(aData) + 1);
  end;
end;

// HASH_FNV
function Hash_fnv(aData: Pointer; aDataLength: Integer): NativeUInt;
var
  i: integer;
begin
  Result := 2166136261;
  for i := 1 to aDataLength do
  begin
    Result := (Result * 16777619) xor PByte(aData)^;
    aData  := Pointer(NativeUInt(aData) + 1);
  end;
end;

// HASH_FNV1A
// Slight variation of Hash_fnv.
function Hash_fnv1a(aData: Pointer; aDataLength: Integer): NativeUInt;
var
  i: integer;
begin
  Result := 2166136261;
  for i := 1 to aDataLength do
  begin
    Result := (Result xor PByte(aData)^) * 16777619;
    aData  := Pointer(NativeUInt(aData) + 1);
  end;
end;

// HASH_SDBM
function Hash_sdbm(aData: Pointer; aDataLength: Integer): NativeUInt;
var
  i: integer;
begin
  Result := 0;
  for i := 1 to aDataLength do
  begin
    Result := PByte(aData)^ + (Result shl 6) + (Result shl 16) - Result;
    aData  := Pointer(NativeUInt(aData) + 1);
  end;
end;

// HASH_JENKIS
function Hash_jenkis(aData: Pointer; aDataLength: Integer): NativeUInt;
var
  i: integer;
begin
  Result := 0;
  for i := 1 to aDataLength do
  begin
    Inc(Result, PByte(aData)^);
    Inc(Result, Result shl 10);
    Result := Result xor (Result shr 6);
    aData  := Pointer(NativeUInt(aData) + 1);
  end;
  Inc(Result, Result shl 3);
  Result := Result xor (Result shr 11);
  Inc(Result, Result shl 15);
end;

function StrToHash_FNV1A(sSrc: String): NativeUInt;
var
  nLen: Integer;
begin
  nLen := Length(sSrc);
  if nLen  = 0 then
  begin
    Result := 0;
    exit;
  end;

  Result := Hash_fnv1a(@sSrc[1], nLen);
end;

end.