shaconst.~pas

delphi实现加密算法 CRC32-Dym.................CRC32算法动态码表实现 CRC32-Static..............CRC32算法静态码表实现 MD

unit SHAConst;

interface

uses
  Windows,SHAUnit,SysUtils;

const
  SHA         = $101;
  //错误消息
  NOERROR     = 0;
  READERROR    = NOERROR+$1;

type
  {Hash context}
  PHashContext = ^THashContext;
  THashContext = record
    IntData: Pointer;      {Reserved for internal use}
    HashType: LongWord;    {Hash type}
    lParam: LongWord;      {First Param}
    wParam: LongWord;      {Second Param}
  end;

  function GetStrSHA(ShaStr:String):String;
  function GetFileSHA(FileNameStr:String):String;

implementation

function HashInit(Context: PHashContext; HashType: LongWord): LongWord;
begin
  Context^.HashType := HashType;
  Result := NOERROR;
  GetMem(Context^.IntData, SizeOf(TSHACtx));
  SHAInit(PSHACtx(Context^.IntData)^);
end;

function HashUpdate(Context: PHashContext; SrcBuf: Pointer; BufLen: LongWord): LongWord;
begin
  Result := NOERROR;
  SHAUpdate(PSHACtx(Context^.IntData)^, SrcBuf, BufLen, 1);
end;

function HashFinal(Context: PHashContext; var DestHash: String): LongWord;
begin
  Result := NOERROR;
  DestHash := SHAFinal(PSHACtx(Context^.IntData)^, 1);
  FreeMem(Context^.IntData, SizeOf(TSHACtx));
  Context^.IntData := nil;
end;

function HashStr(HashType: LongWord; SrcStr: String; var DestHash: String): LongWord;
var
  ctx: THashContext;
begin
  Result := HashInit(@ctx, HashType);
  if Result = NOERROR then
    Result := HashUpdate(@ctx, PChar(SrcStr), Length(SrcStr));
  if Result = NOERROR then
    Result := HashFinal(@ctx, DestHash);
end;

function HashBuf(HashType: LongWord; SrcBuf: Pointer; BufLen: LongWord; var DestHash: String): LongWord;
var
  ctx: THashContext;
begin
  Result := HashInit(@ctx, HashType);
  if Result = NOERROR then
    Result := HashUpdate(@ctx, SrcBuf, BufLen);
  if Result = NOERROR then
    Result := HashFinal(@ctx, DestHash);
end;

function _GetFileSize(const FName: String): LongWord;
var
  FileHandle: THandle;
begin
  Result := INVALID_FILE_SIZE;
  FileHandle := CreateFile(PChar(FName), GENERIC_READ, FILE_SHARE_READ, nil, OPEN_EXISTING, 0, 0);
  if FileHandle = INVALID_HANDLE_VALUE then Exit;
  Result := GetFileSize(FileHandle, nil);
  CloseHandle(FileHandle);
end;

function _HashFilePartial(ctx: PHashContext; FileName: String; offset1, offset2: LongWord): Boolean;
var
  FileHandle: THandle;
  buf: array[0..4095] of Char;
  read: LongWord;
  done, need: Int64;
begin
  Result := False;
  FileHandle := CreateFile(PChar(FileName), GENERIC_READ, FILE_SHARE_READ, nil, OPEN_EXISTING, 0, 0);
  if FileHandle = INVALID_HANDLE_VALUE then Exit;
  if SetFilePointer(FileHandle, offset1, nil, 0) = LongWord(-1) then
  begin
    CloseHandle(FileHandle);
    Exit;
  end;
  need := offset2 - offset1;
  if need < 0 then Exit;
  done := 0;
  while ReadFile(FileHandle, buf, SizeOf(buf), read, nil) do begin
    if read < 1 then begin
      CloseHandle(FileHandle);
      Exit;
    end;
    if done + read >= need then begin
      HashUpdate(ctx, @buf, need - done);
      Break;
    end else
      HashUpdate(ctx, @buf, read);
    Inc(done, read);
  end;
  CloseHandle(FileHandle);
  Result := True;
end;

function HashFile(HashType: LongWord; FileName: String; var DestHash: String): LongWord;
var
  ctx: THashContext;
  fsz: LongWord;
begin
  FillChar(ctx, SizeOf(ctx), 0);
  fsz := _GetFileSize(FileName);
  Result := HashInit(@ctx, HashType);
  if Result = NO_ERROR then
    if not _HashFilePartial(@ctx, FileName, 0, fsz) then
       Result := READERROR;
  if Result = NO_ERROR then
    Result := HashFinal(@ctx, DestHash);
end;

function HashErrorToStr(Error: LongWord): String;
begin
  case Error of
    NOERROR: Result := 'OK';
    HASH_FR_ERROR: Result := '文件读取失败!';
  else
    Result := '未知错误!';
  end;
end;

function GetStrSHA(ShaStr:String):String;
var
  buf:Pchar;
  buf_len: LongWord;
  Hash: String;
  HashToUse: LongWord;
  str:String;
begin
  try
    Str:=ShaStr;
    buf_len :=Length(Str)+1;
    GetMem(buf,buf_len);
    StrPCopy(buf,PChar(Str));
    HashToUse :=SHA;
    HashBuf(HashToUse, buf, buf_len - 1, Hash);
    Result:=StrUpper(PChar(Hash));
    FreeMem(buf, buf_len);
  except
    Result:='错误!';
  end;
end;

function GetFileSHA(FileNameStr:String):String;
var
  HashToUse: LongWord;
  Hash: String;
begin
  try
    HashToUse:=SHA;
    HashFile(HashToUse, FileNameStr, Hash);
    Result:=StrUpper(PChar(hash));
  except
    Result:='错误!';
  end;
end;

end.