Wyłączający się wątek

Napisałem aplikację, która ma za zadanie "nasłuchiwać" zmian w bazie danych.
Jest funkcja, która uruchamia wątek:

  Randomize;
  JakisWatek:=TWatek.Create(False);

Procedury opisujące wątek wyglądają tak:

unit Watek;

interface

uses
  Classes, Windows, SysUtils, Dialogs;

type
  TWatek = class(TThread)
  private
    procedure SetName;
  protected
    procedure Execute; override;
  end;

implementation

uses Main;

type
  TThreadNameInfo = record
    FType: LongWord;     // must be 0x1000
    FName: PChar;        // pointer to name (in user address space)
    FThreadID: LongWord; // thread ID (-1 indicates caller thread)
    FFlags: LongWord;    // reserved for future use, must be zero
  end;

//------------------------------------------------------------------------------
procedure TWatek.SetName;
var
  ThreadNameInfo: TThreadNameInfo;
begin
  ThreadNameInfo.FType:=$1000;
  ThreadNameInfo.FName:='TWatek';
  ThreadNameInfo.FThreadID:=$FFFFFFFF;
  ThreadNameInfo.FFlags:=0;
  try
    RaiseException($406D1388,0,SizeOf(ThreadNameInfo) div sizeof(LongWord),@ThreadNameInfo);
  except
  end;
end;

//------------------------------------------------------------------------------
procedure TWatek.Execute;
var
  DataICzas: string;
  Sender: TObject;
begin
  LongTimeFormat := 'hh:mm:ss';
  SetName;
  while not Terminated do
  begin
    DataICzas:=DateToStr(Date)+' '+TimeToStr(Time);
    with f_main.l_data_godzina do
    begin
      Caption:=DataICzas;
      Update;
    end;
{tutaj inne funkcje}
    Sleep(1000);
  end;
end;

end.

Powyższy kod nie robi nic poza tym, że co sekundę uaktualnia "zegar" zrobiony ze zwykłego labela.
Przedtem w miejscu {tutaj inne funkcje} miałem kilka innych funkcji, które powodowały, że co 10 sekund był wykonywany select na bazie danych sprawdzający czy coś się w niej zmieniło, a jeśli się zmieniło, to wykonywał dalsze funkcje.
Wszystko fajnie działa, tylko nie wiedzieć czemu co jakiś czas (czasem co kilka godzin, czasem co kilkanaście godzin) wątek przerywa swoje działanie. Początkowo myślałem, że to chwilowy brak połączenia z bazą danych, więc zrobiłem obsługę błędu, że mimo braku połączenia z bazą wątek dalej działał i selecta robił później. Nic to nie zmieniło. Tak więc usuwałem kolejne funkcje aż do momentu, gdzie nawet nie sprawdza, czy minęło 10 sekund:

LongTimeFormat := 'ss';
if (
  (TimeToStr(Time)='00') or 
  (TimeToStr(Time)='10') or 
  (TimeToStr(Time)='20') or 
  (TimeToStr(Time)='30') or 
  (TimeToStr(Time)='40') or 
  (TimeToStr(Time)='50')
 ) then............

W końcu został taki "golas", jak powyżej wkleiłem, a mimo to nadal ten zegar zrobiony z labela czasem się zatrzymuje i muszę od nowa uruchamiać funkcję uruchamiającą wątek. Czy ktoś może domyśla się dlaczego?
Z góry dzięki za pomoc!

Czy ktoś może domyśla się dlaczego?

Mamy się domyślać? No to może dlatego że coś ten wątek ubija na przykład wyjątek.
Zrób sobie obsługę wyjątków, jakiś log który będzie logować czy wątek wychodzi przez exception czy przez żądanie Terminated=true. Jak umiesz użyć debuggera to możesz też go użyć, pewnie by ułatwił zadanie z parę razy.

1. co to za cudo i co ma na celu?

try
    RaiseException($406D1388,0,SizeOf(ThreadNameInfo) div sizeof(LongWord),@ThreadNameInfo);
  except
  end;

2. może byś tak np, PRZECZYTAŁ CO JEST W KOMENTARZU W NOWYM MODULE JAK DODAJESZ NOWĄ KLASĘ WĄTKU DO PROJEKTU! Pisze jak byk aby do synchronizacji z głównym wątkiem używać SYNCHRONIZE! Ludzie jak się za coś bierzecie to dowiedzcie się czegoś najpierw na ten temat!! Jak ci przyjdzie do głowy rozgrzebać np. piecyk gazowy w domu to weźmiesz młotek i będziesz w niego walił aż [CIACH!]?
3. OCZYWIŚCIE komponenty bazodanowe są thread-safe?

"Caption:=DataICzas"
stawiał bym że ta instrukcja powoduje "wywalenie" wątku

do zmiany właściowości komponentów VCL spróbuj użyć metody Synchronize

Przepraszam wszystkich, których uraziłem zadając takie pytanie oraz dziękuje tym, którzy mimo wszystko mi pomogli.
Przyznaję się bez bicia, że temat wątków, jako że nie był mi nigdy wcześniej, ani nigdy później (na razie) potrzebny, przeleciałem po łebkach i skopiowałem jakiś gotowiec, który ku mojej uciesze zadziałał. Zadziałał jednak tak, że po jakimś czasie okazało się, że się wiesza.
Oczywiście wystarczyło użyć funkcji Synchronize i póki co po kilku dniach testów, nie wiesza się już.
Niepotrzebna była też procedura SetName. Doczytałem gdzieś też, żeby dla bezpieczeństwa należy blokować płótno formularza, więc dopisałem te Canvas.Lock i Canvas.UnLock

Teraz wygląda to tak:

unit Watek;

interface

uses
  Classes, Windows, SysUtils, Dialogs;

type
  TWatek = class(TThread)
  private
    procedure Dzialaj();
  protected
    procedure Execute; override;
  end;

implementation

uses Main;

procedure TWatek.Execute;
var
  Sender: TObject;
begin
  LongTimeFormat := 'hh:mm:ss';
  while not Terminated do
  begin
    Sleep(1000);
    If f_main.Canvas.LockCount <> 0 Then
        Continue;
    Synchronize(Dzialaj);
  end;
end;

procedure TWatek.Dzialaj();
var
  DataICzas: string;
begin
    f_main.Canvas.Lock;
    f_main.Canvas.Refresh;
    DataICzas:=DateToStr(Date)+' '+TimeToStr(Time);
    with f_main.l_data_godzina do
    begin
      Caption:=DataICzas;
      Update;
    end;
    LongTimeFormat := 'ss';
    if ((TimeToStr(Time)='00') or (TimeToStr(Time)='10') or (TimeToStr(Time)='20') or
        (TimeToStr(Time)='30') or (TimeToStr(Time)='40') or (TimeToStr(Time)='50')) then
      f_main.wykonaj;
    LongTimeFormat := 'hh:mm:ss';
    f_main.Canvas.UnLock;
end;

end.

Jeszcze raz dzięki za pomoc i za cierpliwość.

    if ((TimeToStr(Time)='00') or (TimeToStr(Time)='10') or (TimeToStr(Time)='20') or
        (TimeToStr(Time)='30') or (TimeToStr(Time)='40') or (TimeToStr(Time)='50')) then

:|
To się kiedykolwiek spełnia?

Patryk27 napisał(a):

    if ((TimeToStr(Time)='00') or (TimeToStr(Time)='10') or (TimeToStr(Time)='20') or
        (TimeToStr(Time)='30') or (TimeToStr(Time)='40') or (TimeToStr(Time)='50')) then

:|
To się kiedykolwiek spełnia?

Tak. Sześć razy w ciągu jednej minuty :)

Tak. Sześć razy w ciągu jednej minuty :)

Jest to rozwiązanie niewydajne i do tego niezbyt logiczne.

DecodeTime

Po coś ta funkcja procedura chyba jest, prawda?

Doczytałem gdzieś też, żeby dla bezpieczeństwa należy blokować płótno formularza, więc dopisałem te Canvas.Lock i Canvas.UnLock
Albo Lock albo Synchronize, u Ciebie jednoczesne użycie nie ma sensu. Jeśli wątek zablokuje sobie Canvas metodą Lock to może po nim rysować bez konfliktów z innymi wątkami. Ty wykorzystujesz tylko jeden wątek do rysowani, główny (przez Synchronize), więc Lock jest zbędny.

Z tym że nadal potrzebujesz Synchronize gdyż oprócz rysowania zmieniasz również Caption i wywołujesz Update, a te muszą być wywołane w wątku głównym.

Czyli powinno to wyglądać tak?

unit Watek;
 
interface
 
uses
  Classes, Windows, SysUtils, Dialogs;
 
type
  TWatek = class(TThread)
  private
    procedure Dzialaj();
  protected
    procedure Execute; override;
  end;
 
implementation
 
uses Main;
 
procedure TWatek.Execute;
var
  Sender: TObject;
begin
  LongTimeFormat := 'hh:mm:ss';
  while not Terminated do
  begin
    Sleep(1000);
    Synchronize(Dzialaj);
  end;
end;
 
procedure TWatek.Dzialaj();
var
  DataICzas: string;
begin
    DataICzas:=DateToStr(Date)+' '+TimeToStr(Time);
    with f_main.l_data_godzina do
    begin
      Caption:=DataICzas;
      Update;
    end;
    LongTimeFormat := 'ss';
    if ((TimeToStr(Time)='00') or (TimeToStr(Time)='10') or (TimeToStr(Time)='20') or
        (TimeToStr(Time)='30') or (TimeToStr(Time)='40') or (TimeToStr(Time)='50')) then
      f_main.wykonaj;
    LongTimeFormat := 'hh:mm:ss';
end;
 
end.

O DecodeTime doczytam :)

Jest jeszcze jeden problem z twoim kodem. Chcesz co 10 sekund wykonać f_main.wykonaj. Robisz to w ten sposób, że pobierasz aktualny czas i sprawdzasz, czy to n-dziesiąta sekunda. Źle.

TTimer tyka w przybliżeniu co jedną sekundę.
Sleep(1000) zatrzymuje wątek w przybliżeniu na jedną sekundę. Oprócz "czekania" wątek robi też inne rzeczy które zajmują czas.

Będą występować dłuższe przerwy niż jedna sekunda. Więc będzie się zdarzać tak, że jedno tyknięcie nastąpi w sekundzie np. 19-tej a kolejne w sekundzie 21-szej. Nie będzie tyknięcia w sekundzie 20-tej.

adf88 napisał(a):

Jest jeszcze jeden problem z twoim kodem. Chcesz co 10 sekund wykonać f_main.wykonaj. Robisz to w ten sposób, że pobierasz aktualny czas i sprawdzasz, czy to n-dziesiąta sekunda. Źle.

TTimer tyka w przybliżeniu co jedną sekundę.
Sleep(1000) zatrzymuje wątek w przybliżeniu na jedną sekundę.

Będą zdarzać się się dłuższe przerwy w kolejnych tyknięciach. Więc będzie się zdarzać tak, że jedno tyknięcie nastąpi w sekundzie np. 19-tej a kolejne w sekundzie 21-szej. Nie będzie tyknięcia w sekundzie 20-tej.

Pewnie masz rację, ale akurat w moim przypadku to nie jest wielki problem, jeśli w którejś minucie zamiast 6 razy wykonać funkcję "f_main.wykonaj" wykona ją tylko 5 razy. Tak czy tak pod funkcją "f_main.wykonaj" kryje się taki kod, który czasem jest w stanie zatrzymać działanie programu na kilkadziesiąt sekund (odpytuję bazę danych i jeśli pojawiły się nowe "zapytania", to tworzy plik XML, loguje się przez WebServices, wysyła tego XMLa, czeka na odpowiedź, odbiera XMLs i aktualizuje bazę danych). Tak więc może się nawet zdarzyć, że program w ciągu jednej minuty wykona funkcję "f_main.wykonaj" na przykład tylko dwa razy.