3

我有一个网络创建程序，它在构建站点时会创建数百个文件。

当互联网根文件夹位于本地电脑上时，程序运行良好。如果 Internet 根文件夹位于网络驱动器上，则复制创建的页面比创建页面本身需要更长的时间（页面的创建是相当优化的）。

我正在考虑在本地创建文件，将创建的文件的名称添加到 TStringList 并让另一个线程将它们复制到网络驱动器（从 TStringList 中删除复制的文件）。

但是，我以前从未使用过线程，并且在涉及线程的其他 Delphi 问题中找不到现有答案（如果我们可以and在搜索字段中使用运算符），所以我现在问是否有人有这样做的工作示例（或者可以指出一些带有工作德尔福代码的文章）？

我正在使用德尔福 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 这样的网站很棒。什么社区。

4

3 回答 3

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; 列表中的当前文件数和当前处理的文件。我想调用这在复制例程之前和之后添加时

您可以添加通知，但要使它们真正有用，它们需要在主线程的上下文中执行。最简单和最丑陋的方法是用方法包装它们Synchronize()。查看 Delphi Threads 演示，了解如何执行此操作的示例。然后阅读通过在 SO 上搜索“[delphi] 同步”找到的一些问题和答案，看看这种技术有很多缺点。

但是，我不会以这种方式实现通知。如果您只想显示进度，则无需使用每个文件进行更新。此外，您已经在 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块即可。

于 2010-01-17T11:51:22.090 回答
2

如果您有点不愿意像在mghie 解决方案中那样直接使用 TThread 并直接处理 TThread ，那么另一种可能更快的方法是使用Andreas Hausladen 的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;
于 2010-01-17T19:22:02.447 回答
1

使用线程的一个好的开始是 Delphi 可以在Delphi about 网站上找到

为了使您的解决方案有效，您需要一个工作线程的作业队列。可以使用字符串列表。但是在任何情况下，您都需要保护队列，以便在任何时候只有一个线程可以写入它。即使写线程被挂起。

您的应用程序写入队列。所以必须有一个受保护的写方法。

您的线程从队列中读取并删除。所以必须有一个受保护的读取/删除方法。

您可以使用临界区来确保在任何时候只有其中一个可以访问队列。

于 2010-01-17T11:11:11.797 回答