cryptoapi.pas

超级Delphi函数包,包括编程时常需要的一些函数

  case Context^.HashType of
    {$IFDEF INCLUDE_MD}
    HASH_MD2:
    begin
      DestHash := MD2Final(Context^.IntData);
      FreeMem(Context^.IntData, SizeOf(TMD2Ctx));
      Context^.IntData := nil;
    end;
    HASH_MD4:
    begin
      DestHash := MDFinal(Context^.IntData, @MD4Transform);
      FreeMem(Context^.IntData, SizeOf(TMD4Ctx));
      Context^.IntData := nil;
    end;
    HASH_MD5:
    begin
      DestHash := MDFinal(Context^.IntData, @MD5Transform);
      FreeMem(Context^.IntData, SizeOf(TMD4Ctx));
      Context^.IntData := nil;
    end;
    {$ENDIF}
    {$IFDEF INCLUDE_CRC}
    HASH_CRC32, HASH_CRC32B:
    begin
      DestHash := CRC32Final(PLongWord(Context^.IntData)^);
      FreeMem(Context^.IntData, SizeOf(LongWord));
      Context^.IntData := nil;
    end;
    {$ENDIF}
    {$IFDEF INCLUDE_ADLER}
    HASH_ADLER32:
    begin
      DestHash := Adler32Final(PLongWord(Context^.IntData)^);
      FreeMem(Context^.IntData, SizeOf(LongWord));
      Context^.IntData := nil;
    end;
    {$ENDIF}
    {$IFDEF INCLUDE_GOST}
    HASH_GOST:
    begin
      DestHash := GostFinal(PGostCtx(Context^.IntData)^);
      FreeMem(Context^.IntData, SizeOf(TGostCtx));
      Context^.IntData := nil;
    end;
    {$ENDIF}
    {$IFDEF INCLUDE_HAVAL}
    HASH_HAVAL128, HASH_HAVAL160, HASH_HAVAL192, HASH_HAVAL224, HASH_HAVAL256:
    begin
      case Context^.HashType of
        HASH_HAVAL128: DestHash := HavalFinal(PHavalCtx(Context^.IntData)^, Context^.lParam, 128);
        HASH_HAVAL160: DestHash := HavalFinal(PHavalCtx(Context^.IntData)^, Context^.lParam, 160);
        HASH_HAVAL192: DestHash := HavalFinal(PHavalCtx(Context^.IntData)^, Context^.lParam, 192);
        HASH_HAVAL224: DestHash := HavalFinal(PHavalCtx(Context^.IntData)^, Context^.lParam, 224);
        HASH_HAVAL256: DestHash := HavalFinal(PHavalCtx(Context^.IntData)^, Context^.lParam, 256);
      end;
      FreeMem(Context^.IntData, SizeOf(THavalCtx));
      Context^.IntData := nil;
    end;
    {$ENDIF}
    {$IFDEF INCLUDE_SHA}
    HASH_SHA1, HASH_SHA256:
    begin
      if Context^.HashType = HASH_SHA1 then
        DestHash := SHA256Final(PSHA256Ctx(Context^.IntData)^, 1)
      else
        DestHash := SHA256Final(PSHA256Ctx(Context^.IntData)^, 256);
      FreeMem(Context^.IntData, SizeOf(TSHA256Ctx));
      Context^.IntData := nil;
    end;
    HASH_SHA384, HASH_SHA512:
    begin
      if Context^.HashType = HASH_SHA384 then
        DestHash := SHA512Final(PSHA512Ctx(Context^.IntData)^, 384)
      else
        DestHash := SHA512Final(PSHA512Ctx(Context^.IntData)^, 512);
      FreeMem(Context^.IntData, SizeOf(TSHA512Ctx));
      Context^.IntData := nil;
    end;
    {$ENDIF}
    {$IFDEF INCLUDE_TIGER}
    HASH_TIGER128, HASH_TIGER160, HASH_TIGER192:
    begin
      case Context^.HashType of
        HASH_TIGER128: DestHash := TigerFinal(PTigerCtx(Context^.IntData)^, 128, Context^.lParam);
        HASH_TIGER160: DestHash := TigerFinal(PTigerCtx(Context^.IntData)^, 160, Context^.lParam);
        HASH_TIGER192: DestHash := TigerFinal(PTigerCtx(Context^.IntData)^, 192, Context^.lParam);
      end;
      FreeMem(Context^.IntData, SizeOf(TTigerCtx));
      Context^.IntData := nil;
    end;
    {$ENDIF}
    {$IFDEF INCLUDE_RMD}
    HASH_RIPEMD128, HASH_RIPEMD160:
    begin
      if Context^.HashType = HASH_RIPEMD128 then
        DestHash := RMDFinal(PRMDCtx(Context^.IntData)^, 128)
      else
        DestHash := RMDFinal(PRMDCtx(Context^.IntData)^, 160);
      FreeMem(Context^.IntData, SizeOf(TRMDCtx));        
    end;
    {$ENDIF}    
    else
      Result := HASH_UNK_TYPE;
  end;
end;

function HashStr(HashType: LongWord; SrcStr: String; var DestHash: String): LongWord;
var
  ctx: THashContext;
begin
  Result := HashInit(@ctx, HashType);
  if Result = HASH_NOERROR then
    Result := HashUpdate(@ctx, PChar(SrcStr), Length(SrcStr));
  if Result = HASH_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 = HASH_NOERROR then
    Result := HashUpdate(@ctx, SrcBuf, BufLen);
  if Result = HASH_NOERROR then
    Result := HashFinal(@ctx, DestHash);
end;

{$IFDEF INCLUDE_FUTILS}
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..4047] of Char;  //Read buffer, could be modified
  read, fread: LongWord;
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 Exit;
  ReadFile(FileHandle, buf, SizeOf(buf), read, nil);
  fread := offset1 + read; if read < 1 then Exit;
  if read + offset1 >= offset2 then
    HashUpdate(ctx, @buf, offset2 - offset1)
  else
    while ReadFile(FileHandle, buf, SizeOf(buf), read, nil) do
    begin
      Inc(fread, read);
      if read < 1 then
        Break
      else
      begin
        if fread > offset2 then
        begin
          HashUpdate(ctx, @buf, read + offset2 - fread);
          Break;
        end
        else
          HashUpdate(ctx, @buf, read)
      end;
  end;
  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);
  if fsz = INVALID_FILE_SIZE then
  begin
    Result := HASH_FO_ERROR;
    Exit;
  end;
  Result := HashInit(@ctx, HashType);
  if Result = NO_ERROR then
    if not _HashFilePartial(@ctx, FileName, 0, _GetFileSize(FileName)) then
       Result := HASH_FR_ERROR;
  if Result = NO_ERROR then
    Result := HashFinal(@ctx, DestHash);
end;

function HashFilePartial(HashType: LongWord; FileName: String; FlOffsetLow, FlOffsetHigh: LongWord; var DestHash: String): LongWord;
var
  ctx: THashContext;
  fsz: LongWord;
begin
  FillChar(ctx, SizeOf(ctx), 0);
  fsz := _GetFileSize(FileName);
  if fsz = INVALID_FILE_SIZE then
  begin
    Result := HASH_FO_ERROR;
    Exit;
  end;
  Result := HashInit(@ctx, HashType);
  if FlOffsetHigh >= fsz then
    FlOffsetHigh := fsz - 1;
  if Result = NO_ERROR then
    if not _HashFilePartial(@ctx, FileName, FlOffsetLow, FlOffsetHigh + 1) then
       Result := HASH_FR_ERROR;
  if Result = NO_ERROR then
    Result := HashFinal(@ctx, DestHash);
end;
{$ENDIF}

function EnumHashTypes(StoreToArr: Pointer; MaxItems: LongWord): LongWord;
  procedure AddToEnum(Value: LongWord; var Count: LongWord);
  begin
    if Count >= MaxItems then Exit;
    PDWordArray(StoreToArr)^[Count] := Value;
    Inc(Count);
  end;
begin
  Result := 0;
  if MaxItems = 0 then
    Exit;
  if MaxItems > HASH_MAX_TYPES then
    MaxItems := HASH_MAX_TYPES;
  {$IFDEF INCLUDE_MD}
  AddToEnum(HASH_MD2, Result);
  AddToEnum(HASH_MD4, Result);
  AddToEnum(HASH_MD5, Result);
  {$ENDIF}
  {$IFDEF INCLUDE_CRC}
  AddToEnum(HASH_CRC32, Result);
  AddToEnum(HASH_CRC32B, Result);
  {$ENDIF}
  {$IFDEF INCLUDE_ADLER}
  AddToEnum(HASH_ADLER32, Result);
  {$ENDIF}
  {$IFDEF INCLUDE_GOST}
  AddToEnum(HASH_GOST, Result);
  {$ENDIF}
  {$IFDEF INCLUDE_HAVAL}
  AddToEnum(HASH_HAVAL128, Result);
  AddToEnum(HASH_HAVAL160, Result);
  AddToEnum(HASH_HAVAL192, Result);
  AddToEnum(HASH_HAVAL224, Result);
  AddToEnum(HASH_HAVAL256, Result);
  {$ENDIF}
  {$IFDEF INCLUDE_SHA}
  AddToEnum(HASH_SHA1, Result);
  AddToEnum(HASH_SHA256, Result);
  AddToEnum(HASH_SHA384, Result);
  AddToEnum(HASH_SHA512, Result);
  {$ENDIF}
  {$IFDEF INCLUDE_TIGER}
  AddToEnum(HASH_TIGER128, Result);
  AddToEnum(HASH_TIGER160, Result);
  AddToEnum(HASH_TIGER192, Result);
  {$ENDIF}
  {$IFDEF INCLUDE_RMD}
  AddToEnum(HASH_RIPEMD128, Result);
  AddToEnum(HASH_RIPEMD160, Result);
  {$ENDIF}
end;

function HashErrorToStr(Error: LongWord): String;
begin
  case Error of
    HASH_NOERROR: Result := 'No error';
    HASH_UNK_TYPE: Result := 'Unknown hash type';
    HASH_NIL_CONTEXT: Result := 'Hash context is null';
    HASH_INV_CONTEXT: Result := 'Invalid hash context';
    HASH_FR_ERROR: Result := 'Could not read file';
    HASH_FO_ERROR: Result := 'Could not open file';
    HASH_TEST_FAILED: Result := 'Hash test failed';    
  else
    Result := 'Unknown error';
  end;
end;

end.