| 0,0 → 1,605 |
|---|
| 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. |