{ --------------------------------------------------------------- }
{ Dieser Quelltext ist urheberrechtlich geschuetzt.               }
{ (c) 2006-2024 FreeXP, http://www.freexp.de                      }
{                                                                 }
{ Dieser Quelltext dient ausschließlich dazu, in FreeXP           }
{ verwendete Quelltexte Dritter, die von FreeXP modifiziert       }
{ wurden, auch in anderen Programmen als FreeXP verwenden zu      }
{ können.                                                         }
{ --------------------------------------------------------------- }

{ Unit hashfile }
unit hashfile;
{$I-}

{ FreeXP-Setting}
{.$DEFINE freexp}

{$IFDEF VER70 }
  {$DEFINE BP}
  {$IFDEF WINDOWS}
    {$DEFINE Win16}
  {$ENDIF }
{$ELSE}
  {$IFDEF VER80 }
    {$DEFINE BP}
    {$IFDEF WINDOWS}
      {$DEFINE Win16}
    {$ENDIF }
  {$ENDIF }
{$ENDIF }

interface

uses
  {$IFDEF FreeXP}typeform,fileio,{$ELSE}freexp,{$ENDIF}BTypes,Hash;

type md5str  = string[32];
type sha1str  = string[40]; 
   
function md5sum_file(const source:string):md5str;
  {-initialize context}
  {$ifdef DLL} stdcall; {$endif}

function md5sum_str(const source:string):md5str;
  {-initialize context}
  {$ifdef DLL} stdcall; {$endif}
 
function sha1sum_file(const source:string):sha1str;
  {-initialize context}
  {$ifdef DLL} stdcall; {$endif}

function sha1sum_str(const source:string):sha1str;
  {-initialize context}
  {$ifdef DLL} stdcall; {$endif}

implementation

uses md5,sha1;

function md5sum_file(const source:string):md5str;
{$ifdef CPU8086}
type md5buf = array[1..$7FFF] of byte;
{$ELSE}
type md5buf = array[1..$FFFF] of byte;
{$endif}
var  f         : file;
     context   : THashContext;
     digest    : TMD5Digest;
     StrDigest : md5str;
     l         : longint;
	 {$ifdef VPASCAL}
     n         : longint;	 
	 {$ELSE}
     n         : word;
	 {$ENDIF}
     w         : byte;
     err       : integer;
     md5bufp   : ^md5buf;
begin
  md5sum_file:='';
  New(md5bufp);
  MD5Init(context);
  w:=FileMode;
  fm_ro;
  assign(f,source);
  reset(f,1);
  err:=IOResult;
  FileMode:=w;
  if err<>0 then begin
    Dispose(md5bufp);
    exit;
  end;
  l:=FileSize(f);
  if IOResult<>0 then begin
     Dispose(md5bufp);
     exit;
  end;
  while (err=0) and (l>0) do
  begin
    blockread(f,md5bufp^,SizeOf(md5buf),n);
    err:=IOResult;
    dec(l,n);
    MD5Update(context,md5bufp,n);
  end;
  close(f);
  if IOResult=0 then;
  if err<>0 then begin
    Dispose(md5bufp);
    exit;
  end;
  MD5Final(context,digest);
  Dispose(md5bufp);
  StrDigest:='';
  for n:=0 to 15 do StrDigest:=StrDigest+hex(digest[n],2);
  md5sum_file:=StrDigest;
end;

function md5sum_str(const source:string):md5str;
var context   : THashContext;
    digest    : TMD5Digest;
    md5buf    : array[1..255] of byte;
    StrDigest : md5str;
    l         : byte;
begin
  md5sum_str:='';
  MD5Init(context);
  l:=length(source);
  move(source[1],md5buf[1],l);
  MD5Update(context,@md5buf,l);
  MD5Final(context,digest);
  StrDigest:='';
  for l:=0 to 15 do StrDigest:=StrDigest+hex(digest[l],2);
  md5sum_str:=StrDigest;
end;

function sha1sum_file(const source:string):sha1str;
{$ifdef CPU8086}
type sha1buf = array[1..$7FFF] of byte;
{$ELSE}
type sha1buf = array[1..$FFFF] of byte;
{$endif}
var  f         : file;
     context   : THashContext;
     digest    : TSHA1Digest;
     StrDigest : sha1str;
     l         : longint;
	 {$ifdef VPASCAL}
     n         : longint;	 
	 {$ELSE}
     n         : word;
	 {$ENDIF}
     w         : byte;
     err       : integer;
     sha1bufp   : ^sha1buf;
begin
  sha1sum_file:='';
  New(sha1bufp);
  SHA1Init(context);
  w:=FileMode;
  fm_ro;
  assign(f,source);
  reset(f,1);
  err:=IOResult;
  FileMode:=w;
  if err<>0 then begin
    Dispose(sha1bufp);
    exit;
  end;
  l:=FileSize(f);
  if IOResult<>0 then begin
     Dispose(sha1bufp);
     exit;
  end;
  while (err=0) and (l>0) do
  begin
    blockread(f,sha1bufp^,SizeOf(sha1buf),n);
    err:=IOResult;
    dec(l,n);
    SHA1Update(context,sha1bufp,n);
  end;
  close(f);
  if IOResult=0 then;
  if err<>0 then begin
    Dispose(sha1bufp);
    exit;
  end;
  SHA1Final(context,digest);
  Dispose(sha1bufp);
  StrDigest:='';
  for n:=0 to 19 do StrDigest:=StrDigest+hex(digest[n],2);
  sha1sum_file:=StrDigest;
end;

function sha1sum_str(const source:string):sha1str;
var context   : THashContext;
    digest    : TSHA1Digest;
    sha1buf    : array[1..255] of byte;
    StrDigest : sha1str;
    l         : byte;
begin
  sha1sum_str:='';
  SHA1Init(context);
  l:=length(source);
  move(source[1],sha1buf[1],l);
  SHA1Update(context,@sha1buf,l);
  SHA1Final(context,digest);
  StrDigest:='';
  for l:=0 to 19 do StrDigest:=StrDigest+hex(digest[l],2);
  sha1sum_str:=StrDigest;
end;

end.
