Sprawdzenie czy wątek jeszcze pracuje/zakończył się

0

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. 
0

Jeżeli masz FreeOnTerminate na True sprawdzenie właściwości Terminated nie wchodzi w grę... (Access Violation jeżeli obiekt już nie istnieje) takie rozwiązanie jest z d..y wzięte.
Albo tworzysz watek początkowo (CreateSuspended na True) zawieszony i zapamiętujesz w zmiennej jego Handle i wtedy za pomocą funkcji WinApi GetExitCodeThread możesz sprawdzić czy wątek jest aktywny albo bez FreeOnTerminate wtedy masz dostępną właściwość Terminated.

0

@kAzek dobrze, więc umieściłem w komentarz FreeOnTerminate := true; a w zdarzeniu MyOnTerminate() wrzuciłem kod:

procedure TSearchThread.MyOnTerminate(Sender: TObject);
begin
//    if byles = glowna.log.Lines.Count-1 then glowna.log.Lines.Add('STOP');
  if SearchThread.Terminated = true then glowna.log.Lines.Add('STOP');
end;

Jednak po zakończeniu wyszukiwania w komponencie log nic się nie pojawiło.

0

Zobacz przykładowy kod i jak on działa. Terminated będzie równe True tylko wtedy jeżeli przerwiesz wątek przez metodę Terminate. Ale więcej podpowiedzieć moze pewnie @kAzek.

Ogólnie to wiem ze swojego doświadczenia, że na przykład pewną swoją aplikację w WinAPI do porównywania zawartości dwóch plików o takim samym rozmiarze i tworzącej loga w pliku txt z różnicami bajtów, a którą pomagał mi udoskonalać MisiekD gdy jeszcze udzielał się na tym forum. To we wszystkie możłiwe miejsca rzeczy dziejącej się w pętli repeat aż do przeksanowania pliku lub do anulowania były dodatkowo wstawione sprawdzenia zmiennej boolean która wskazywała czy wątek przerwano.

Ale to było pod WinAPI, tutaj myślę, że po każdej instrukcji wyszukiwania należało by dawać sprawdzenie czy wątek jest Terminated. I jeśli tak stosować Break lub Exit. A w przypadku Exit wcześniej zamykać uchwyty do wyszukania. Tutaj wyszukanie masz poprzez VCL, ale ja wolę wyszukiwać funkcjami WinAPI ze względu na problemy z faAnyFile pod Delphi 7.

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

type
  TMyThread = class(TThread)
  private
    procedure MyOnTerminate(Sender : TObject);
  public
    constructor Create;
  protected
    procedure Execute; override;
  end;

type
  TForm1 = class(TForm)
    Button1 : TButton;
    Button2 : TButton;
    Button3 : TButton;
    procedure Button1Click(Sender : TObject);
    procedure Button2Click(Sender : TObject);
    procedure Button3Click(Sender : TObject);
  private
  public
  end;

var
  Form1 : TForm1;
  Thr : TMyThread;

implementation

{$R *.dfm}

procedure SMsg(Text : string);
begin
  MessageBox(Application.Handle, PChar(Text), PChar(Application.Title), MB_OK);
end;

procedure TMyThread.MyOnTerminate(Sender : TObject);
begin
  if Terminated then
  begin
    SMsg('TERMINATED');
  end
  else
  begin
    SMsg('END');
  end;
end;

constructor TMyThread.Create;
begin
  inherited Create(False);
  OnTerminate := MyOnTerminate;
end;

procedure TMyThread.Execute;
var
  I : integer;
begin
  for I := 1 to 300 do
  begin
    Sleep(10);
    if Terminated then
    begin
      Break;
    end;
  end;
end;

procedure TForm1.Button1Click(Sender : TObject);
begin
  Thr := TMyThread.Create;
end;

procedure TForm1.Button2Click(Sender : TObject);
begin
  if Thr <> nil then
  begin
    Thr.Terminate;
  end;
end;

procedure TForm1.Button3Click(Sender : TObject);
var
  Crd : Cardinal;
begin
  if Thr <> nil then
  begin
    GetExitCodeThread(Thr.Handle, Crd);
    SMsg(IntToStr(Crd));
  end;
end;

end.
2

ale po co tak to wszystko gmatwacie?
Wątek ma właściwość OnTerminate, która jest wywoływana po zakończeniu wątku a przed jego zwolnieniem - wystarczy się podpiąć.
Przykład:

Form1 = TForm1
  procedure btnStartClick(Sender: TObject);
private
  FRunningThread: Integer;

  procedure ThreadTerminate(Sender: TObject);
//...
end;

procedure TForm1.btnStartClick(Sender: TObject);
begin
  Inc(FRunningThread);
  with TThread.Create(False) do
    OnTerminate := ThreadTerminate;
end;

procedure TForm1.ThreadTerminate(Sender: TObject);
begin
  Dec(FRunningThread);
end;

i w FRunningThreadmasz liczbę uruchomionych wątków

BTW w swoim kodzie masz OnTerminate := MyOnTerminate; co jest zbędne i nielogiczne - po co podpinasz się pod własne zdarzenie? To jest aby poinformować świat poza własną klasą o czymś.

BTW2 to

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;

powinno być tak

constructor TSearchThread.Create(Const FileName : String; Drive : Char);
begin
  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)
  inherited Create(False); // wywołanie konstruktora klasy bazowej
end;

bo NAJPIERW musisz dać wątkowi dane na których pracuje a dopiero potem go uruchomić

<font color="red">BTW3 a tak w ogóle to i tak całe to szukanie prędzej czy później się wysypie bo gmerasz w wątku głównym z wątku pobocznego.</span>

BTW4 wiesz, że tu FoundFile := FindFirst(IsDir(StartDir) + DR.Name + '\*.*', faAnyFile, SR); możesz podać maskę (np. taką *FFileName*) zamiast *.* i dostaniesz OD RAZU tylko szukane pliki :p

1 użytkowników online, w tym zalogowanych: 0, gości: 1