multithreading


Copying files which the main thread adds to a stringlist using a thread


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.
If you're somewhat reluctant to go down to the metal and deal with TThread directly like in mghie solution, an alternative, maybe quicker, is to use Andreas Hausladen's AsyncCalls.
skeleton code:
procedure MoveFile(AFileName: TFileName; const DestFolder: string);
//------------------------------------------------------------------------------
begin
if DestFolder > '' then
if CopyFile(PChar(AFileName), PChar(IncludeTrailingPathDelimiter(DestFolder) + ExtractFileName(AFileName)), False) then
SysUtils.DeleteFile(AFileName)
else
RaiseLastOSError;
end;
procedure DoExport;
//------------------------------------------------------------------------------
var
TempPath, TempFileName: TFileName;
I: Integer;
AsyncCallsList: array of IAsyncCall;
begin
// find Windows temp directory
SetLength(TempPath, MAX_PATH);
SetLength(TempPath, GetTempPath(MAX_PATH, PChar(TempPath)));
// we suppose you have an array of items (1 per file to be created) with some info
SetLength(AsyncCallsList, Length(AnItemListArray));
for I := Low(AnItemListArray) to High(AnItemListArray) do
begin
AnItem := AnItemListArray[I];
LogMessage('.Processing current file for '+ AnItem.NAME);
TempFileName := TempPath + Format(AFormatString, [AnItem.NAME, ...]);
CreateYourFile(TempFileName);
LogMessage('.File generated for '+ AnItem.NAME);
// Move the file to Dest asynchronously, without waiting
AsyncCallsList[I] := AsyncCall(#MoveFile, [TempFileName, AnItem.DestFolder])
end;
// final rendez-vous synchronization
AsyncMultiSync(AsyncCallsList);
LogMessage('Job finished... ');
end;
A good start for using thread is Delphi is found at the Delphi about site
In order to make your solution work, you need a job queue for the worker thread. A stringlist can be used. But in any case you need to guard the queue so that only one thread can write to it at any single moment. Even if the writing thread is suspended.
Your application writes to the queue. So there must be a guarded write method.
Your thread reads and removes from the queue. So there must be a guarded read/remove method.
You can use a critical section to make sure only one of these has access to the queue at any single moment.

Related Links

How goroutine scheduling works
F# parallel design pattern
How To Prevent Perl Thread Printouts from Intercepting?
Extreme slowdown, OpenMP probably see unexisting race conditions?
How to use multithreading to write downloaded data in one file in a mulithread download application
Kafka as Messaging queue in Microservices
Rpyc Python: Rpyc service thread start call is blocking
How memory barrier/fence inhibit instruction reordering carried out by CPU?
Consumer-producer: Pausing the consumer if memory usage goes beyond a particular threshold
Threads communication in PyQt5
how to check if a pthread is joinable?
Apache Apollo on Ubuntu 14.04 - Can not connect to Websocket (Thread issue?)
TBB / Threading Building Blocks: Getting return value from a Task
Windows 10 UAP App using Boost Thread can't start on phone
Working with multiple threads and Connectionpool in UnboundID LDAP
GWT client side multithreading revisited

Categories

HOME
bluetooth
cloud
vbscript
openmp
magnific-popup
ngrx
routes
cvs
malloc
jpeg
networkx
upload
adobe-analytics
izpack
clojurescript
ghc
reactive-cocoa
mps
csrf-protection
zurb-foundation-6
claims-based-identity
h2db
react-css-modules
windows-error-reporting
neo4j-spatial
fabric8
iframe-resizer
fog
openoffice.org
normal-distribution
overlap
neuroscience
libraries
abstract-class
glew
fakeiteasy
no-www
qcombobox
theming
hendrix
dropbox-php
nativeapplication
linode
arrow-keys
titanium-android
parallel-data-warehouse
multi-level
skobbler-maps
gstreamer-0.10
clang-static-analyzer
markojs
yaws
suffix-tree
system.management
javax.sound.midi
riak-cs
ios9.1
e10s
network-interface
gui-test-framework
codeigniter-routing
qcodo
nsbutton
applescript-objc
onactivityresult
marmalade
xceed-datagrid
hyprlinkr
algebraic-data-types
listings
ruby-datamapper
padarn
ember-app-kit
delphi-6
browser-detection
cascalog
regsvr32
cufon
whoosh
recent-documents
iphone-web-app
asp.net-mvc-areas
coda-slider
sortable-tables
filtered-index
private-members
msdev

Resources

Database Users
RDBMS discuss
Database Dev&Adm
javascript
java
csharp
php
android
javascript
java
csharp
php
python
android
jquery
ruby
ios
html
Mobile App
Mobile App
Mobile App