I have a web creation program which, when building a site, creates hundreds of files.
When the internet root folder is situated on the local pc, the program runs fine. If the internet root folder is situated on a network drive, the copying of a created page takes longer than creating the page itself (the creation of the page is fairly optimized).
I was thinking of creating the files locally, adding the names of the created files to a TStringList and let another thread copy them to the network drive (removing the copied file from the TStringList).
Howerver, I have never, ever used threads before and I couldn't find an existing answer in the other Delphi questions involving threads (if only we could use an and operator in the search field), so I am now asking if anyone has got a working example which does this (or can point me to some article with working Delphi code) ?
I am using Delphi 7.
EDITED: My sample project (thx to the original code by mghie - who is hereby thanked once again).
...
fct : TFileCopyThread;
...
procedure TfrmMain.FormCreate(Sender: TObject);
begin
if not DirectoryExists(DEST_FOLDER)
then
MkDir(DEST_FOLDER);
fct := TFileCopyThread.Create(Handle, DEST_FOLDER);
end;
procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
FreeAndNil(fct);
end;
procedure TfrmMain.btnOpenClick(Sender: TObject);
var sDir : string;
Fldr : TedlFolderRtns;
i : integer;
begin
if PickFolder(sDir,'')
then begin
// one of my components, returning a filelist [non threaded :) ]
Fldr := TedlFolderRtns.Create();
Fldr.FileList(sDir,'*.*',True);
for i := 0 to Fldr.TotalFileCnt -1 do
begin
fct.AddFile( fldr.ResultList[i]);
end;
end;
end;
procedure TfrmMain.wmFileBeingCopied(var Msg: Tmessage);
var s : string;
begin
s := fct.FileBeingCopied;
if s <> ''
then
lbxFiles.Items.Add(fct.FileBeingCopied);
lblFileCount.Caption := IntToStr( fct.FileCount );
end;
and the unit
unit eFileCopyThread;
interface
uses
SysUtils, Classes, SyncObjs, Windows, Messages;
const
umFileBeingCopied = WM_USER + 1;
type
TFileCopyThread = class(TThread)
private
fCS: TCriticalSection;
fDestDir: string;
fSrcFiles: TStrings;
fFilesEvent: TEvent;
fShutdownEvent: TEvent;
fFileBeingCopied: string;
fMainWindowHandle: HWND;
fFileCount: Integer;
function GetFileBeingCopied: string;
protected
procedure Execute; override;
public
constructor Create(const MainWindowHandle:HWND; const ADestDir: string);
destructor Destroy; override;
procedure AddFile(const ASrcFileName: string);
function IsCopyingFiles: boolean;
property FileBeingCopied: string read GetFileBeingCopied;
property FileCount: Integer read fFileCount;
end;
implementation
constructor TFileCopyThread.Create(const MainWindowHandle:HWND;const ADestDir: string);
begin
inherited Create(True);
fMainWindowHandle := MainWindowHandle;
fCS := TCriticalSection.Create;
fDestDir := IncludeTrailingBackslash(ADestDir);
fSrcFiles := TStringList.Create;
fFilesEvent := TEvent.Create(nil, True, False, '');
fShutdownEvent := TEvent.Create(nil, True, False, '');
Resume;
end;
destructor TFileCopyThread.Destroy;
begin
if fShutdownEvent <> nil then
fShutdownEvent.SetEvent;
Terminate;
WaitFor;
FreeAndNil(fFilesEvent);
FreeAndNil(fShutdownEvent);
FreeAndNil(fSrcFiles);
FreeAndNil(fCS);
inherited;
end;
procedure TFileCopyThread.AddFile(const ASrcFileName: string);
begin
if ASrcFileName <> ''
then begin
fCS.Acquire;
try
fSrcFiles.Add(ASrcFileName);
fFileCount := fSrcFiles.Count;
fFilesEvent.SetEvent;
finally
fCS.Release;
end;
end;
end;
procedure TFileCopyThread.Execute;
var
Handles: array[0..1] of THandle;
Res: Cardinal;
SrcFileName, DestFileName: string;
begin
Handles[0] := fFilesEvent.Handle;
Handles[1] := fShutdownEvent.Handle;
while not Terminated do
begin
Res := WaitForMultipleObjects(2, @Handles[0], False, INFINITE);
if Res = WAIT_OBJECT_0 + 1 then
break;
if Res = WAIT_OBJECT_0
then begin
while not Terminated do
begin
fCS.Acquire;
try
if fSrcFiles.Count > 0
then begin
SrcFileName := fSrcFiles[0];
fSrcFiles.Delete(0);
fFileCount := fSrcFiles.Count;
PostMessage( fMainWindowHandle,umFileBeingCopied,0,0 );
end else
SrcFileName := '';
fFileBeingCopied := SrcFileName;
if SrcFileName = '' then
fFilesEvent.ResetEvent;
finally
fCS.Release;
end;
if SrcFileName = '' then
break;
DestFileName := fDestDir + ExtractFileName(SrcFileName);
CopyFile(PChar(SrcFileName), PChar(DestFileName), True);
end;
end;
end;
end;
function TFileCopyThread.IsCopyingFiles: boolean;
begin
fCS.Acquire;
try
Result := (fSrcFiles.Count > 0)
// last file is still being copied
or (WaitForSingleObject(fFilesEvent.Handle, 0) = WAIT_OBJECT_0);
finally
fCS.Release;
end;
end;
// new version - edited after receiving comments
function TFileCopyThread.GetFileBeingCopied: string;
begin
fCS.Acquire;
try
Result := fFileBeingCopied;
finally
fCS.Release;
end;
end;
// old version - deleted after receiving comments
//function TFileCopyThread.GetFileBeingCopied: string;
//begin
// Result := '';
// if fFileBeingCopied <> ''
// then begin
// fCS.Acquire;
// try
// Result := fFileBeingCopied;
// fFilesEvent.SetEvent;
// finally
// fCS.Release;
// end;
// end;
//end;
end.
Any additional comments would be much appreciated.
Reading the comments and looking at the examples, you find different approaches to the solutions, with pro and con comments on all of them.
The problem when trying to implement a complicated new feature (as threads are to me), is that you almost always find something which seems to work ... at first. Only later on you find out the hard way that things should have been done differently. And threads are a very good example of this.
Sites like StackOverflow are great. What a community.
A quick and dirty solution:
type
TFileCopyThread = class(TThread)
private
fCS: TCriticalSection;
fDestDir: string;
fSrcFiles: TStrings;
fFilesEvent: TEvent;
fShutdownEvent: TEvent;
protected
procedure Execute; override;
public
constructor Create(const ADestDir: string);
destructor Destroy; override;
procedure AddFile(const ASrcFileName: string);
function IsCopyingFiles: boolean;
end;
constructor TFileCopyThread.Create(const ADestDir: string);
begin
inherited Create(True);
fCS := TCriticalSection.Create;
fDestDir := IncludeTrailingBackslash(ADestDir);
fSrcFiles := TStringList.Create;
fFilesEvent := TEvent.Create(nil, True, False, '');
fShutdownEvent := TEvent.Create(nil, True, False, '');
Resume;
end;
destructor TFileCopyThread.Destroy;
begin
if fShutdownEvent <> nil then
fShutdownEvent.SetEvent;
Terminate;
WaitFor;
FreeAndNil(fFilesEvent);
FreeAndNil(fShutdownEvent);
FreeAndNil(fSrcFiles);
FreeAndNil(fCS);
inherited;
end;
procedure TFileCopyThread.AddFile(const ASrcFileName: string);
begin
if ASrcFileName <> '' then begin
fCS.Acquire;
try
fSrcFiles.Add(ASrcFileName);
fFilesEvent.SetEvent;
finally
fCS.Release;
end;
end;
end;
procedure TFileCopyThread.Execute;
var
Handles: array[0..1] of THandle;
Res: Cardinal;
SrcFileName, DestFileName: string;
begin
Handles[0] := fFilesEvent.Handle;
Handles[1] := fShutdownEvent.Handle;
while not Terminated do begin
Res := WaitForMultipleObjects(2, @Handles[0], False, INFINITE);
if Res = WAIT_OBJECT_0 + 1 then
break;
if Res = WAIT_OBJECT_0 then begin
while not Terminated do begin
fCS.Acquire;
try
if fSrcFiles.Count > 0 then begin
SrcFileName := fSrcFiles[0];
fSrcFiles.Delete(0);
end else
SrcFileName := '';
if SrcFileName = '' then
fFilesEvent.ResetEvent;
finally
fCS.Release;
end;
if SrcFileName = '' then
break;
DestFileName := fDestDir + ExtractFileName(SrcFileName);
CopyFile(PChar(SrcFileName), PChar(DestFileName), True);
end;
end;
end;
end;
function TFileCopyThread.IsCopyingFiles: boolean;
begin
fCS.Acquire;
try
Result := (fSrcFiles.Count > 0)
// last file is still being copied
or (WaitForSingleObject(fFilesEvent.Handle, 0) = WAIT_OBJECT_0);
finally
fCS.Release;
end;
end;
To use this in production code you would need to add error handling, maybe some progress notifications, and the copying itself should probably be implemented differently, but this should get you started.
In answer to your questions:
should I create the FileCopyThread in the FormCreate of the main program (and let it running), will that slow down the program somehow ?
You can create the thread, it will block on the events and consume 0 CPU cycles until you add a file to be copied. Once all files have been copied the thread will block again, so keeping it over the whole runtime of the program has no negative effect apart from consuming some memory.
Can I add normal event notification to the FileCopyThread (so that I can send an event as in property onProgress:TProgressEvent read fOnProgressEvent write fOnProgressEvent; with f.i. the current number of files in the list, and the file currently processed. I would like to call this when adding and before and after the copy routine
You can add notifications, but for them to be really useful they need to be executed in the context of the main thread. The easiest and ugliest way to do that is to wrap them with the Synchronize() method. Look at the Delphi Threads demo for an example how to do this. Then read some of the questions and answers found by searching for "[delphi] synchronize" here on SO, to see how this technique has quite a few drawbacks.
However, I wouldn't implement notifications in this way. If you just want to display progress it's unnecessary to update this with each file. Also, you have all the necessary information in the VCL thread already, in the place where you add the files to be copied. You could simply start a timer with an Interval of say 100, and have the timer event handler check whether the thread is still busy, and how many files are left to be copied. When the thread is blocked again you can disable the timer. If you need more or different information from the thread, then you could easily add more thread-safe methods to the thread class (for example return the number of pending files). I started with a minimal interface to keep things small and easy, use it as inspiration only.
Comment on your updated question:
You have this code:
function TFileCopyThread.GetFileBeingCopied: string;
begin
Result := '';
if fFileBeingCopied <> '' then begin
fCS.Acquire;
try
Result := fFileBeingCopied;
fFilesEvent.SetEvent;
finally
fCS.Release;
end;
end;
end;
but there are two problems with it. First, all access to data fields needs to be protected to be safe, and then you are just reading data, not adding a new file, so there's no need to set the event. The revised method would simply be:
function TFileCopyThread.GetFileBeingCopied: string;
begin
fCS.Acquire;
try
Result := fFileBeingCopied;
finally
fCS.Release;
end;
end;
Also you only set the fFileBeingCopied field, but never reset it, so it will always equal the last copied file, even when the thread is blocked. You should set that string empty when the last file has been copied, and of course do that while the critical section is acquired. Simply move the assignment past the if block.