| Форумы
ЧАТ |
Орешник |
|
| Форумы -» | Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG |
|
| ||
|
|
Новости |
Поиск |
FAQ |
Статьи |
Книги |
Новости VCL
| | Форумы ЧАТ |
Орешник |
|
| |||
| |||
| |||
« предыдущая ветвь | форум | следующая ветвь »
Потоки мешаю друг другу [D7, WinXP]
Мирон © (2004-09-30 14:58:00)В проге запущен поток (делает бэкап некоего каталога на диске).
При запуске в проге второго подобного (оба экземпляры одного класса) - первый прекращает работу. Из-за чего это может быть? Заранее спасибо.
Мирон (2004-09-30 16:25:00) [1]Да читал я её. Если бе не читал, не наваял бы даже такого. Просто нету времени на серьезное изучение - завтра надо показать работающуюпрогу. А там дадут пару дней на ловлю багов, тогда и почитаю...
pasha_golub (2004-09-30 16:23:00) [2]Мирон, заглянь в папку Demos. Пример тама отличный. Я сам по нему вкуривал.
Суслик (2004-09-30 16:20:00) [3]
> Уже допер. Ладно, не ржите. Врядли кто с первого раза делает
> все правильно.
Кто-то и со второго не все делает правильно, особенно если документацию не читал.
Без обид. Ну ведь это правда? :)
Мирон (2004-09-30 16:18:00) [4]
> Конечно не нажимались, у тебя же тело методе Execute выполнялось
> в основном кодовом потоке :)))
Уже допер. Ладно, не ржите. Врядли кто с первого раза делает все правильно.
Digitman (2004-09-30 16:16:00) [5]
> Self.Suspend;
> Application.ProcessMessages;
> Self.Resume;
>
> помогло рещить проблему
все понятно - великий и могучий метод научного тыка
нет бы документацию почитать
Суслик (2004-09-30 16:13:00) [6]
> И, короче, кнопочки на форме не нажимались.
>
> Self.Suspend;
> Application.ProcessMessages;
> Self.Resume;
Конечно не нажимались, у тебя же тело методе Execute выполнялось в основном кодовом потоке :)))
Мирон (2004-09-30 16:12:00) [7]было
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;
вроде фунциклирует
Erik1 (2004-09-30 16:11:00) [8]Удалено модератором
Суслик (2004-09-30 16:10:00) [9]
> [27] Мирон © (30.09.04 16:08)
> А где поток уничтожать-то, когда он отработает?
Ставь объекту потока FreeOnTerminat = true и дело с концом.
Сам уничтожится.
Мирон (2004-09-30 16:08:00) [10]А где поток уничтожать-то, когда он отработает?
Digitman (2004-09-30 16:05:00) [11]
> Мирон
Self.Suspend;
Application.ProcessMessages;
Self.Resume;
поясни, пож., свою глубокую мысль - что ты хотел этим кодом сделать и из каких соображений ?
> inherited Create(True);
вот ты создал "спящий" поток, а где же его "пробуждение" ?
Суслик (2004-09-30 16:01:00) [12]
> [24] Мирон © (30.09.04 16:00)
> Поставил "Resume" - заработало. Спасибо.
Рано говорить спасибо.
Если хочешь сделать нормальную реализацию с пониманием дела тебе нужно сильно переработать твой код. Хотя, дело твое.
Мирон (2004-09-30 16:00:00) [13]Поставил "Resume" - заработало. Спасибо.
Мирон (2004-09-30 15:58:00) [14]конструктор
constructor TBackUpThread.Create(AProfile: TBackUP);
begin
inherited Create(True);
Priority := tpLower;
FProfile := AProfile;
StartDir := FProfile.FSourche;
end;
Суслик (2004-09-30 15:57:00) [15]
> Self.Suspend;
> Application.ProcessMessages;
> Self.Resume;
это ерунда какая-то :)))
зачем ты в потоке вызываешь terminate? Вообще ерунда.
Совет. Серьезно займись изучением класса TThread. См. примеры. См. код реализации в classes.pas.
Суслик (2004-09-30 15:53:00) [16]
> procedure TBackUP.GOBackUp;
> begin
> FThread := TBackUpThread.Create(Self);
> FThread.Execute;> end;
Ты неправильно запускаешь потоки.
Читай примеры.
ЗЫ. Ты не показал тело конструктора потока, но думаю в данном случае resume подойдет.
Как сейчас есть у тебя нет никакого потока - поток у тебя один :)))
Мирон (2004-09-30 15:51:00) [17]так отображается состояние потока при "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:49:00) [18]Как уже все наверное протелепатировали, прога делает резервные копии каталогов.
Каждая задача запускается в отдельном потоке. Каждая задача реализована как класс (ну, пунктик у меня на счет ООП, что поделаешь...:-)).
Вот описание
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;
pasha_golub (2004-09-30 15:32:00) [19]Суслик © (30.09.04 15:24) [17]
Эх, студент. :)
Ура, заработало (с) Матроскин
Суслик (2004-09-30 15:24:00) [20]
> [16] Мирон © (30.09.04 15:24)
> Ща, подождите, обстоятельно все напишу. Чтоб потом вопросов
> было меньше.
Ура!!!!
Так бы сразу :)))
| |
Страницы: 