type
PInfoData = ^TInfoData;
TInfoData = record
Message :string;
ThreadID :TThreadID;
When :TDateTime;
end;
TFileHashingWorkerThread = class(TThread)
private
FFileName :string;
FEvent :TDataEvent;
public
constructor Create(aFilename : string; const FinishEvent:TDataEvent);
procedure Execute; override;
end;
TForm1 = class(TForm)
Button1 :TButton;
Memo1 :TMemo;
SelectDirectoryDialog1 :TSelectDirectoryDialog;
procedure Button1Click(Sender :TObject);
private
{ private declarations }
//MyWorkerThread: TThread;
FileToBeHashed : string;
public
{ public declarations }
procedure InvokeHashThread(FileIterator: TFileIterator);
procedure HashInfo(Data: PtrInt);
end;
.....
constructor TFileHashingWorkerThread.Create(aFilename : string;const FinishEvent:TDataEvent);
begin
inherited Create(False);
FFileName := aFilename;
FEvent := FinishEvent;
FreeOnTerminate := True; //No memory Leaks.
end;
procedure TForm1.Button1Click(Sender :TObject);
var
FilesToBeHashed :TStringList;
FileList :TFileSearcher;
SearchMask :string;
begin
SearchMask := '*'; // *.* is OK on Windows but * works cross platform
if SelectDirectoryDialog1.Execute then
try
FileList := TFileSearcher.Create;
FileList.FileAttribute := faAnyFile;
FileList.OnFileFound := @InvokeHashThread; // So for each found file, a hash thread is invoked
FileList.Search(SelectDirectoryDialog1.FileName, SearchMask, true, false);
finally
FileList.Free;
end;
end;
procedure TForm1.InvokeHashThread(FileIterator: TFileIterator);
begin
FileToBeHashed := FileIterator.FileName;
if TThread.IsSingleProcessor then // If only one CPU, use the old way of doing it. Otherwise, call threads.
begin
Form1.Memo1.Lines.Add(FileToBeHashed + ' ' + MD5Print(MD5File(FileToBeHashed, 2097152)));
end else TFileHashingWorkerThread.Create(FileToBeHashed, @HashInfo);
end;
procedure TFileHashingWorkerThread.Execute;
const
BufSize = 64 * 1024; // 64kb buffer
var
GeneratedHash :string;
FileToBeHashed :string;
fsFileToBeHashed :TFileStream;
HashInstanceMD5 :IHash;
HashInstanceResultMD5 :IHashResult;
i :integer;
Buffer :array [0 .. BufSize - 1] of Byte;
TotalBytesRead,
LoopCounter :QWord;
function NewData(msg:string;when:Tdatetime):PInfoData;
begin
Result := New(PInfoData);
Result^.Message := msg;
Result^.ThreadID := ThreadID;
Result^.When := when;
end;
begin
i := 0;
fsFileToBeHashed := TFileStream.Create(FFileName, fmOpenRead);
//Form1.Memo1.Lines.Add('Started ' + fsFileToBeHashed.FileName + ', using ThreadID ' + IntToStr(ThreadID) + ' ' + FormatDateTime('dd/mm/yy HH:MM:SS', Now));
Application.QueueAsyncCall(FEvent,NewData('Started ' + fsFileToBeHashed.FileName + ', using ThreadID ' + IntToStr(ThreadID) + ' ' + FormatDateTime('dd/mm/yy HH:MM:SS', Now),Now));
// ...
// all the hashing stuff etc etc
// ...
HashInstanceResultMD5 := HashInstanceMD5.TransformFinal();
generatedhash := HashInstanceResultMD5.ToString();
//Form1.Memo1.Lines.Add('Finished ' + fsFileToBeHashed.filename + ' at ' + FormatDateTime('dd/mm/yy HH:MM:SS', Now) + ' ' + GeneratedHash);
Application.QueueAsyncCall(FEvent,NewData('Finished ' + fsFileToBeHashed.filename + ' at ' + FormatDateTime('dd/mm/yy HH:MM:SS', Now) + ' ' + GeneratedHash, Now));
end;
procedure TForm1.HashInfo(Data :PtrInt);
var
vStr:string;
begin
writestr(vStr, PInfoData(Data)^.ThreadID, ' : ', PInfoData(Data)^.When, ' : ', PInfoData(Data)^.Message);
Memo1.Lines.Add(vstr);
Free(Data);//no memory leaks
end;