Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Основная";
Текущий архив: 2003.09.04;
Скачать: [xml.tar.bz2];

Вниз

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

 
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 :))))


 
Camus   (2003-08-21 13:00) [9]

> iNew © (21.08.03 12:01) [8]
> Я хочу свой ProgressBar :))))

А чем "свой" лучше стандартного?


 
panov   (2003-08-21 13:03) [10]

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

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


 
panov   (2003-08-21 13:14) [11]

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

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

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

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

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



Страницы: 1 вся ветка

Форум: "Основная";
Текущий архив: 2003.09.04;
Скачать: [xml.tar.bz2];

Наверх





Память: 0.49 MB
Время: 0.009 c
6-10856
Alien
2003-06-24 15:42
2003.09.04
TServerSocket.Socket.SendBuf/ReceiveBuf


3-10551
-=[SDA]=-
2003-08-12 07:19
2003.09.04
Можно ли программно настроить алиас?


4-11030
sucer
2003-07-05 15:35
2003.09.04
Как убить процесс ,зная только его имя?


3-10577
Cranium
2003-08-14 16:01
2003.09.04
Запрет перетаскивания столбца в гриде?


14-10891
pasha_golub
2003-08-15 22:18
2003.09.04
И тут Остапа понесло...





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский