Потоки мешаю друг другу

← →
Мирон © (2004-09-30 14:58) [0]

В проге запущен поток (делает бэкап некоего каталога на диске).
При запуске в проге второго подобного (оба экземпляры одного класса) - первый прекращает работу. Из-за чего это может быть? Заранее спасибо.

← →
Ozone © (2004-09-30 15:02) [1]

А что делает 2-й поток?

← →
Мирон © (2004-09-30 15:05) [2]

> А что делает 2-й поток?

бэкап другого каталога

← →
Суслик © (2004-09-30 15:06) [3]

чую к посту 20 мы выясним все детали :)))
может быть даже кусочек кода получим

← →
Суслик © (2004-09-30 15:08) [4]

Автору.

Только большая просьба - если соизволишь дать код, то не приводи листинг на 102 страницах. Сократи до размера разумного.

← →
pasha_golub © (2004-09-30 15:10) [5]

Раз, два, три , четыре, пять - начинаю телепать:

"Вижу, вижу... Два потока обращаются к одному файлу в режиме монопольного доступа"

← →
TUser © (2004-09-30 15:11) [6]

> то не приводи листинг на 102 страницах. Сократи до размера
> разумного.

До ближайшей круглой цифры

← →
Мирон © (2004-09-30 15:12) [7]

> "Вижу, вижу... Два потока обращаются к одному файлу в режиме
> монопольного доступа"

Ни фига, потоки пишут разные каталоги в разные места

← →
Суслик © (2004-09-30 15:14) [8]

> [5] pasha_golub © (30.09.04 15:10)

Слабак!
До телепата тебе далеко :)))
Ты лучше попробуй Мирону телепатировать код выложить...

← →
pasha_golub © (2004-09-30 15:14) [9]

Мирон © (30.09.04 15:12) [7]
А мы это должны по наитию знать? :))

← →
Суслик © (2004-09-30 15:15) [10]

> [9] pasha_golub © (30.09.04 15:14)

> А мы это должны по наитию знать? :))

Учись, студент :)) Где тебе еще такие горизонты применения своих телепатических навыков приснятся?

← →
Ozone © (2004-09-30 15:18) [11]

:) Хватит флудить. Давайте все дружно подождем кода!

← →
pasha_golub © (2004-09-30 15:18) [12]

Суслик © (30.09.04 15:15) [10]
:0)

Ozone © (30.09.04 15:18) [11]
Раз, два, три , четыре, пять - начинаю кода ждать.

← →
Суслик © (2004-09-30 15:20) [13]

> [12] pasha_golub © (30.09.04 15:18)

восемь тысяч девятьсот сотрок пять
восемь тысяч девятьсот сотрок шесть
восемь тысяч девятьсот сотрок семь
....

ЗЫ. Не будет кода

← →
Суслик © (2004-09-30 15:20) [14]

← →
Romkin © (2004-09-30 15:21) [15]

Лучше я телепну:
TCoolTread.Execute; begin while not Terminated do Syncronize; end;
ТАк? :))))

← →
Мирон © (2004-09-30 15:24) [16]

Ща, подождите, обстоятельно все напишу. Чтоб потом вопросов было меньше.

← →
Суслик © (2004-09-30 15:24) [17]

> [16] Мирон © (30.09.04 15:24)
> Ща, подождите, обстоятельно все напишу. Чтоб потом вопросов
> было меньше.

Ура!!!!
Так бы сразу :)))

← →
pasha_golub © (2004-09-30 15:32) [18]

Суслик © (30.09.04 15:24) [17]
Эх, студент. :)
Ура, заработало (с) Матроскин

← →
Мирон © (2004-09-30 15:49) [19]

Как уже все наверное протелепатировали, прога делает резервные копии каталогов.
Каждая задача запускается в отдельном потоке. Каждая задача реализована как класс (ну, пунктик у меня на счет ООП, что поделаешь...:-)).

Вот описание

TBackUP = class(TObject)
private
FDestination: string;
FName: String;
FSourche: String;
FLastExec: TDate;
Form: TfmBackUp;
FActive: Boolean;
FThread: TBackUpThread;
procedure SetName(const Value: String);
procedure SetSourche(const Value: String);
procedure SetDestination(const Value: string);
procedure SetActive(const Value: Boolean);
public
constructor Create(F: TfmBackUp);
procedure GOBackUp; // сама процедура копирования
procedure SaveToStream(MS: TufMemoryStream); //
procedure LoadFromStream(MS: TufMemoryStream);
procedure ShowPropertyes; // отбражаем состояние на контролах формы (TfmBackup)
property Active: Boolean read FActive write SetActive;
property Destination: string read FDestination write SetDestination; // папка, куда все копируем
property LastExec: TDate read FLastExec write FLastExec;
property Name: String read FName write SetName;
property Sourche: String read FSourche write SetSourche; // папка, откуда все копируем
end;

Описание класса потока

TBackUpThread = class(TThread)
private
FProfile: TBackUP;
TotalFiles: Integer;
CurrentFile: Integer;
StartDir: String;
CurrentDirName: String;
CurrentFileName: String;
public
constructor Create(AProfile: TBackUP);
function FilesCount(Dir: String): Integer; // функция возвращает количество файлов и папок в указанном каталоге
procedure Execute; override;
procedure ShowProgress;
end;

Далее. При создании формы, из файла настроек считываются имеющиеся задания, для каждого из которых создается экземпляр TBackUp, указатель на него помещается в ListBox формы. При щелканьи на кнопке "GO" на форме. Выделенное получает Active := True.

Вот код

procedure TBackUP.SetActive(const Value: Boolean);
begin
if FActive <> Value
then begin
FActive := Value;
Form.btnRun.Enabled := not Value;
Form.btnStop.Enabled := Value;
Form.LB.Enabled := not Value;
if Value
then GOBackUp
else FThread.Terminate;
end;
end;

далее попадаем в

procedure TBackUP.GOBackUp;
begin
FThread := TBackUpThread.Create(Self);
FThread.Execute;
end;

далее

procedure TBackUpThread.Execute;
var
SL: TStringList;
//=============================================================
procedure ScanDirectory(CurrBUF, Dir: String);
var
sr, srFiles, srDest, srSourche: TSearchRec;
OldDate, NewDate: TDateTime;
DestFileName, SourcheFileName: String;

begin
if Terminated
then Exit;
if Dir[Length(Dir)] <> "\"
then Dir := Dir + "\";
if CurrBUF[Length(CurrBUF)] <> "\"
then CurrBUF := CurrBUF + "\";
SL.Add("Ñêàíèðóåì ïàïêó: " + Dir + sr.Name);
if FindFirst(Dir + "*.*", faAnyFile, srFiles) = 0
then begin
try
repeat
if (not ((srFiles.Attr and faDirectory) = faDirectory))
then begin
inc(CurrentFile);
CurrentFileName := srFiles.Name;
CurrentDirName := "..\" + ExtractRelativePath(StartDir, Dir);
SourcheFileName := Dir + srFiles.Name;
DestFileName := CurrBUF + srFiles.Name;
Synchronize(ShowProgress);
if not FileExists(DestFileName)
then begin
SL.Add(" Êîïèðóåì ôàéë:" + srFiles.Name);
if not CopyFile(PAnsiChar(SourcheFileName), PAnsiChar(DestFileName), False)
then SL.Add("Íå óäàëîñü ñêîïèðîâàòü");
end
else begin
if FindFirst(DestFileName, faAnyFile, srDest) = 0
then begin
try
if (srDest.FindData.ftLastWriteTime.dwLowDateTime <> srFiles.FindData.ftLastWriteTime.dwLowDateTime)
and (srDest.FindData.ftLastWriteTime.dwHighDateTime <> srFiles.FindData.ftLastWriteTime.dwHighDateTime)
then begin
SL.Add("Îáíîâëÿåì ôàéë: " + srFiles.Name);
if not CopyFile(PAnsiChar(SourcheFileName), PAnsiChar(DestFileName), False)
then SL.Add("Íå óäàëîñü îáíîâèòü");
end;
finally
SysUtils.FindClose(srDest);
end;
end;
end;
end;
until FindNext(srFiles) <> 0
finally
SysUtils.FindClose(srFiles);
end;
end;
if FindFirst(Dir + "*.*", faHidden or faDirectory, sr) = 0
then begin
try
repeat
if (sr.Attr and faDirectory = faDirectory) and (sr.Name[1] <> ".")
then begin
inc(CurrentFile);
Synchronize(ShowProgress);
ForceDirectories(CurrBUF + sr.Name);
ScanDirectory(CurrBUF + sr.Name, Dir + sr.Name);
end;
until FindNext(sr) <> 0
finally
SysUtils.FindClose(sr);
end;
end;
end;
begin
if DirectoryExists(FProfile.FSourche)
then begin
SL := TStringList.Create;
try
TotalFiles := FilesCount(FProfile.Sourche);
SL.Add("Íàéäåíî ôàéëîâ è ïàïîê: " + IntToStr(TotalFiles));
CurrentFile := 0;
ScanDirectory(FProfile.FDestination, FProfile.Sourche);
Terminate;
Synchronize(ShowProgress);
finally
try
SL.SaveToFile(ExtractFilePath(Application.ExeName) + FProfile.Name + ".txt");
finally
SL.Free;
end;
end;
end;
end;

← →
Мирон © (2004-09-30 15:51) [20]

так отображается состояние потока при "Synchronize(ShowProgress);"

procedure TBackUpThread.ShowProgress;
begin
Self.Suspend;
Application.ProcessMessages;
Self.Resume;
if FProfile.Form.LB.ItemIndex = FProfile.Form.LB.Items.IndexOfObject(FProfile)
then begin
if Self.Terminated
then begin
FProfile.Active := False;
FProfile.Form.PB.Position := 0;
FProfile.Form.lblFolder.Caption := "Ïàïêà:";
FProfile.Form.lblFile.Caption := "Ôàéë:";
end
else begin
FProfile.Form.PB.Min := 0;
FProfile.Form.PB.Max := TotalFiles;
FProfile.Form.PB.Position := CurrentFile;
FProfile.Form.lblFolder.Caption := "Папка: " + CurrentDirName;
FProfile.Form.lblFile.Caption := "Файл: " + CurrentFileName;
end;
end;

← →
Суслик © (2004-09-30 15:53) [21]

> procedure TBackUP.GOBackUp;
> begin
> FThread := TBackUpThread.Create(Self);
> FThread.Execute;> end;

Ты неправильно запускаешь потоки.
Читай примеры.

ЗЫ. Ты не показал тело конструктора потока, но думаю в данном случае resume подойдет.

Как сейчас есть у тебя нет никакого потока - поток у тебя один :)))

← →
Суслик © (2004-09-30 15:57) [22]

> Self.Suspend;
> Application.ProcessMessages;
> Self.Resume;

это ерунда какая-то :)))

зачем ты в потоке вызываешь terminate? Вообще ерунда.

Совет. Серьезно займись изучением класса TThread. См. примеры. См. код реализации в classes.pas.

← →
Мирон © (2004-09-30 15:58) [23]

конструктор

constructor TBackUpThread.Create(AProfile: TBackUP);
begin
inherited Create(True);
Priority := tpLower;
FProfile := AProfile;
StartDir := FProfile.FSourche;
end;

← →
Мирон © (2004-09-30 16:00) [24]

Поставил "Resume" - заработало. Спасибо.

← →
Суслик © (2004-09-30 16:01) [25]

> [24] Мирон © (30.09.04 16:00)
> Поставил "Resume" - заработало. Спасибо.

Рано говорить спасибо.

Если хочешь сделать нормальную реализацию с пониманием дела тебе нужно сильно переработать твой код. Хотя, дело твое.

> Мирон

Self.Suspend;
Application.ProcessMessages;
Self.Resume;

поясни, пож., свою глубокую мысль - что ты хотел этим кодом сделать и из каких соображений ?

> inherited Create(True);

вот ты создал "спящий" поток, а где же его "пробуждение" ?

А где поток уничтожать-то, когда он отработает?

> [27] Мирон © (30.09.04 16:08)
> А где поток уничтожать-то, когда он отработает?

Ставь объекту потока FreeOnTerminat = true и дело с концом.
Сам уничтожится.

Удалено модератором

было
procedure TBackUP.GOBackUp; begin FThread := TBackUpThread.Create(Self); FThread.Execute; end;

И, короче, кнопочки на форме не нажимались.

Self.Suspend; Application.ProcessMessages; Self.Resume;

помогло рещить проблему

исправил
procedure TBackUP.GOBackUp; begin FThread := TBackUpThread.Create(Self); FThread.Resume; end;

вроде фунциклирует

> И, короче, кнопочки на форме не нажимались.
>
> Self.Suspend;
> Application.ProcessMessages;
> Self.Resume;

Конечно не нажимались, у тебя же тело методе Execute выполнялось в основном кодовом потоке :)))

> Self.Suspend;
> Application.ProcessMessages;
> Self.Resume;
>
> помогло рещить проблему

все понятно - великий и могучий метод научного тыка

нет бы документацию почитать

> Конечно не нажимались, у тебя же тело методе Execute выполнялось
> в основном кодовом потоке :)))

Уже допер. Ладно, не ржите. Врядли кто с первого раза делает все правильно.

> Уже допер. Ладно, не ржите. Врядли кто с первого раза делает
> все правильно.

Кто-то и со второго не все делает правильно, особенно если документацию не читал.

Без обид. Ну ведь это правда? :)

Мирон, заглянь в папку Demos. Пример тама отличный. Я сам по нему вкуривал.

Да читал я её. Если бе не читал, не наваял бы даже такого. Просто нету времени на серьезное изучение - завтра надо показать работающую прогу. А там дадут пару дней на ловлю багов, тогда и почитаю...

Потоки мешаю друг другу Найти похожие ветки