- html - 出于某种原因,IE8 对我的 Sass 文件中继承的 html5 CSS 不友好?
- JMeter 在响应断言中使用 span 标签的问题
- html - 在 :hover and :active? 上具有不同效果的 CSS 动画
- html - 相对于居中的 html 内容固定的 CSS 重复背景?
我有一个网络创建程序,在构建网站时会创建数百个文件。
当互联网根文件夹位于本地电脑上时,程序运行正常。如果互联网根文件夹位于网络驱动器上,则复制已创建的页面比创建页面本身花费的时间更长(页面的创建已相当优化)。
我正在考虑在本地创建文件,将创建的文件的名称添加到 TStringList 中,并让另一个线程将它们复制到网络驱动器(从 TStringList 中删除复制的文件)。
但是,我以前从未使用过线程,并且在涉及线程的其他 Delphi 问题中找不到现有答案(如果我们可以在搜索字段),所以我现在问是否有人有一个可以执行此操作的工作示例(或者可以向我指出一些包含工作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 这样的网站非常棒。多么好的社区啊。
最佳答案
一个快速但肮脏的解决方案:
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;
要在生产代码中使用它,您需要添加错误处理,也许一些进度通知,并且复制本身可能应该以不同的方式实现,但这应该可以帮助您开始。
回答您的问题:
should I create the FileCopyThread in the FormCreate of the main program (and let it running), will that slow down the program somehow ?
您可以创建线程,它将阻塞事件并消耗 0 CPU 周期,直到您添加要复制的文件。一旦所有文件都被复制,线程将再次阻塞,因此除了消耗一些内存之外,在程序的整个运行时保持它不会产生负面影响。
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
您可以添加通知,但要使它们真正有用,它们需要在主线程的上下文中执行。最简单也是最丑陋的方法是使用 Synchronize()
方法包装它们。查看 Delphi Threads 演示,了解如何执行此操作的示例。然后阅读通过在 SO 上搜索“[delphi]同步”找到的一些问题和答案,看看这种技术有很多缺点。
但是,我不会以这种方式实现通知。如果您只想显示进度,则无需对每个文件进行更新。此外,您已经在 VCL 线程中添加要复制的文件的位置拥有所有必要的信息。您可以简单地以 100 的间隔启动计时器,并让计时器事件处理程序检查线程是否仍然繁忙,以及还有多少文件需要复制。当线程再次被阻塞时,您可以禁用计时器。如果您需要来自线程的更多或不同的信息,那么您可以轻松地向线程类添加更多线程安全方法(例如返回挂起文件的数量)。我从一个最小的界面开始,让事情变得小而简单,仅将其用作灵感。
对您更新的问题发表评论:
您有以下代码:
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
block 即可。
关于multithreading - 使用线程复制主线程添加到字符串列表的文件,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/2080727/
如标题所示,ans_list是一个答案列表,ans_index是一个数字(答案在词汇表中的索引,但与atm无关) 这里生成的 tree.anslist 是什么? (例如,仅针对第一个),忽略迭代。 f
我目前将用户的输入存储在逗号分隔的列表中,如下所示: Userid | Options 1 | 1,2,5 用户在一个数组形式中勾选一组选项,然后用逗号连接起来 1,2,5 然后 MySQ
我目前将用户的输入存储在逗号分隔的列表中,如下所示: Userid | Options 1 | 1,2,5 用户在一个数组形式中勾选一组选项,然后用逗号连接起来 1,2,5 然后 MySQ
我想知道如何完全展平列表和包含它们的东西。除其他外,我想出了一个解决方案,它可以将具有多个元素的东西滑倒并将它们放回原处,或者在滑倒后将具有一个元素的东西拿走。 这与 How do I “flatte
我想知道如何完全展平列表和包含它们的东西。除其他外,我想出了一个解决方案,它可以将具有多个元素的东西滑倒并将它们放回原处,或者在滑倒后将带有一个元素的东西拿走。 这与 How do I “flatte
这个问题已经有答案了: Convert nested list to 2d array (3 个回答) 已关闭 7 年前。 java中有没有快捷方式可以转换 List> 到 String[][] ?
我在排序时遇到问题 List> 。我创建了一个自定义比较器,在其中编写了对数据进行排序的代码。 public class CustomComparator implements Comparator
这个问题已经有答案了: 已关闭10 年前。 Possible Duplicate: Java Generics: Cannot cast List to List? 我只是想知道为什么下面的java代
试图想出一个 LINQy 方法来做到这一点,但我什么也没想到。 我有一个对象列表<>,其中包含一个属性,该属性是逗号分隔的字母代码列表: lst[0].codes = "AA,BB,DD" lst[1
假设我有这些任务: points = [] point = (1, 2) 我怎么会这样做: points += point 它工作得很好,并且给了我点 = [1, 2]。但是,如果我这样做: poin
如何在 scala 中将 List[Task[List[Header]]] 类型转换为 Task[List[Header]]。 我有一个方法返回 Task[List[Header]] 并多次调用 do
如何在 Java 中查找二维列表的元素? 我有一个参数为 List> 的函数我想知道如何找到这个列表的行和列。 最佳答案 如果你喜欢 List> obj 然后你就可以像这样访问 obj.get(cur
分配 List到 List工作正常。 分配 List>到 List>不编译。 代码 public class Main { public static void main(String[] a
我正在用 Java 编写一个方法,该方法必须接收并迭代 Serializable 的 List。 有什么区别: public void myMethod(List list) { } 和 public
我看到很多人想用 mvvm 更新网格/列表/树的一部分,但他们不想刷新整个列表。 对于所有遇到此问题的人,我做了以下示例。 希望这对你有用。 最佳答案 这是一个简单的例子。整个代码中最重要的是: Bi
我正在为现有的 C++ 库编写包装器,该库使用列表,其中 T 是自定义结构。我被建议使用 vector 而不是列表,但我试图避免修改库。 为了更好地理解这个场景,我做了一个简单的应用程序,使用一个列表
List list List list 这两种声明有什么区别吗? 谢谢, 最佳答案 是的。 List可以包含所有派生自 Base 的不同事物的混合物. List包含同质项(从某种意义上说,它们必须全部
有人可以尽可能详细地解释以下类型之间的区别吗? List List List 让我更具体一点。我什么时候想使用 // 1 public void CanYouGiveMeAnAnswer(List l
我有一个元组列表,每个元组都是一对列表。所以我的数据看起来像: mylist = [(['foo', 'bar'], ['bar', 'bar']),(['bar', 'bar'],['bar', '
也许是一个时髦的标题,但我遇到了以下问题: 给定一个类型为 (a * b) list 的列表,我想创建一个类型为 (a * b list) list 的新列表。一个例子: 给定列表 let testL
我是一名优秀的程序员,十分优秀!