Вот сделал копирование файлов в отдельном потоке. Оцените.

← →
iNew © (2003-08-21 05:35) [0]

type

TMyThread = class(TThread)
private
SPath : String;
DPath : String;
protected
procedure Execute; override;
procedure MyFindF;
public
constructor Create(SourceDir,DestDir:string);
end;

implementation
uses
Main;

constructor TMyThread.Create(SourceDir,DestDir:string);
begin
inherited Create(True);
FreeOnTerminate := True;
SPath := SourceDir;
DPath := DestDir;
Self.Priority := tpHighest;
Resume;
end;

procedure TMyThread.Execute;
var
FTimeOut: Integer;
EndTime: TDateTime;
begin
FTimeOut := 1;
EndTime := now + (1/24/60)* FTimeOut;
while not Terminated do
begin
Sleep(100);
if Terminated then break;
if now>=EndTime then
begin
Synchronize(MyFindF);
EndTime := now + (1/24/60)* FTimeOut;
end;
end;
end;

function MyCopyFile(FileName, DestName: TFileName):Integer;
var
CopyBuffer: Pointer; { buffer for copying }
BytesCopied: Longint;
Source, Dest: Integer; { handles }
const
ChunkSize: Longint = 8192; { copy in 8K chunks }
begin
GetMem(CopyBuffer, ChunkSize); { allocate the buffer }
try
Source := FileOpen(FileName, fmShareDenyWrite); { open source file }
// if Source < 0 then ShowMessage("Error");
try
Dest := FileCreate(DestName); { create output file; overwrite existing }
// if Dest < 0 then ShowMessage("Error");
try
repeat
BytesCopied := FileRead(Source, CopyBuffer^, ChunkSize); { read chunk }
if BytesCopied > 0 then { if we read anything... }
FileWrite(Dest, CopyBuffer^, BytesCopied); { ...write chunk }
until BytesCopied < ChunkSize; { until we run out of chunks }
finally
FileClose(Dest); { close the destination file }
end;
finally
FileClose(Source); { close the source file }
end;
finally
FreeMem(CopyBuffer, ChunkSize); { free the buffer }
end;
Result:=GetLastError;
end;

procedure TMyThread.MyFindF;
var lpFD : WIN32_FIND_DATA;
hd : integer;
DirTo : String;
str1,str2: String;
MyBool : Boolean;

begin
str1:=".";
str2:="..";
MyBool:=true;
hd:=FindFirstFile(PChar(SPath+"\*.*"),lpFd);
try
while MyBool do
begin
if (lpFD.cFileName <> str1) and (lpFD.cFileName <> str2) then
begin
if lpFD.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY = 0 then
begin
MyCopyFile(SPath+"\"+lpFd.cFileName,DPath+"\"+lpFD.cFileName);
end
else
begin
DirTo:=DPath+"\"+lpFD.cFileName;
if not DirectoryExists(DirTo) then CreateDir(DirTo);
CopyWithSubDir(SPath+"\"+lpFD.cFileName,DirTo);
end;
end;
MyBool:=FindNextFile(hd,lpFD);
end;
finally
Windows.FindClose(hd);
end;
end;
end.

P.S. Только не пинайте сразу. Можно просто словами объяснить :)

← →
Evgeny V © (2003-08-21 06:25) [1]

Execute - хотел много спросить, но..., не правильно построен алгоритм работы с потоком, в данном случае у тебя нет преимущества работы в другом потоке - Synchronize(MyFindF); ты выполняешь всю работу основную в потоке главного окна, фактически Synchronize шлет SendMessage главному окну, и оно уже выполняет MyFindF, а твой поток в этот момент висит, ждет завершения SendMessage. С таким жк успехом можно было по кнопке делать в основном окне. Не понятно зачем Sleep(100), после него опять проверка на if Terminated then break;, убери Sleep и проверка будет не нужна. С работой с файлами не смотрел внимательно,но сложилось впечатление что и цикл в Execute while тебе вообще не нужен, вроде ты сразу все копируешь, скопировал и выходи из потока. Ошибки есть(алгоритмические), но все поправимо, посмотри хелп по TThread и все будет ок:-))))

← →
iNew © (2003-08-21 06:49) [2]

> Evgeny V
//не правильно построен алгоритм работы с потоком.

А как надо использовать MyFindF?

← →
Zergling © (2003-08-21 07:03) [3]

А кто такой CopyWithSubDir

ChunkSize: Longint = 8192;
FileRead(Source, CopyBuffer^, ChunkSize);
А не будет ли ошибки при чтении по 8 кб (выход за конец файла), может лучше ChunkSize: Longint = 1;

Пррисоеденяюсь к Evgeny V ©
Вместо Synchronize(MyFindF) можно слать мессаги или извратиться с глобальными переменными.

← →
iNew © (2003-08-21 09:12) [4]

> Zergling А кто такой CopyWithSubDir
Ошибочка вышла, там должно быть MyFindF.
> Evgeny V
А если не использовать Synchronize, а содержимое MyFindF
запихать прямо в TMyThread.Execute?

← →
iNew © (2003-08-21 10:28) [5]

Да точно если Synchronize(MyFindF) то с формой никаких действий
во время копирования произвести нельзя. А вот если сделать
while not Terminated do
begin
Sleep(100);
if Terminated then break;
if now>=EndTime then
begin
MyFindF;
EndTime := now + (1/24/60)* FTimeOut;
end;
end;
end;
то нормально.
Правильно ли так?

← →
Evgeny V © (2003-08-21 11:52) [6]

Да так можно,а зачем Sleep - не понимаю:-))

← →
Игорь Шевченко © (2003-08-21 11:56) [7]

SHFileOperation, однако :)))

← →
iNew © (2003-08-21 12:01) [8]

> Evgeny V а зачем Sleep - не понимаю:-))
http://delphimaster.net/view/1-1061342338/

> Игорь Шевченко SHFileOperation, однако :)))
Я хочу свой ProgressBar :))))

Ну написал человек - изучает именно это раздел программирования.

Ему ж совет именно для изучения нужен, доберется и до других методов... позже...

Далее возможны 2 пути для взаимодействия для отображения ProgressBar.

1. Создать ProgressBar в основном потоке и уведомлять его об изменении.
2. Создать ProgressBar в отдельном потоке.

В первом случае прочесс копирования будет все-таки притормаживать обновление визуальных объектов приложения.
А использование Application.ProcessMessages замедлит копирование файлов, так как будет довольно частое переключение на выборку сообщений из очереди сообщений.
К тому же поток у тебя создается с приоритетом выше нормального, что тоже повлияет на скорость работы в основном потоке.

Для синхронизации можно использовать либо Synchronize, либо воспользоваться посылкой сообщений для ProgressBar...

Второй метод позволяет избавиться от этих недостатков.

Вот сделал копирование файлов в отдельном потоке. Оцените. Найти похожие ветки