BSOne.SFC/Tocsg.Lib/VCL/Tocsg.Hash.pas

612 lines
15 KiB
Plaintext

{*******************************************************}
{ }
{ 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.