У меня есть программа для создания веб-сайтов, которая при создании сайта создает сотни файлов.
Когда корневая папка Интернета находится на локальном компьютере, программа работает нормально. Если корневая папка в Интернете расположена на сетевом диске, копирование созданной страницы занимает больше времени, чем создание самой страницы (создание страницы достаточно оптимизировано).
Я думал создать файлы локально, добавить имена созданных файлов в TStringList и позволить другому потоку скопировать их на сетевой диск (удалив скопированный файл из TStringList).
Хауэрвер, я никогда раньше не использовал потоки, и я не мог найти существующий ответ в других вопросах Delphi, связанных с потоками (если бы мы только могли использовать оператор and в поле поиска), поэтому я Теперь я спрашиваю, есть ли у кого-нибудь рабочий пример, который делает это (или может указать мне какую-то статью с рабочим кодом Delphi)?
Я использую Delphi 7.
EDITED: мой образец проекта (спасибо исходному коду от 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, великолепны. Что за сообщество.
