Este ya es un ejemplo completo donde coge todos los ficheros de un directorio y calcula el MD5 de los mismos
Código Delphi
[-]
interface
uses
System.SysUtils, System.Classes,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, UQueueMultiThreads, IdHashMessageDigest;
type
TInfoFile = record
FileName:String;
MD5:String;
end;
TColaInfoFile=class(TQueueMultiThread < TInfoFile >);
TMyThread2 = class(TThread < TInfoFile >)
private
FIdHashMessageDigest5:TIdHashMessageDigest5;
function FileMD5(FileStream: TStream): string; overload;
function FileMD5(const FileName: string): string; overload;
procedure ProcessItem; override;
procedure execute; override;
public
end;
TForm1 = class(TForm)
ButtonScanDir: TButton;
Memo1: TMemo;
procedure ButtonScanDirClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
FColaInfoFile:TColaInfoFile;
procedure ScanDir(const ARuta:String);
procedure FinishItem(Sender:TObject; var item:TInfoFile);
public
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
Uses idHash;
procedure TForm1.ButtonScanDirClick(Sender: TObject);
begin
inherited;
ScanDir('C:\a\');
end;
procedure TMyThread2.execute;
begin
try
FIdHashMessageDigest5 := TIdHashMessageDigest5.Create;
inherited;
finally
FIdHashMessageDigest5.Free;
end;
end;
function TMyThread2.FileMD5(FileStream: TStream): string;
begin
try
Result := '';
with FIdHashMessageDigest5 do
result := LowerCase(HashStreamAsHex(FileStream));
except
end;
end;
function TMyThread2.FileMD5(const FileName: string): string;
var
fs : TFileStream;
begin
Result := '';
try
fs := TFileStream.Create(fileName, fmOpenRead or fmShareDenyWrite);
try
Result := fileMD5(fs);
finally
fs.Free;
end;
except
end;
end;
procedure TMyThread2.ProcessItem;
begin
FItem.MD5 := FileMD5(FItem.FileName);
end;
procedure TForm1.FinishItem(Sender: TObject; var item: TInfoFile);
begin
with item do
Memo1.lines.Add(ExtractFileName(FileName) + '-' + MD5);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
FColaInfoFile:=TColaInfoFile.Create(TMyThread2);
FColaInfoFile.MaxThreads:=8;
FColaInfoFile.OnFinishItem:=FinishItem;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
FColaInfoFile.clear;
FColaInfoFile.Free;
end;
procedure TForm1.ScanDir(const ARuta:String);
var
searchResult: TSearchRec;
aux: TInfoFile;
begin
inherited;
if findfirst(ARuta+'*', faAnyFile, searchResult) = 0 then begin
repeat
if (searchResult.attr and faDirectory) <> faDirectory then begin
aux.FileName:=ARuta+searchResult.Name;
FColaInfoFile.Add(aux);
end;
until FindNext(searchResult) <> 0;
FindClose(searchResult);
end;
end;
end.