Witam,
ostatnio korzystałem z artykułu Adama Boducha na temat wyszukiwarki wielowątkowej w Delphi. Mój program jest oparty na jego przykładzie lecz nieco się różni. Jak mógłbym sprawdzić, czy wątek wciąż działa czy się zakończył? Pytam ponieważ muszę wiedzieć czy wyszukiwarka jeszcze pracuje czy już nie. Oto kod modułu:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
Tglowna = class(TForm)
log: TMemo;
plik: TEdit;
Button1: TButton;
dyski: TListBox;
Label1: TLabel;
Button2: TButton;
procedure FormShow(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
TSearchThread = class(TThread)
private
Start, Stop : Integer; // wartości przechowują czas rozpoczęcia i zakończenia działania wątku
Total : Currency; // wartość totalnego czasu przeszukania
FFileName : String; // nazwa pliku do odnalezienia
FDrive : Char; // dysk, w którym odbędzie się szukanie
procedure MyOnTerminate(Sender: TObject); // obsługa zdarzenia OnTerminatre
public
constructor Create(const FileName : String; Drive : Char); // konstruktor dla klasy
destructor Destroy; override; // destruktor dla klasy
procedure SearchInDrive; // procedura poszukiwawcza
protected
procedure Execute; override;
end;
var
glowna: Tglowna;
SearchThread : TSearchThread;
byles: integer = 0;
implementation
{$R *.dfm}
constructor TSearchThread.Create(Const FileName : String; Drive : Char);
begin
inherited Create(False); // wywołanie konstruktora klasy bazowej
FreeOnTerminate := True; // zwolnij przy zakończeniu
OnTerminate := MyOnTerminate; // przypisz procedurę zdarzenia
FFileName := FileName; // nazwa pliku do znalezienia
FDrive := Drive; // dysk
Start := GetTickCount; // pobierz czas staru (w milisekundach)
end;
destructor TSearchThread.Destroy;
begin
Stop := GetTickCount; // pobierz czas zakończenia
Total := Stop - Start; // odejmij czas startu i zakończenia
Total := Total / 1000; // podizel przez 1000, aby uzyskać liczbę sekund
{ wyświetl na komponencie czas wyszukiwania na danym dysku }
//glowna.lbEnd.Items.Add(FDrive + ':\ - ' + CurrToStr(Total) + ' sek.');
inherited;
end;
procedure TSearchThread.SearchInDrive;
procedure Search(StartDir : String);
var
SR, DR : TSearchRec;
Found, FoundFile : Integer;
{ ta procedura sprawdza, czy na końcu zmiennej znajduje się znak \ - jeżeli
tak to nie robi nic - jeżeli tego znaku brak - dodaje go... }
function IsDir(Value : String) : String;
begin
if Value[Length(Value)] <> '\' then // jeżeli na końcu znajdziesz znak
Result := Value + '\' else Result := Value; // dodaj go... w przeciwnym wypadku nie rób nic
end;
begin
Found := FindFirst(IsDir(StartDir) + '*.*', faDirectory, DR); // następuje pobieranie katalogów z podanej lokalizacji
while Found = 0 do // pętelka
begin
if ((DR.Attr and faDirectory) = faDirectory) and // sprawdza, czy pozycja jest katalogiem
((DR.Name <> '.') and (DR.Name <> '..')) then
begin
// glowna.StatusBar.SimpleText := IsDir(StartDir) + DR.Name + '\*.*'; // na komponencie wyświetl aktuanlie przesuzkiwany katalog
if Pos(FFileName, DR.Name) > 0 then // sprawdź, czy w nazwie jest szukany ciag znaków
glowna.log.lines.Add(IsDir(StartDir) + DR.Name);
{ pobierz na razie wszystkie pliki z danego katalogu - potem je zanalizujemy }
FoundFile := FindFirst(IsDir(StartDir) + DR.Name + '\*.*', faAnyFile, SR);
while FoundFile = 0 do
begin
if ((SR.Name <> '.') and (SR.Name <> '..')) then //
if Pos(FFileName, SR.Name) > 0 then // następuje sprawdzenie, czy plik nie zawiera części szukanego ciągu
glowna.log.lines.Add(IsDir(StartDir) + DR.Name + '\' + SR.Name);
FoundFile := FindNext(SR); // kontynuuj przeszukiwanie
end;
FindClose(SR); // zakończ
Search(IsDir(StartDir) + DR.Name); // tutaj następuje rekurencja
end;
Found := FindNext(DR); // kontynuuj
end;
FindClose(DR);
end;
begin
Search(FDrive + ':\'); // rozpocznij wyszukiwanie w danym dysku
end;
procedure TSearchThread.Execute;
begin
byles := byles + 1;
SearchInDrive; // wywołaj procedurę...
end;
procedure TSearchThread.MyOnTerminate(Sender: TObject);
begin
if byles = glowna.log.Lines.Count-1 then glowna.log.Lines.Add('STOP');
end;
procedure pobierzDyski(lista : TStrings);
var
bufor : PChar;
pozycjaWBuforze : PChar;
rozmiarBufora : integer;
begin
rozmiarBufora := GetLogicalDriveStrings(0, nil);
if rozmiarBufora = 0 then
exit;
GetMem(bufor, rozmiarBufora + 1);
try
if GetLogicalDriveStrings(rozmiarBufora, bufor) = 0 then
exit;
pozycjaWBuforze := bufor;
while pozycjaWBuforze^ <> #0 do
begin
lista.Add(pozycjaWBuforze);
pozycjaWBuforze := pozycjaWBuforze + StrLen(pozycjaWBuforze) + 1;
end;
finally
FreeMem(bufor);
end;
end;
procedure Tglowna.FormShow(Sender: TObject);
var
i, drivetype: integer;
begin
// pobierzdyski (dyski.Items);
for I := Ord('A') to Ord('Z') do
begin
DriveType := GetDriveType(PChar(Chr(i) + ':\')); // pobierz typ dysku
if not (DriveType = 0) and not (DriveType = 1) then
begin
if (DriveType = DRIVE_FIXED) then dyski.items.Add(chr(i) + ':\');
end;
end;
plik.SetFocus;
end;
procedure Tglowna.Button1Click(Sender: TObject);
var
i: integer;
begin
log.Clear;
for I := 0 to dyski.Items.Count-1 do
begin
SearchThread := TSearchThread.Create(plik.Text, dyski.Items.Strings[i][1]{Chr(i)}); // wywołaj wątek z literą dysku jako początkowy parametr
end;
end;
procedure Tglowna.Button2Click(Sender: TObject);
begin
label1.Caption := inttostr(log.Lines.Count);
end;
end.