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!