Subversion Repositories delphiutils

unit HighPerfFileComparator;

(*

  HighPerfFileComparator.pas

  (C) 2010 ViaThinkSoft, Daniel Marschall

  Last modified: January, 21th 2010

  THighPerfFileComparator.compare(filenameA, filenameB: string): boolean;

  Compares two files primary with size comparison and

  secundary with MD5 hash comparison. All results will be cached.

  Note: If you want to use the cache for every file, please do not

  destroy the instance of THighPerfFileComparator after done your job.

  Use in a field of your form class and free it when the application

  closes.

  Example of usage:

      var

        comparator: THighPerfFileComparator;

      procedure TForm1.FormCreate(Sender: TObject);

      begin

        comparator := THighPerfFileComparator.Create;

      end;

      procedure TForm1.Button1Click(Sender: TObject);

      begin

        // This deletes all cached file hashs, so that the result will be

        // new calculated. Alternatively you can create a new

        // THighPerfFileComparator at the beginning of every new job.

        comparator.clearCache;

        if comparator.Compare('C:\a.txt', 'C:\b.txt') then

          ShowMessage('Files are equal')

        else

          ShowMessage('Files are not equal');

      end;

      procedure TForm1.FormDestroy(Sender: TObject);

      begin

        comparator.Free;

      end;

  Class hierarchie:

      Exception

          EFileNotFound

          ENoRegisteredComparators

      TObject

          (TContainer)

              (TStringContainer)

              (TInteger64Container)

          TCacheManager

              TFilenameCacheManager

                  TInteger64CacheManager

                  TStringCacheManager

      TInterfacedObject

          TComparator

              TFileComparator

                  THashMD5Comparator

                      TCachedHashMD5Comparator [ICachedComparator]

                  TSizeComparator

                      TCachedSizeComparator [ICachedComparator]

                  TMultipleFileComparators

                      TCachedSizeHashMD5FileComparator [ICachedComparator]

                      = THighPerfFileComparator

*)

interface

uses

  SysUtils, Classes, Contnrs;

type

  ICachedComparator = interface(IInterface)

  // private

    procedure SetCacheEnabled(Value: boolean);

    function GetCacheEnabled: boolean;

  // public

    property CacheEnabled: boolean read getCacheEnabled write setCacheEnabled;

    procedure ClearCache;

  end;

  EFileNotFound = class(Exception);

  ENoRegisteredComparators = class(Exception);

  TCacheManager = class(TObject)

  private

    FCache: TStringList;

  public

    procedure SetCache(identifier: string; cacheObject: TObject);

    function GetCache(identifier: string): TObject;

    function IsCached(identifier: string): boolean;

    procedure Clear;

    constructor Create;

    destructor Destroy; override;

  end;

  // TFilenameCacheManager extends every filename to a unique identifier

  TFilenameCacheManager = class(TCacheManager)

  protected

    function FullQualifiedFilename(filename: string): string;

  public

    procedure SetCache(filename: string; cacheObject: TObject);

    function GetCache(filename: string): TObject;

    function IsCached(filename: string): boolean;

  end;

  // Wäre eigentlich ein guter Ansatz für Mehrfachvererbung...

  TInteger64CacheManager = class(TFilenameCacheManager)

  public

    procedure SetCache(filename: string; content: int64);

    function GetCache(filename: string): int64;

  end;

  TStringCacheManager = class(TFilenameCacheManager)

  public

    procedure SetCache(filename: string; content: string);

    function GetCache(filename: string): string;

  end;

  TComparator = class(TInterfacedObject) // abstract

  public

    function Compare(a, b: string): boolean; virtual; abstract;

  end;

  TFileComparator = class(TComparator) // abstract

  protected

    // Please call this method for both filenames at every Compare()

    // call of your derivates.

    procedure CheckFileExistence(filename: string);

  public

    // This is an abstract method since it only checks filenames and returns

    // always false.

    // function Compare(filenameA, filenameB: string): boolean; override;

  end;

  TSizeComparator = class(TFileComparator)

  protected

    function GetFileSize(filename: string): Int64; virtual;

  public

    function Compare(filenameA, filenameB: string): boolean; override;

  end;

  TCachedSizeComparator = class(TSizeComparator, ICachedComparator)

  private

    FCacheManager: TInteger64CacheManager;

    FCacheEnabled: boolean;

    procedure SetCacheEnabled(Value: boolean);

    function GetCacheEnabled: boolean;

  protected

    function GetFileSize(filename: string): Int64; override;

  public

    property CacheEnabled: boolean read getCacheEnabled write setCacheEnabled;

    procedure ClearCache;

    constructor Create;

    destructor Destroy; override;

  end;

  THashMD5Comparator = class(TFileComparator)

  protected

    function GetFileHashMD5(filename: string): String; virtual;

  public

    function Compare(filenameA, filenameB: string): boolean; override;

  end;

  TCachedHashMD5Comparator = class(THashMD5Comparator, ICachedComparator)

  private

    FCacheManager: TStringCacheManager;

    FCacheEnabled: boolean;

    procedure SetCacheEnabled(Value: boolean);

    function GetCacheEnabled: boolean;

  protected

    function GetFileHashMD5(filename: string): String; override;

  public

    property CacheEnabled: boolean read getCacheEnabled write setCacheEnabled;

    procedure ClearCache;

    constructor Create;

    destructor Destroy; override;

  end;

  TMultipleFileComparators = class(TFileComparator) // abstract

  // This is an abstract class since no comparators are registered and so

  // compare() will throw an ENoRegisteredComparators exception.

  protected

    // WARNING: DOES *NOT* OWNS ITS OBJECTS. PLEASE FREE THEM ON DESTROY.

    FRegisteredComparators: TObjectList; // of TFileComparator

    procedure RegisterComparator(comparator: TFileComparator);

  public

    function Compare(filenameA, filenameB: string): boolean; override;

    constructor Create;

    destructor Destroy; override;

  end;

  TCachedSizeHashMD5FileComparator = class(TMultipleFileComparators,

    ICachedComparator)

  private

    FHashComparator: TCachedHashMD5Comparator;

    FSizeComparator: TCachedSizeComparator;

    procedure SetCacheEnabled(Value: boolean);

    function GetCacheEnabled: boolean;

  public

    property CacheEnabled: boolean read getCacheEnabled write setCacheEnabled;

    procedure ClearCache;

    constructor Create;

    destructor Destroy; override;

  end;

  THighPerfFileComparator = TCachedSizeHashMD5FileComparator;

implementation

// Please download MD5.pas from

// http://www.koders.com/delphi/fid1C4B47A76F8C7172FDCFE7B3A74863D6FB7FC2BA.aspx

uses

  MD5;

resourcestring

  LNG_E_NO_REGISTERED_COMPARATORS = 'No comparators registered. Please use ' +

    'a derivate of the class TMultipleFileComparators which does register ' +

    'comparators.';

  LNG_E_FILE_NOT_FOUND = 'The file "%s" was not found.';

type

  TContainer = class(TObject);

  TStringContainer = class(TContainer)

  public

    Content: string;

    constructor Create(AContent: string);

  end;

  TInteger64Container = class(TContainer)

  public

    Content: int64;

    constructor Create(AContent: int64);

  end;

{ Functions }

function _MD5File(filename: string): string;

begin

  result := MD5Print(MD5File(filename));

end;

{ TStringContainer }

constructor TStringContainer.Create(AContent: string);

begin

  inherited Create;

  content := AContent;

end;

{ TInteger64Container }

constructor TInteger64Container.Create(AContent: int64);

begin

  inherited Create;

  content := AContent;

end;

{ TCacheManager }

procedure TCacheManager.SetCache(identifier: string; cacheObject: TObject);

begin

  FCache.AddObject(identifier, cacheObject);

end;

function TCacheManager.GetCache(identifier: string): TObject;

begin

  if isCached(identifier) then

    result := FCache.Objects[FCache.IndexOf(identifier)] as TContainer

  else

    result := nil;

end;

function TCacheManager.IsCached(identifier: string): boolean;

begin

  result := FCache.IndexOf(identifier) <> -1;

end;

procedure TCacheManager.Clear;

begin

  FCache.Clear;

end;

constructor TCacheManager.Create;

begin

  inherited Create;

  FCache := TStringList.Create;

end;

destructor TCacheManager.Destroy;

begin

  FCache.Free;

  inherited Destroy;

end;

{ TFilenameCacheManager }

function TFilenameCacheManager.FullQualifiedFilename(filename: string): string;

begin

  result := ExpandUNCFileName(filename);

end;

procedure TFilenameCacheManager.SetCache(filename: string;

  cacheObject: TObject);

begin

  inherited setCache(FullQualifiedFilename(filename), cacheObject);

end;

function TFilenameCacheManager.GetCache(filename: string): TObject;

begin

  result := inherited getCache(FullQualifiedFilename(filename));

end;

function TFilenameCacheManager.IsCached(filename: string): boolean;

begin

  result := inherited isCached(FullQualifiedFilename(filename));

end;

{ TInteger64CacheManager }

procedure TInteger64CacheManager.SetCache(filename: string; content: int64);

begin

  inherited setCache(filename, TInteger64Container.Create(content));

end;

function TInteger64CacheManager.GetCache(filename: string): int64;

begin

  result := (inherited getCache(filename) as TInteger64Container).content;

end;

{ TStringCacheManager }

procedure TStringCacheManager.SetCache(filename: string; content: string);

begin

  inherited setCache(filename, TStringContainer.Create(content));

end;

function TStringCacheManager.GetCache(filename: string): string;

begin

  result := (inherited getCache(filename) as TStringContainer).content;

end;

{ TFileComparator }

procedure TFileComparator.CheckFileExistence(filename: string);

begin

  if not fileExists(filename) then

    raise EFileNotFound.CreateFmt(LNG_E_FILE_NOT_FOUND, [filename]);

end;

(* function TFileComparator.Compare(filenameA, filenameB: string): boolean;

begin

  if not fileExists(filenameA) then

    raise EFileNotFound.CreateFmt(LNG_E_FILE_NOT_FOUND, [filenameA]);

  if not fileExists(filenameB) then

    raise EFileNotFound.CreateFmt(LNG_E_FILE_NOT_FOUND, [filenameB]);

  // Leider keine Überprüfung, ob Methode überschrieben wurde

  // (da sonst result immer false ist!)

  if Self.ClassType = TFileComparator then

    raise EDirectCall.CreateFmt(LNG_E_DIRECT_CALL, [Self.ClassName]);

  result := false;

end; *)

{ TSizeComparator }

function TSizeComparator.GetFileSize(filename: string): Int64;

var

  f: TFileStream;

begin

  f := TFileStream.Create(filename, fmOpenRead);

  try

    result := f.Size

  finally

    f.Free;

  end;

end;

function TSizeComparator.Compare(filenameA, filenameB: string): boolean;

begin

  //inherited compare(filenameA, filenameB);

  CheckFileExistence(filenameA);

  CheckFileExistence(filenameB);

  result := getFileSize(filenameA) = getFileSize(filenameB);

end;

{ TCachedSizeComparator }

procedure TCachedSizeComparator.SetCacheEnabled(Value: boolean);

begin

  if FCacheEnabled <> Value then

    FCacheEnabled := Value;

end;

function TCachedSizeComparator.GetCacheEnabled: boolean;

begin

  result := FCacheEnabled;

end;

function TCachedSizeComparator.GetFileSize(filename: string): Int64;

begin

  if FCacheEnabled then

  begin

    if FCacheManager.isCached(filename) then

    begin

      result := FCacheManager.getCache(filename);

    end

    else

    begin

      result := inherited getFileSize(filename);

      FCacheManager.setCache(filename, result);

    end;

  end

  else

    result := inherited getFileSize(filename);

end;

procedure TCachedSizeComparator.ClearCache;

begin

  FCacheManager.clear;

end;

constructor TCachedSizeComparator.Create;

begin

  inherited Create;

  FCacheManager := TInteger64CacheManager.Create;

  FCacheEnabled := true;

end;

destructor TCachedSizeComparator.Destroy;

begin

  FCacheManager.Free;

  inherited Destroy;

end;

{ THashMD5Comparator }

function THashMD5Comparator.GetFileHashMD5(filename: string): String;

begin

  result := _MD5File(filename);

end;

function THashMD5Comparator.Compare(filenameA, filenameB: string): boolean;

begin

  //inherited Compare(filenameA, filenameB);

  CheckFileExistence(filenameA);

  CheckFileExistence(filenameB);

  result := GetFileHashMD5(filenameA) = GetFileHashMD5(filenameB);

end;

{ TCachedHashMD5Comparator }

procedure TCachedHashMD5Comparator.SetCacheEnabled(Value: boolean);

begin

  if FCacheEnabled <> Value then

    FCacheEnabled := Value;

end;

function TCachedHashMD5Comparator.GetCacheEnabled: boolean;

begin

  result := FCacheEnabled;

end;

function TCachedHashMD5Comparator.GetFileHashMD5(filename: string): String;

begin

  if FCacheEnabled then

  begin

    if FCacheManager.IsCached(filename) then

    begin

      result := FCacheManager.GetCache(filename);

    end

    else

    begin

      result := inherited GetFileHashMD5(filename);

      FCacheManager.SetCache(filename, result);

    end;

  end

  else

    result := inherited GetFileHashMD5(filename);

end;

procedure TCachedHashMD5Comparator.ClearCache;

begin

  FCacheManager.Clear;

end;

constructor TCachedHashMD5Comparator.Create;

begin

  inherited Create;

  FCacheManager := TStringCacheManager.Create;

  FCacheEnabled := true;

end;

destructor TCachedHashMD5Comparator.Destroy;

begin

  FCacheManager.Free;

  inherited Destroy;

end;

{ TMultipleFileComparators }

procedure TMultipleFileComparators.RegisterComparator(comparator: TFileComparator);

begin

  FRegisteredComparators.Add(comparator)

end;

function TMultipleFileComparators.Compare(filenameA,

  filenameB: string): boolean;

var

  i: integer;

begin

  //inherited Compare(filenameA, filenameB);

  CheckFileExistence(filenameA);

  CheckFileExistence(filenameB);

  if FRegisteredComparators.Count = 0 then

    raise ENoRegisteredComparators.Create(LNG_E_NO_REGISTERED_COMPARATORS);

  for i := 0 to FRegisteredComparators.Count - 1 do

  begin

    if not (FRegisteredComparators.Items[i] as TFileComparator).

      Compare(filenameA, filenameB) then

    begin

      result := false;

      exit;

    end;

  end;

  result := true;

end;

constructor TMultipleFileComparators.Create;

begin

  inherited Create;

  FRegisteredComparators := TObjectList.Create(false);

end;

destructor TMultipleFileComparators.Destroy;

begin

  FRegisteredComparators.Free;

  inherited Destroy;

end;

{ TCachedSizeHashMD5FileComparator }

procedure TCachedSizeHashMD5FileComparator.SetCacheEnabled(Value: boolean);

begin

  FSizeComparator.SetCacheEnabled(Value);

  FHashComparator.SetCacheEnabled(Value);

end;

function TCachedSizeHashMD5FileComparator.getCacheEnabled: boolean;

begin

  result := FSizeComparator.GetCacheEnabled and FHashComparator.GetCacheEnabled;

end;

procedure TCachedSizeHashMD5FileComparator.ClearCache;

begin

  FSizeComparator.ClearCache;

  FHashComparator.ClearCache;

end;

constructor TCachedSizeHashMD5FileComparator.Create;

begin

  inherited Create;

  FSizeComparator := TCachedSizeComparator.Create;

  RegisterComparator(FSizeComparator);

  FHashComparator := TCachedHashMD5Comparator.Create;

  RegisterComparator(FHashComparator);

end;

destructor TCachedSizeHashMD5FileComparator.Destroy;

begin

  FHashComparator.Free;

  FSizeComparator.Free;

  inherited Destroy;

end;

end.