我有一个网络创建程序，在构建网站时会创建数百个文件。
当互联网根文件夹位于本地电脑上时，程序运行正常。如果Internet根文件夹位于网络驱动器上，则复制创建的页面所需的时间比创建页面本身要长（页面的创建得到了相当优化）。
我在考虑在本地创建文件，将创建的文件的名称添加到TStringList，让另一个线程将它们复制到网络驱动器（从TStringList中删除复制的文件）。
Howerver，我以前从未使用过线程，而且我在其他涉及线程的Delphi问题中找不到现有答案（如果我们只能在搜索字段中使用and运算符< / em>），所以我现在问是否有人有一个可以做到这一点的工作示例（或者可以指向一些使用Delphi代码的文章）？
我正在使用Delphi 7。
编辑：我的示例项目（由mghie转到原始代码 - 特此再次受到感谢）。
...
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;
和单位
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.
非常感谢任何其他评论。
阅读评论并查看示例，您可以找到解决方案的不同方法，并对所有这些方法进行赞成和评论。
尝试实现一个复杂的新功能（因为线程对我来说）时的问题是，你几乎总能找到一些似乎有用的东西......起初。只有在以后你才能找到应该以不同方式完成事情的艰难方式。而线程就是一个非常好的例子。
像StackOverflow这样的网站很棒。什么是社区。
答案 0 :(得分：12)
快速而肮脏的解决方案：
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;
要在生产代码中使用它，您需要添加错误处理，可能需要一些进度通知，并且复制本身应该以不同的方式实现，但这应该可以帮助您入门。
回答您的问题：
我应该在主程序的FormCreate中创建FileCopyThread（让它运行），这会以某种方式减慢程序的速度吗？
您可以创建线程，它将阻止事件并消耗0个CPU周期，直到您添加要复制的文件。一旦复制了所有文件，线程将再次阻塞，因此将其保留在程序的整个运行时间内除了消耗一些内存之外没有任何负面影响。
我可以向FileCopyThread添加正常事件通知（这样我就可以在属性onProgress中发送事件：TProgressEvent读取fOnProgressEvent写入fOnProgressEvent;使用fi列表中当前的文件数，以及当前处理的文件。我会喜欢在添加复制例程之前和之后调用它
您可以添加通知，但为了使它们真正有用，它们需要在主线程的上下文中执行。最简单和最丑陋的方法是使用Synchronize()方法包装它们。查看Delphi Threads演示，了解如何执行此操作的示例。然后通过在SO上搜索“[delphi] synchronize”来找到一些问题和答案，看看这种技术有多少缺点。
但是，我不会以这种方式实现通知。如果您只想显示进度，则无需使用每个文件对其进行更新。此外，您已经在添加要复制的文件的位置具有VCL线程中的所有必要信息。您可以简单地启动一个{100}的Interval的计时器，并让计时器事件处理程序检查线程是否仍然忙，以及还有多少文件要复制。当线程再次被阻止时，您可以禁用计时器。如果您需要来自线程的更多或不同的信息，那么您可以轻松地向线程类添加更多线程安全的方法（例如，返回待处理文件的数量）。我开始使用最小的界面来保持小巧轻松，仅将其作为灵感。
评论您更新的问题：
您有以下代码：
function TFileCopyThread.GetFileBeingCopied: string;
begin
Result := '';
if fFileBeingCopied <> '' then begin
fCS.Acquire;
try
Result := fFileBeingCopied;
fFilesEvent.SetEvent;
finally
fCS.Release;
end;
end;
end;
但它有两个问题。首先，需要保护对数据字段的所有访问都是安全的，然后您只是读取数据而不是添加新文件，因此不需要设置事件。修改后的方法只是：
function TFileCopyThread.GetFileBeingCopied: string;
begin
fCS.Acquire;
try
Result := fFileBeingCopied;
finally
fCS.Release;
end;
end;
此外，您只设置fFileBeingCopied字段，但从不重置它，因此它总是等于最后复制的文件，即使线程被阻止也是如此。您应该在复制最后一个文件时将该字符串设置为空，当然也可以在获取关键部分时执行此操作。只需将作业移过if块。
答案 1 :(得分：2)
如果你有点不愿意直接使用金属并像mghie solution那样直接处理TThread，那么另一种选择，也许更快，就是使用Andreas Hausladen's AsyncCalls。
框架代码：
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;
答案 2 :(得分：1)
使用线程的良好开端是在the Delphi about site
找到Delphi为了使您的解决方案有效，您需要一个工作线程的作业队列。可以使用字符串列表。但无论如何，您需要保护队列，以便在任何一个时刻只有一个线程可以写入它。即使写作线程被暂停。
您的应用程序写入队列。所以必须有一个有保障的写法。
您的线程从队列中读取和删除。所以必须有一个有保护的读/删除方法。
您可以使用关键部分确保其中任何一个都可以在任何一个时刻访问该队列。