Chip 2002 May/Chip_2002-05_cd1.bin/zkuste/delphi/kompon/d5/CAKDIR.ZIP/RsSupp.pas

Pascal/Delphi Source File | 2001-05-23 | 11KB | 357 lines

unit RsSupp;

interface

uses Windows, Messages, SysUtils, FileCtrl, Classes,
  Graphics, Controls, Forms, Dialogs, ErrorUnit, ArchiveHeadersUnit, ResourceCompUnit;

(*******************************************************************************
  Column Data Extractor types

  Desc:
  Each column in the FileList is represented by a class derived from TColDataExtr.
  This makes each column capable of extracting its own data, info (header width,
  header), and sort itself (ListSortCompare).

  Each child of TColDataExtr
    - assigns its own header, width and ListSortCompare in the Create procedure.
    - overrides the Extract procedure to return the data it exposes in a string

  To add a new column:
  Derive a new column from TColDataExtr
  Override Create:
    - call the inherited create to give a header title and a width
    - assign a pointer to the compare procedure if any
  Override Extract to return a string for the data
*******************************************************************************)

type
  TColDataExtr = class
  protected
    fheader: string;
    fwidth: integer;
    FListSortCompare: TListSortCompare;
  public
    property header: string read fheader;
    property Width: integer read fwidth;
    property ListSortCompare: TListSortCompare read FListSortCompare;
    constructor Create(aheader: string; awidth: integer);
    function Extract(CFH: TCentralFileHeader): string; virtual; abstract;
  end;

  TNameColDataExtr = class(TColDataExtr)
  public
    constructor Create;
    function Extract(CFH: TCentralFileHeader): string; override;
  end;

  TSizeColDataExtr = class(TColDataExtr)
  public
    constructor Create;
    function Extract(CFH: TCentralFileHeader): string; override;
  end;

  TPackedColDataExtr = class(TColDataExtr)
  public
    constructor Create;
    function Extract(CFH: TCentralFileHeader): string; override;
  end;

  TTimeColDataExtr = class(TColDataExtr)
  public
    constructor Create;
    function Extract(CFH: TCentralFileHeader): string; override;
  end;

  TRatioColDataExtr = class(TColDataExtr)
  public
    constructor Create;
    function Extract(CFH: TCentralFileHeader): string; override;
  end;

  TTypeNameColDataExtr = class(TColDataExtr)
  public
    constructor Create;
    function Extract(CFH: TCentralFileHeader): string; override;
  end;

  TNumBlocksColDataExtr = class(TColDataExtr)
  public
    constructor Create;
    function Extract(CFH: TCentralFileHeader): string; override;
  end;

  TDataOffsetColDataExtr = class(TColDataExtr)
  public
    constructor Create;
    function Extract(CFH: TCentralFileHeader): string; override;
  end;

implementation


{-------------------------------------------------------------------------------
  GetCompressionRatio
  -------------------
  Returns the compression ratio calculate from compressed and uncompresse
  Notes: The compression ratio is a percentage describing the ratio the file
  has shrunk by i.e. if the compression ratio is 30%, the file is 70% of its
  original size.
  This form of description is used Winzip, Arj and other major archivers.
-------------------------------------------------------------------------------}
function GetCompressionRatio(compressed, uncompressed: integer): integer;
begin
  if Uncompressed > 0 then
    Result := 100 - (compressed * 100 div uncompressed)
  else
    Result := 0;
  {try
  except
    on EDivByZero do
      result := 0;
  end;}
end;

{-------------------------------------------------------------------------------
  GetBitsPerByte
  --------------
  Gives an approximation of the bits per byte for a file.
  The number of bits is rounded to next 8 bits because the exact value is
  not known. It is calculated by multiplying compressed by 8.
-------------------------------------------------------------------------------}
function GetBitsPerByte(compressed, uncompressed: integer): extended;
begin
  try
    if Uncompressed > 0 then
      Result := compressed / uncompressed * 8
    else
      Result := 0;
  except
    on EInvalidOp do // Div by zero
      Result := 0;
  end;
end;

function GetBitsPerByteStr(compressed, uncompressed: integer): string;
var
  bpb: extended;  // bits per byte
  s:   string;  // result string
begin
  bpb := GetBitsPerByte(compressed, uncompressed);
  Str(bpb: 5: 3, s);
  Result := s;
end;

(*******************************************************************************
  Column Sort support
*******************************************************************************)

{-------------------------------------------------------------------------------
  InverseCompare
  --------------
  Compares Item1 and Item2, and returns the inverse of the result.
  Uses the actual comparison function pointed to by InverseCompareActual to
  do the actual comparison. Then internally reverses the result.
-------------------------------------------------------------------------------}
var
  InverseCompareActual: TListSortCompare;

function InverseCompare(Item1, Item2: Pointer): integer;
var
  d: integer;
begin
  d := InverseCompareActual(Item1, Item2);
  if (d > 0) then d := -1
  else if (d < 0) then d := 1;
  Result := d;
end;

{-------------------------------------------------------------------------------
  CompareInt
  ----------
  Compares two integers a and b.
  Returns:
    1  : a > b
    -1 : a < b
    0  : a = b
-------------------------------------------------------------------------------}
function CompareInt(a, b: integer): integer;
begin
  if a > b then
    Result := 1
  else if a < b then
    Result := -1
  else
    Result := 0;
end;

{-------------------------------------------------------------------------------
  Various comparison functions

  Notes:
  The variuos compare function compares a field in Item1 and Item2. Depending
  on the data type of the fields, a different comparison method is used.
  CompareStr: to compare strings
  CompareInt: to compare integers
-------------------------------------------------------------------------------}
function NameCompare(Item1, Item2: Pointer): integer;
begin
  Result := CompareStr(TCentralFileHeader(Item1).filename,
    TCentralFileHeader(Item2).filename);
end;

function SizeCompare(Item1, Item2: Pointer): integer;
begin
  Result := CompareInt(TCentralFileHeader(Item1).uncompressed_size,
    TCentralFileHeader(Item2).uncompressed_size);
end;

function PackedCompare(Item1, Item2: Pointer): integer;
begin
  Result := CompareInt(TCentralFileHeader(Item1).compressed_size,
    TCentralFileHeader(Item2).compressed_size);
end;

function RatioCompare(Item1, Item2: Pointer): integer;
var
  r1, r2: integer;
begin
  r1     := GetCompressionRatio(TCentralFileHeader(Item1).compressed_size,
    TCentralFileHeader(Item1).uncompressed_size);
  r2     := GetCompressionRatio(TCentralFileHeader(Item2).compressed_size,
    TCentralFileHeader(Item2).uncompressed_size);
  Result := CompareInt(r1, r2);
end;

function TimeCompare(Item1, Item2: Pointer): integer;
begin
  Result := CompareInt(TCentralFileHeader(Item1).Time, TCentralFileHeader(Item2).Time);
end;

function TypeNameCompare(Item1, Item2: Pointer): integer;
begin
  Result := CompareStr(TCentralFileHeader(Item1).ShellTypeName,
    TCentralFileHeader(Item2).ShellTypeName);
end;

(*******************************************************************************
  Column Data Extractor types

  Desc:
  Each column in the FileList is represented by a class derived from TColDataExtr.
  This makes each column capable of extracting its own data, info (header width,
  header), and sort itself (ListSortCompare).

  Each child of TColDataExtr
    - assigns its own header, width and ListSortCompare in the Create procedure.
    - overrides the Extract procedure to return the data it exposes in a string

  To add a new column:
  Derive a new column from TColDataExtr
  Override Create:
    - call the inherited create to give a header title and a width
    - assign a pointer to the compare procedure if any
  Override Extract to return a string for the data
*******************************************************************************)

{-------------------------------------------------------------------------------
  Column Data Extractors
-------------------------------------------------------------------------------}
constructor TColDataExtr.Create;
begin
  inherited Create;
  fheader          := aheader;
  fwidth           := awidth;
  FListSortCompare := nil;
end;

constructor TNameColDataExtr.Create;
begin
  inherited Create('Name', 140);
  FListSortCompare := NameCompare;
end;

function TNameColDataExtr.Extract(CFH: TCentralFileHeader): string;
begin
  Result := CFH.filename;
end;

constructor TSizeColDataExtr.Create;
begin
  inherited Create('Size', 100);
  FListSortCompare := SizeCompare;
end;

function TSizeColDataExtr.Extract(CFH: TCentralFileHeader): string;
begin
  Result := IntToStr(CFH.uncompressed_size);
end;

constructor TPackedColDataExtr.Create;
begin
  inherited Create('Packed', 100);
  FListSortCompare := PackedCompare;
end;

function TPackedColDataExtr.Extract(CFH: TCentralFileHeader): string;
begin
  Result := IntToStr(CFH.compressed_size);
end;

constructor TTimeColDataExtr.Create;
begin
  inherited Create('Time', 120);
  FListSortCompare := TimeCompare;
end;

function TTimeColDataExtr.Extract(CFH: TCentralFileHeader): string;
begin
  Result := CFH.timeStr; // info cached
end;

constructor TRatioColDataExtr.Create;
begin
  inherited Create('Ratio', 50);
  FListSortCompare := RatioCompare;
end;

constructor TTypeNameColDataExtr.Create;
begin
  inherited Create('Type', 130);
  FListSortCompare := TypeNameCompare;
end;

function TTypeNameColDataExtr.Extract(CFH: TCentralFileHeader): string;
begin
  Result := CFH.shelltypename;
end;

function TRatioColDataExtr.Extract(CFH: TCentralFileHeader): string;
begin
  Result := IntToStr(GetCompressionRatio(CFH.compressed_size, CFH.uncompressed_size)) +
    '%';
end;

constructor TNumBlocksColDataExtr.Create;
begin
  inherited Create('Blocks', 50);
end;

function TNumBlocksColDataExtr.Extract(CFH: TCentralFileHeader): string;
begin
  Result := IntToStr(CFH.num_blocks);
end;

constructor TDataOffsetColDataExtr.Create;
begin
  inherited Create('Data', 50);
end;

function TDataOffsetColDataExtr.Extract(CFH: TCentralFileHeader): string;
begin
  Result := IntToStr(CFH.data_offset);
end;



end.