Главная страница
Top.Mail.Ru    Яндекс.Метрика
Текущий архив: 2003.05.19;
Скачать: CL | DM;

Вниз

Thread ы и FindFiles   Найти похожие ветки 

 
BOBAH   (2003-05-05 18:45) [0]

Имеет место быть следующая проблема:
Есть поток в нем выполняются какие-то действия, пока он жив показывается модальная форма. Основное дейстиве потока не важно, но там ест цикл:
while (FindNext(F)=0)
Модальная форма убирается когда вызывается событие OnTerminate у потока.
Все работало прекрасно, пока не появился пользователь с Windwows 2000 Server и унего этот поток продолжает жить, у меня подозрение что возможны две причины такого поведения:
1. не выходит из цикла описанного выше
2. как-то по особенному работают Tread"ы в Win2000Server


 
pasha_golub ©   (2003-05-05 18:51) [1]

Не знаю как в вынь2000сервак, но у меня на ХР такая же хрень работала точно так же как и в 98...


 
pasha_golub ©   (2003-05-05 18:56) [2]

А вот и код...

TDetailsThread = class(TThread)
private
FFolderName: string;
FilesCount: longint;
FoldersCount: longint;
TotalSize: int64;
Created: string;
Attr: string;
DriveIndex: byte;
protected
procedure Execute; override;
procedure UpdateInfo;
public
procedure GetFolderSize(const APath: string);
constructor Create(const Path: string);
end;

...трям-тарарам...


procedure TDetailsThread.Execute;
var A: word;
SR: TSearchRec;
begin
FreeOnTerminate := false;
TotalSize := 0;
FilesCount := 0;
FoldersCount := 0;
FindFirst(FFolderName+"\.", faAnyFile, sr);
FindClose(SR);
if SR.Time <= -1 then Created := "" else Created := DateTimeToStr(FileDateToDateTime(SR.Time));
GetFolderSize(FFolderName);
A := FileGetAttr(FFolderName);
Attr := "";
If (A and faReadOnly) = faReadOnly then Attr := Attr+#13#10+" Только чтение";
if (A and faArchive) = faArchive then Attr := Attr+#13#10+" Архивная";
if (A and faSysFile) = faSysFile then Attr := Attr+#13#10+" Системная";
if (A and faHidden) = faHidden then Attr := Attr+#13#10+" Скрытая";
{$Warnings on}
if not Terminated then Synchronize(UpdateInfo);
end;

procedure TDetailsThread.GetFolderSize(const APath: string);
var SR: TSearchRec;
begin
if Terminated then Exit;
if FindFirst(APath+"\*.*", faAnyFile, sr) = 0 then
repeat
if ((sr.Attr and faDirectory) = faDirectory) then
begin
if (sr.Name <> ".") and (sr.Name <> "..") then
begin
GetFolderSize(APath+"\"+sr.Name);
inc(FoldersCount);
end
end
else
begin
inc(FilesCount);
TotalSize := TotalSize + sr.Size;
end;

until (FindNext(sr) <> 0) or (Terminated);
FindClose(sr);
end;



 
BOBAH   (2003-05-05 18:59) [3]

У меня XP стоит тоже все работает, на 98 и Win2000 не server тоже работает.
А win2000serv не у меня а у user"a а поставить и потестировать на win200serv нет возможности



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

Текущий архив: 2003.05.19;
Скачать: CL | DM;

Наверх




Память: 0.47 MB
Время: 0.012 c
1-59795
Apachi
2003-05-07 07:26
2003.05.19
Окна


11-59641
Сандро
2002-08-12 12:48
2003.05.19
Формы


1-59735
Yel
2003-05-06 07:49
2003.05.19
имя и рабочая папка ярлыка


3-59606
msoftware
2003-04-28 16:22
2003.05.19
Проблема с поиском записей


1-59775
Peter
2003-05-06 17:50
2003.05.19
Как узнать путь