使用线程将主线程添加到字符串列表中的文件复制 [英] Copying files which the main thread adds to a stringlist using a thread
问题描述
我有一个网页制作程序，在制作网站时，会创建数百个文件。
当Internet根文件夹位于本地PC上时，程序运行正常。如果互联网根文件夹位于网络驱动器上，则复制创建的页面比创建页面本身需要更长的时间（页面的创建是相当优化的）。
我正在考虑在本地创建文件，将创建的文件的名称添加到TStringList，并让另一个线程将它们复制到网络驱动器（从TStringList中删除复制的文件）。
$ b Howerver，我从来没有使用过线程，我在其他Delphi的问题中找不到一个现有的答案，如果只有我们可以使用
和操作符在搜索字段），所以我现在询问是否有人有一个工作的例子，这样做（或者可以指向一些有工作的Delphi代码的文章）？ 我正在使用Delphi 7。
EDITED：我的示例项目（原始代码为 mghie - 再次感谢谁）。
...
fct：TFileCopyThre广告;
...
程序TfrmMain.FormCreate（发件人：TObject）;
begin
如果不是DirectoryExists（DEST_FOLDER）
然后
MkDir（DEST_FOLDER）;
fct：= TFileCopyThread.Create（Handle，DEST_FOLDER）;
结束
程序TfrmMain.FormClose（发件人：TObject; var Action：TCloseAction）;
begin
FreeAndNil（fct）;
结束
程序TfrmMain.btnOpenClick（发件人：TObject）;
var sDir：string;
Fldr：TedlFolderRtns;
i：integer;
begin
如果PickFolder（sDir，''）
然后开始
//我的一个组件，返回一个文件列表[非线程:)]
Fldr：= TedlFolderRtns.Create（）;
Fldr.FileList（sDir，'*。*'，True）;
for i：= 0 to Fldr.TotalFileCnt -1 do
begin
fct.AddFile（fldr.ResultList [i]）;
结束
结束
结束
程序TfrmMain.wmFileBeingCopied（var Msg：Tmessage）;
var s：string;
begin
s：= fct.FileBeingCopied;
如果s<> ''
then
lbxFiles.Items.Add（fct.FileBeingCopied）;
lblFileCount.Caption：= IntToStr（fct.FileCount）;
结束
单位
unit eFileCopyThread;
接口
使用
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;
函数GetFileBeingCopied：string;
protected
procedure Execute;覆盖
public
构造函数Create（const MainWindowHandle：HWND; const ADestDir：string）;
析构函数覆盖
procedure AddFile（const ASrcFileName：string）;
函数IsCopyingFiles：boolean;
属性FileBeingCopied：string read GetFileBeingCopied;
属性FileCount：整数读取fFileCount;
结束
实现
构造函数TFileCopyThread.Create（const MainWindowHandle：HWND; const ADestDir：string）;
begin
继承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，''）;
简历;
结束
析构函数TFileCopyThread.Destroy;
begin
如果fShutdownEvent<> nil then
fShutdownEvent.SetEvent;
终止;
WaitFor;
FreeAndNil（fFilesEvent）;
FreeAndNil（fShutdownEvent）;
FreeAndNil（fSrcFiles）;
FreeAndNil（fCS）;
继承;
结束
程序TFileCopyThread.AddFile（const ASrcFileName：string）;
begin
如果ASrcFileName<> ''
然后开始
fCS.Acquire;
try
fSrcFiles.Add（ASrcFileName）;
fFileCount：= fSrcFiles.Count;
fFilesEvent.SetEvent;
终于
fCS.Release;
结束
结束
结束
程序TFileCopyThread.Execute;
var
句柄：THandle的数组[0..1];
Res：红衣主教;
SrcFileName，DestFileName：string;
begin
句柄[0]：= fFilesEvent.Handle;
句柄[1]：= fShutdownEvent.Handle;
而不是终止do
begin
Res：= WaitForMultipleObjects（2，@Handles [0]，False，INFINITE）;
如果Res = WAIT_OBJECT_0 + 1 then
break;
如果Res = WAIT_OBJECT_0
然后开始
而不是终止do
begin
fCS.Acquire;
尝试
如果fSrcFiles.Count> 0
然后开始
SrcFileName：= fSrcFiles [0];
fSrcFiles.Delete（0）;
fFileCount：= fSrcFiles.Count;
PostMessage（fMainWindowHandle，umFileBeingCopied，0,0）;
end else
SrcFileName：='';
fFileBeingCopied：= SrcFileName;
如果SrcFileName =''然后
fFilesEvent.ResetEvent;
finally
fCS.Release;
结束
如果SrcFileName =''然后
break;
DestFileName：= fDestDir + ExtractFileName（SrcFileName）;
CopyFile（PChar（SrcFileName），PChar（DestFileName），True）;
结束
结束
结束
结束
函数TFileCopyThread.IsCopyingFiles：boolean;
begin
fCS.Acquire;
try
结果：=（fSrcFiles.Count> 0）
//最后一个文件仍然被复制
或（WaitForSingleObject（fFilesEvent.Handle，0）= WAIT_OBJECT_0）;
finally
fCS.Release;
结束
结束
//新版本 - 收到评论后编辑
函数TFileCopyThread.GetFileBeingCopied：string;
begin
fCS.Acquire;
try
结果：= fFileBeingCopied;
finally
fCS.Release;
结束
结束
//旧版本 - 收到注释后删除
//函数TFileCopyThread.GetFileBeingCopied：string;
// begin
//结果：='';
//如果fFileBeingCopied<> ''
//然后开始
// fCS.Acquire;
// try
//结果：= fFileBeingCopied;
// fFilesEvent.SetEvent;
// finally
// fCS.Release;
// end;
// end;
// end;
结束。
任何其他评论都将不胜感激。
阅读评论并查看示例，您可以找到不同的解决方案，并对所有这些进行评论。
当尝试实现一个复杂的新功能（对我来说是线索）时，问题是，您几乎总是会发现似乎工作的东西...。只有在你之后，才能发现事情本来应该做的不同。线程是一个非常好的例子。
像StackOverflow这样的网站很棒。一个社区。
一个快速而肮脏的解决方案：
type
TFileCopyThread = class（TThread）
private
fCS：TCriticalSection;
fDestDir：string;
fSrcFiles：TStrings;
fFilesEvent：TEvent;
fShutdownEvent：TEvent;
protected
procedure Execute;覆盖
public
构造函数Create（const ADestDir：string）;
析构函数覆盖
procedure AddFile（const ASrcFileName：string）;
函数IsCopyingFiles：boolean;
结束
构造函数TFileCopyThread.Create（const ADestDir：string）;
begin
继承Create（True）;
fCS：= TCriticalSection.Create;
fDestDir：= IncludeTrailingBackslash（ADestDir）;
fSrcFiles：= TStringList.Create;
fFilesEvent：= TEvent.Create（nil，True，False，''）;
fShutdownEvent：= TEvent.Create（nil，True，False，''）;
简历;
结束
析构函数TFileCopyThread.Destroy;
begin
如果fShutdownEvent<> nil then
fShutdownEvent.SetEvent;
终止;
WaitFor;
FreeAndNil（fFilesEvent）;
FreeAndNil（fShutdownEvent）;
FreeAndNil（fSrcFiles）;
FreeAndNil（fCS）;
继承;
结束
程序TFileCopyThread.AddFile（const ASrcFileName：string）;
begin
如果ASrcFileName<> ''然后开始
fCS.Acquire;
try
fSrcFiles.Add（ASrcFileName）;
fFilesEvent.SetEvent;
finally
fCS.Release;
结束
结束
结束
程序TFileCopyThread.Execute;
var
句柄：THandle的数组[0..1];
Res：红衣主教;
SrcFileName，DestFileName：string;
begin
句柄[0]：= fFilesEvent.Handle;
句柄[1]：= fShutdownEvent.Handle;
，而不是终止do $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $;;;;;;;;;;;;;;;;;;;;;;;;;;;
如果Res = WAIT_OBJECT_0 + 1 then
break;
如果Res = WAIT_OBJECT_0然后开始
而不是终止do begin
fCS.Acquire;
尝试
如果fSrcFiles.Count> 0然后开始
SrcFileName：= fSrcFiles [0];
fSrcFiles.Delete（0）;
end else
SrcFileName：='';
如果SrcFileName =''然后
fFilesEvent.ResetEvent;
finally
fCS.Release;
结束
如果SrcFileName =''然后
break;
DestFileName：= fDestDir + ExtractFileName（SrcFileName）;
CopyFile（PChar（SrcFileName），PChar（DestFileName），True）;
结束
结束
结束
结束
函数TFileCopyThread.IsCopyingFiles：boolean;
begin
fCS.Acquire;
try
结果：=（fSrcFiles.Count> 0）
//最后一个文件仍然被复制
或（WaitForSingleObject（fFilesEvent.Handle，0）= WAIT_OBJECT_0）;
finally
fCS.Release;
结束
结束
要在生产代码中使用这个，您需要添加错误处理，也可能是一些进度通知，复制本身应该有所不同，但这应该让你开始。
回答你的问题：
我应该在主程序的FormCreate中创建FileCopyThread（并让它运行），这会减慢程序吗？
您可以创建线程，它将阻止事件并消耗0个CPU周期，直到添加要复制的文件。一旦所有文件被复制，线程将再次阻塞，因此在程序的整个运行时间内保持它不会消耗一些内存。
我可以向FileCopyThread添加正常的事件通知（这样我可以在属性onProgress中发送一个事件：TProgressEvent read fOnProgressEvent write fOnProgressEvent;使用当前文件列表中的文件和当前处理的文件。想要在添加和复制例程之前和之后调用此功能
您可以添加通知，但是对于他们来说真的很有用需要在主线程的上下文中执行，最简单和最丑陋的方法是使用$ code> Synchronize（）方法来包装它们，看看Delphi Threads演示例如如何做到这一点，然后阅读通过在这里搜索[delphi]同步找到的一些问题和答案，看看这个技术有没有一些缺点。
但是，我不会以这种方式实现通知。如果您只想显示进度，则无需为每个文件更新。此外，您已经在VCL线程中添加了要复制的文件的所有必需信息。您可以简单地启动一个计时器，其中 Interval 为100，并使定时器事件处理程序检查线程是否仍然忙，还有多少文件被复制。当线程再次被阻止时，可以禁用定时器。如果您需要更多或不同的线程信息，那么您可以轻松地向线程类添加更多线程安全的方法（例如返回挂起的文件数）。我开始使用最小的界面来保持简单易用，仅用作灵感。
评论您更新的问题：
您有以下代码：
函数TFileCopyThread.GetFileBeingCopied：string;
begin
结果：='';
如果fFileBeingCopied<> ''然后开始
fCS.Acquire;
try
结果：= fFileBeingCopied;
fFilesEvent.SetEvent;
finally
fCS.Release;
结束
结束
结束
但它有两个问题。首先，对数据字段的所有访问都需要保护，以便安全，然后只是读取数据，而不是添加新文件，因此不需要设置事件。修改后的方法将是：
函数TFileCopyThread.GetFileBeingCopied：string;
begin
fCS.Acquire;
try
结果：= fFileBeingCopied;
finally
fCS.Release;
结束
结束
此外，您只设置 fFileBeingCopied 但是不要重置它，所以它总是等于最后复制的文件，即使线程被阻止。当最后一个文件被复制时，您应该将该字符串设置为空，当然，在获取关键部分时也应该这样做。如果阻止，只需移动分配通过。
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.
这篇关于使用线程将主线程添加到字符串列表中的文件复制的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
