Копирование файлов, которые основной поток добавляет в список строк, используя поток
У меня есть программа для создания веб-сайтов, которая при создании сайта создает сотни файлов.
Когда корневая папка Интернета находится на локальном компьютере, программа работает нормально. Если корневая папка Интернета расположена на сетевом диске, копирование созданной страницы занимает больше времени, чем создание самой страницы (создание страницы довольно оптимизировано).
Я думал о создании файлов локально, добавляя имена созданных файлов в TStringList и позволяя другому потоку копировать их на сетевой диск (удаляя скопированный файл из TStringList).
Но я никогда раньше не использовал потоки, и я не мог найти существующий ответ в других вопросах Delphi, касающихся потоков (если бы мы могли использовать and оператор в поле поиска), поэтому я сейчас спрашиваю, есть ли у кого-нибудь рабочий пример, который делает это (или может указать мне какую-нибудь статью с рабочим кодом 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.
Любые дополнительные комментарии будут высоко оценены.
Читая комментарии и просматривая примеры, вы найдете различные подходы к решению, с за и против комментариями по всем из них.
Проблема при попытке реализовать сложную новую функцию (как мне кажется, темы) состоит в том, что вы почти всегда находите что-то, что, кажется, работает... сначала. Только позже вы узнаете, каким трудным образом все должно было быть иначе. И темы являются очень хорошим примером этого.
Такие сайты, как Stackru, великолепны. Что за сообщество.
3 ответа
Быстрое и грязное решение:
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;
Чтобы использовать это в рабочем коде, вам нужно добавить обработку ошибок, возможно, некоторые уведомления о ходе выполнения, и само копирование, вероятно, должно быть реализовано иначе, но это должно помочь вам начать.
В ответ на ваши вопросы:
я должен создать FileCopyThread в FormCreate основной программы (и позволить ему работать), это как-то замедлит программу?
Вы можете создать поток, он будет блокировать события и использовать 0 циклов ЦП, пока вы не добавите файл для копирования. После того, как все файлы будут скопированы, поток снова заблокируется, поэтому сохранение его в течение всего времени выполнения программы не оказывает отрицательного влияния, кроме использования некоторой памяти.
Могу ли я добавить обычное уведомление о событии в FileCopyThread (чтобы я мог отправить событие как в свойстве onProgress:TProgressEvent read fOnProgressEvent write fOnProgressEvent; при этом fi - текущее число файлов в списке и файл, обрабатываемый в данный момент. Я хочу вызвать это при добавлении и до и после процедуры копирования
Вы можете добавлять уведомления, но для того, чтобы они были действительно полезными, их нужно выполнять в контексте основного потока. Самый простой и уродливый способ сделать это - обернуть их Synchronize() метод. Посмотрите на демонстрацию Delphi Threads для примера, как это сделать. Затем прочитайте некоторые вопросы и ответы, найденные поиском "[delphi] synchronize" здесь в SO, чтобы увидеть, как этот метод имеет немало недостатков.
Однако я бы не реализовывал уведомления таким образом. Если вы просто хотите отобразить прогресс, нет необходимости обновлять его с каждым файлом. Кроме того, у вас уже есть вся необходимая информация в VCL-потоке, там, где вы добавляете файлы для копирования. Вы можете просто запустить таймер с Interval скажем, 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 блок.
Если вы несколько неохотно спускаетесь к металлу и имеете дело с TThread напрямую, как в решении mghie, альтернативой, возможно, более быстрой, является использование 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;
Хорошее начало для использования темы - Delphi находится на сайте Delphi о сайте.
Чтобы ваше решение работало, вам нужна очередь заданий для рабочего потока. Можно использовать список строк. Но в любом случае вам нужно защищать очередь, чтобы в нее мог писать только один поток. Даже если запись потока приостановлена.
Ваше приложение пишет в очередь. Таким образом, должен быть защищенный метод записи.
Ваш поток читает и удаляет из очереди. Таким образом, должен быть защищенный метод чтения / удаления.
Вы можете использовать критический раздел, чтобы убедиться, что только один из них имеет доступ к очереди в любой момент.