Rozdział 5

Aplikacje wielowątkowe

Jedną z najważniejszych cech 32-bitowej platformy Windows jest obsługa aplikacji wielowątkowych. Umożliwia wykorzystanie wszelkich zalet programowania współbieżnego, upraszcza proces programowania i generalnie czyni aplikacje łatwiejszymi w obsłudze. W 16-bitowych wersjach Windows nie było wielowątkowości, dlatego jest ona jednym z głównych czynników przemawiających za przenoszeniem aplikacji z Delphi 1 do wyższych, 32-bitowych wersji. W niniejszym rozdziale opiszemy mechanizmy Win32 API służące do realizacji aplikacji wielowątkowych oraz elementy Delphi stanowiące odzwierciedlenie tych mechanizmów; przy okazji przedstawimy ograniczenia związane z programowaniem współbieżnym w Delphi i postaramy się uzasadnić ich przyczyny.

Natura wątków

Wątek (thread) jest obiektem syste­mu operacyjnego, reprezentującym wydzieloną część kodu w ramach procesu. Każda aplikacja Win32 posiada przynajmniej jeden wątek zwany wątkiem głównym albo wątkiem pierwotnym (primary thread, default thread); aplikacja może także posiadać inne wątki, zwane wątkami pobocznymi lub drugorzędnymi (secondary threads).

Mechanizm wątków pozwala na niezależną, jednoczesną realizację wielu różnych funk­cji aplikacji; jednoczesność ta jednak jest pozorna, gdyż w rzeczywistości polega to na szybkim przełączaniu procesora między poszczególnymi wątkami — na tyle szybkim, iż sprawia wrażenie realizacji jednoczesnej (chyba że komputer wyposażony jest w kilka procesorów, ale to już zupełnie inna sprawa).

Wskazówka

Wielowątkowość jest cechą środowiska 32-bitowego — nie istnieje ona (i nigdy nie będzie istnieć) w 16-bitowych wersjach Windows. Wielowątkowe aplikacje tworzone w Delphi nigdy nie będą więc kompatybilne z Delphi 1.

Rodzaje wielozadaniowości

Wielozadaniowość z wykorzystaniem wątków jest czymś zgoła innym niż wielozada­niowość (a właściwie jej namiastka) w 16-bitowym środowisku Windows 3.x. W ramach Windows 3.x możliwe jest jednoczesne uruchamianie wielu aplikacji, trudno jednak mówić o całkowitym ich podporządkowaniu systemowi operacyjnemu. Aplikacja, otrzy­mawszy od systemu sterowanie, zyskuje tym samym kontrolę nad czasem procesora i mo­że go zawłaszczyć do woli; takie zawłaszczenie — rozmyślne lub niezamierzone, np. na skutek zapętlenia, zawsze paraliżuje pracę systemu, a często prowadzi do jego załama­nia. Od aplikacji 16-bitowej wymaga się więc przestrzegania pewnych zasad współpracy z innymi aplikacjami; z tego względu wielozadaniowość Windows 3.x została nazwana wielozadaniowością kooperacyjną (cooperative multitasking).

W Win32 wielozadaniowość ma całkowicie odmienny charakter. Obiektami ubiegającymi się o czas procesora są nie zadania, lecz właśnie wątki, nie to jest jednak najważniejsze: znacznie istotniejsza jest niemożność zmonopolizowania czasu procesora przez pojedynczy wątek. Otrzymuje on jedynie kwant czasu, po wykorzystaniu którego jest po prostu wywłaszczany (bez ostrzeżenia) przez system operacyjny. Mamy więc do czynienia z sytuacją, kiedy to system operacyjny ustala reguły gry, przydzielając czas poszczególnym wątkom i odbierając im sterowanie, gdy uzna to za stosowne; tego typu wielozadaniowość została nazwana wielozadaniowością z wywłaszczaniem (preemptive multitasking).

Do czego może się przydać wielowątkowość?

Możliwość podziału aplikacji na niezależne wątki jest dla programisty (nie tylko w Win­dows) niezwykle atrakcyjna, i to z wielu względów. Zalety wielowątkowości stają się szczególnie widoczne w przypadku, gdy aplikacja wykonuje jedną lub kilka akcji „w tle”, niezależnie od dialogu, który jednocześnie prowadzi z użytkownikiem w ramach swego interfejsu. Dobrym tego przykładem może być obliczanie wartości komórek arkusza kal­kulacyjnego równolegle z wprowadzaniem nowych danych lub — coraz powszechniej­sze — drukowanie wyników aplikacji równolegle z innymi jej działaniami. Projektant aplikacji może się skupić na dialogu z użytkownikiem uznając, że cała reszta zostanie „załatwiona” w ramach innych wątków. Zresztą — tak bardzo pożądana w procesie pro­jektowania — metoda dekompozycji problemów daje się bardzo łatwo zrealizować właśnie dzięki wielowątkowości; można więc powierzyć poszczególne aspekty aplikacji poszcze­gólnym jej wątkom, opracowywanym niezależnie od siebie, z uwzględnieniem jedynie niezbędnej synchronizacji (o czym będziemy pisać w dalszej części rozdziału).

Wielowątkowość a komponenty VCL

Tak się jednak składa, iż większa część biblioteki VCL nie jest „bezpieczna wątkowo” (thread-safe) — przy jej tworzeniu przyjęto bowiem założenie, iż w danej chwili dostęp do komponentów ma co najwyżej jeden wątek. Ograniczenie to dotyczy w większości komponentów tworzących interfejs użytkownika, chociaż wiele innych komponentów także nie jest przystosowanych do dostępu wielowątkowego. Dla niektórych z nich VCL udostępnia „wielowątkowe alternatywy” — na przykład TThreadList jest bezpieczną wątkowo odmianą komponentu TList. Przykładem mechanizmu przystosowanego do wielowątkowości jest natomiast strumieniowanie komponentów — dopuszcza się odczyt (lub zapis) strumieni (np. plików .DFM) jednocześnie przez kilka wątków.

W stosunku do komponentów tworzących interfejs użytkownika obowiązuje w VCL zastrzeżenie, iż ich obsługa może się odbywać jedynie w kontekście wątku głównego aplikacji — ważnym wyjątkiem od tej zasady jest obiekt płótna (Canvas), który posiada wbudowane mechanizmy obsługi wielowątkowej. Nie oznacza to oczywiście całkowitego odizolowania wątków pobocznych od komponentów, ponieważ Delphi udostępnia narzędzia umożliwiające modyfikowanie interfejsu użytkownika w kontekście wątku głównego, lecz z inicjatywy wątków pobocznych. Nie zmienia to jednak faktu, iż w warunkach aplikacji wielowątkowej obsługa interfejsu użytkownika musi być zrealizowana szczególnie starannie.

Błędne wykorzystanie wielowątkowości

Nadmiar dobrego czasami przeobraża się w zło; ta zasada ma zastosowanie również w odniesieniu do wąt­ków Win32 API. Choć podział aplikacji na niezależne wątki uwalnia programistę od wielu problemów, to jednocześnie przysparza mu wielu nowych kłopotów — tyle że innego rodzaju.

Przede wszystkim krytyczny staje się problem synchronizacji dwóch lub kilku wątków wykorzystujących te same zasoby. Wyobraź sobie wprowadzanie zmian do tekstu pro­gramu, który właśnie jest kompilowany: jeśli kompilator i edytor nie są nawzajem świa­dome swoich skutków, to taka sytuacja przypomina przestawienie zwrotnicy pod prze­jeżdżającym pociągiem. W tym szczególnym przypadku środki zaradcze są niemal banalne: można na przykład zablokować możliwość zmian w module na czas jego kom­pilacji, można też utworzyć kopię modułu i potraktować ją jako wejście dla kompilatora (jednak na czas kopiowania też trzeba zablokować edycję), można wreszcie śledzić po­stęp kompilacji (w przypadku kompilatorów jednoprzebiegowych) i umożliwić edycję tylko tej części tekstu, która została już skompilowana. Konkretne rozwiązanie nie jest tu istotne, ważne jest, aby nie traktować wielowątkowości jako panaceum na dotychczasowe problemy towarzyszące klasycznemu programowaniu sekwencyjne­mu. Programowanie współbieżne, oferując ogromne możliwości i rozwiązując proble­my, których rozwiązanie w ramach dotychczasowych środków mogło być jedynie poło­wiczne (lub żadne — bywa i tak), kryje jednocześnie wiele zdradliwych pułapek, gdy korzystamy z niego w niewłaściwy sposób.

Klasa TThread

Podstawową klasą Delphi, implementującą mechanizmy charakterystyczne dla wątków, jest klasa TThread. Chociaż jej właściwości i metody uwzględniają większość aspek­tów wielowątkowości (również tych specyficznych dla Delphi), to jednak w wielu wypad­kach (jak później zobaczymy) konieczne stają się bezpośrednie odwołania do Win32 API: najbardziej oczywistym tego przykładem są mechanizmy synchronizacji wątków, o której przed chwilą wspominaliśmy. Obecnie skoncentrujmy się jednak na samej klasie TThread; jej deklaracja, prezentowana poniżej, znajduje się w module Classes.pas.

TThread = class

private

FHandle: THandle;

{$IFDEF MSWINDOWS}

FThreadID: THandle;

{$ENDIF}

{$IFDEF LINUX}

// ** FThreadID is not THandle in Linux **

FThreadID: Cardinal;

FCreateSuspendedSem: TSemaphore;

FInitialSuspendDone: Boolean;

{$ENDIF}

FCreateSuspended: Boolean;

FTerminated: Boolean;

FSuspended: Boolean;

FFreeOnTerminate: Boolean;

FFinished: Boolean;

FReturnValue: Integer;

FOnTerminate: TNotifyEvent;

FMethod: TThreadMethod;

FSynchronizeException: TObject;

FFatalException: TObject;

procedure CheckThreadError(ErrCode: Integer); overload;

procedure CheckThreadError(Success: Boolean); overload;

procedure CallOnTerminate;

{$IFDEF MSWINDOWS}

function GetPriority: TThreadPriority;

procedure SetPriority(Value: TThreadPriority);

procedure SetSuspended(Value: Boolean);

{$ENDIF}

{$IFDEF LINUX}

// ** Priority is an Integer value in Linux

function GetPriority: Integer;

procedure SetPriority(Value: Integer);

function GetPolicy: Integer;

procedure SetPolicy(Value: Integer);

procedure SetSuspended(Value: Boolean);

{$ENDIF}

protected

procedure DoTerminate; virtual;

procedure Execute; virtual; abstract;

procedure Synchronize(Method: TThreadMethod);

property ReturnValue: Integer read FReturnValue write FReturnValue;

property Terminated: Boolean read FTerminated;

public

constructor Create(CreateSuspended: Boolean);

destructor Destroy; override;

procedure AfterConstruction; override;

procedure Resume;

procedure Suspend;

procedure Terminate;

function WaitFor: LongWord;

property FatalException: TObject read FFatalException;

property FreeOnTerminate: Boolean read FFreeOnTerminate write FFreeOnTerminate;

property Handle: THandle read FHandle;

{$IFDEF MSWINDOWS}

property Priority: TThreadPriority read GetPriority write SetPriority;

{$ENDIF}

{$IFDEF LINUX}

// ** Priority is an Integer **

property Priority: Integer read GetPriority write SetPriority;

property Policy: Integer read GetPolicy write SetPolicy;

{$ENDIF}

property Suspended: Boolean read FSuspended write SetSuspended;

{$IFDEF MSWINDOWS}

property ThreadID: THandle read FThreadID;

{$ENDIF}

{$IFDEF LINUX}

// ** ThreadId is Cardinal **

property ThreadID: Cardinal read FThreadID;

{$ENDIF}

property OnTerminate: TNotifyEvent read FOnTerminate write FOnTerminate;

end;

Jak widać, klasa TThread jest bezpośrednim potomkiem klasy TObject, więc obiekt klasy TThread nie jest komponentem i nie znajdziemy go w palecie komponentów. Liczne dyrektywy $IFDEF w deklaracji klasy świadczą o tym, iż jest ona klasą uniwersalną w sensie zgodności z Delphi i z Kyliksem. Na uwagę zasługuje także fakt, iż metoda Execute(), realizująca wątek w sensie fizycznym, jest metodą abstrakcyjną; oznacza to, iż abstrakcyjna jest cała klasa TThread, a więc w konkretnej aplikacji musimy posługiwać się jej klasami pochodnymi, przedefiniowującymi metodę Execute() stosownie do specyfiki poszczególnych wątków.

Najprostszym sposobem utworzenia nowej klasy wątku jest wybranie pozycji Thread Object z karty New okna New Items (rys. 5.1):

Rysunek 5.1. Definiowanie nowego wątku za pomocą repozytorium

Po wybraniu obiektu Thread Object Delphi wyświetli pytanie o nazwę tworzonej klasy; przyjmijmy, iż jest nią TTestThread. Po wprowadzeniu nazwy Delphi utworzy nowy moduł zawierający deklarację nowej klasy z przedefiniowaną metodą Execute():

type

TTestThread = class(TThread)

private

{ Private declarations }

protected

procedure Execute; override;

end;

Nie siląc się w tym momencie na jakiś wyrafinowany przykład, uczyńmy treścią tej metody jakieś proste obliczenia, na przykład takie:

procedure TTestThread.Execute;

var

k: integer;

begin

for k := 1 to 2000000 do

Inc( Answer, Round(Abs(Sin(Sqrt(k)))));

end;

Umieśćmy teraz na formularzu przycisk, którego kliknięcie spowoduje utworzenie obiektu zdefiniowanej klasy wątku:

procedure TForm1.Button1Click(Sender: TObject);

var

NewThread: TTestThread;

begin

NewThread := TTestThread.Create(False);

end;

Pojedynczy parametr wywołania konstruktora klasy wątkowej określa sposób postępowania z utworzonym obiektem wątku; jeżeli ma wartość False, wątek jest automatycznie uruchamiany, w przeciwnym razie wątek ten pozostaje w stanie zawieszenia — jego uruchomienie nastąpi dopiero w wyniku wywołania metody Resume(). Ta druga możliwość daje okazję do zmodyfikowania niektórych właściwości obiektu wątkowego przed jego uruchomieniem. Modyfikowanie działającego wątku jest w wielu przypadkach nieskuteczne, często też daje efekty różne od zamierzonych.

Możliwość wstrzymywania zawieszonego wątku nie jest cechą Delphi, lecz Win32; wstrzymanie takie następuje wówczas, gdy tworząca nowy wątek funkcja CreateThread() wywołana zostaje z parametrem CREATE_SUSPENDED.

W procedurze TForm1.Button1Click parametr wywołania konstruktora ma wartość False, zatem tworzony wątek jest automatycznie uruchamiany. Łatwo się wówczas przekonać, iż funkcjonowanie wątku pobocznego w niczym nie blokuje możliwości manipulowania formularzem — jego przemieszczania, minimalizacji, maksymalizacji, zmiany rozmiarów itp.

Obiekty wątków a zmienne

Przyjrzyjmy się zmiennej lokalnej k w procedurze TTestThread.Execute() i zastanówmy się, co się stanie w przypadku równoległej pracy kilku egzemplarzy wątku TTestThread: czy będą one wspólnie wykorzystywać tę zmienną, co, rzecz jasna, musiałoby doprowadzić do nieprzewidywalnych wyników? Czy może dostęp do niej bę­dzie się odbywał według jakichś priorytetów? Nic z tych rzeczy: każdy wątek posiada własny, oddzielny obszar stosu, a ponieważ zmienne lokalne umieszczane są właśnie na stosie, każdy wątek będzie się posługiwał własną, oddzielną kopią zmiennej k.

Jednak zupełnie inaczej rzecz się ma ze zmiennymi globalnymi; ich rozłączność musi być zapewniona za pomocą specjalnych środków, które opisze­my w dalszej części rozdziału.

Kończenie wątku

Zasadnicza akcja wątku reprezentowanego przez obiekt klasy wątkowej rozgrywa się w ramach metody Execute(), toteż jej zakończenie równoważne jest zakończeniu sa­mego wątku. Po zakończeniu wątku wywoływana jest funkcja Delphi o nazwie EndThread(), wywołująca z kolei funkcję API ExitThread() zwalniającą przydzielony do wątku stos i związany z wątkiem obiekt Win32.

Należy także zadbać o zwolnienie obiektu klasy wątkowej w Delphi. Zwróć uwagę, iż zwykłe wywołanie jego metody Free() nie jest sprawą łatwą, ponieważ należałoby uchwycić moment kończenia wątku; jest to możliwe dzięki zdarzeniu OnTerminate, w ramach którego można tę metodę wywołać. Delphi oferuje jednak jeszcze wygodniejsze rozwiązanie tego problemu: otóż ustawiając na True właściwość FreeOnTerminate obiektu wątkowego, zapewniamy jego automatyczne zwolnienie po zakończeniu wątku. Najbardziej odpowiednim miejscem do ustawienia wspomnianej właściwości jest oczywiście początek samej metody Execute():

procedure TTestThread.Execute;

var

k: integer;

begin

FreeOnTerminate := True;

for k := 1 to 2000000 do

Inc( Answer, Round(Abs(Sin(Sqrt(k)))));

end;

Wskazówka

Obsługa zdarzenia OnTerminate odbywa się zawsze w kontekście wątku głównego aplikacji, a więc w ramach procedury zdarzeniowej dopuszczalne jest bezpośrednie manipulowanie komponentami VCL, bez konieczności posiłkowa­nia się metodą Synchronize(). Powrócimy do tego zagadnienia w dalszej części rozdziału.

Ponadto, zgodnie z przyjętą w Delphi konwencją, metoda Execute() powinna jak naj­częściej sprawdzać wartość właściwości Terminate. Po stwierdzeniu, że właściwość ta ma wartość True, metoda Execute() powinna jak najszybciej zakończyć swą pracę. Oto przykład rozwiązania czyniącego zadość temu wymaganiu:

procedure TTestThread.Execute;

var

k : integer;

begin

FreeOnTerminate := TRUE;

For k := 1 to 2000000 do

begin

if Terminated

Then

Break;

Inc(Answer, Round(Abs(Sin(Sqrt(k))));

end;

end;

Na pierwszy rzut oka może to wyglądać na dodatkowe utrudnienie, jednak po chwilowym za­stanowieniu okazuje się być dość istotną zaletą: wątek główny, chcąc wymusić zakończenie wątku drugorzędnego, nie czyni tego bez ostrzeżenia, przysłowiowym „strzałem w plecy”, lecz in­formuje go o swych zamiarach, ustawiając na True właściwość Terminate. Takie postępowanie daje szansę wątkowi drugorzędnemu na wykonanie specyficznych dla nie­go funkcji związanych z zakończeniem pracy, na przykład zamknięcie plików, czy też zwolnienie zarezerwowanych obszarów pamięci operacyjnej.

Ostrzeżenie:

Zdarza się jednak, że wątek drugorzędny nie „przejmuje się” zbytnio wartością właściwości Terminate i jego zakończenie należy po prostu wymusić. Służy do tego funkcja API TerminateThread():

function TerminateThread(hThread: THandle; dwExitCode:DWORD): Boolean;

Pierwszy parametr jest tu uchwytem odnośnego wątku, dostępnym w polu Handle obiektu wątkowego, drugi natomiast określa kod zakończenia wątku.

TerminateThread() jest funkcją bardzo niebezpieczną i powinna być stosowana tylko w ostateczności. „Siłowe” zakończenie wątku odbywa się przy całkowitej jego nieświadomości, nie ma więc on możliwości wykonania żadnych czynności kończących (nawet jeżeli treść wątku ujęta jest w ramy konstrukcji try…finally). W szczególności, jeżeli dany wątek wykony­wał jakąś sekcję krytyczną, pozostanie ona zablokowana przez cały czas realiza­cji procesu. Poza tym zakończenie wątku odbywa się bez wiedzy wykorzystywa­nych przez niego bibliotek DLL (nie jest wywoływana ich procedura inicjująco-kończąca z parametrem DLL_THREAD_DETACH). Wreszcie, jeżeli w ramach koń­czonego wątku wykonywana była jakaś funkcja jądra systemu, może ono pozo­stać w stanie nieokreślonym dla wszystkich pozostałych wątków procesu.

Dodatkowo, w Windows NT/2000 obszar stosu przydzielony do wątku nie jest zwal­niany i jest obszarem straconym do końca realizacji procesu (w Windows 95/98/Me funkcja TerminateThread() zwalnia stos przydzielony dla wątku).

Synchroniczne wykorzystywanie komponentów VCL

Jak już wspominaliśmy, dostęp do komponentów VCL może odbywać się zasadniczo tylko w ramach wątku głównego procesu. Pewna uciążliwość takiego wymogu wydaje się oczywista, przedstawimy więc teraz drugą stronę tego medalu.

Zalety jednowątkowego interfejsu użytkownika

Win32 API wymaga dla każdego wątku osobnego okna głównego oraz związanej z nim funkcji GetMessage(), odpowiedzialnej za obsługę komunikatów. Gdyby więc dopu­ścić równoprawny dostęp do komponentów VCL ze strony wszystkich wątków, łatwo przewidzieć, jak skomplikowałoby się wykorzystywanie biblioteki VCL w aplikacji, a co za tym idzie — sama aplikacja. Z uwagi na serializację obsługi komunikatów — każdy z nich pobierany jest z pojedynczej kolejki i przetwarzany w sposób kompletny przed pobraniem następnego — zachowanie się aplikacji byłoby uzależnione od kolejności przybywania poszczególnych komunikatów do kolejki. Znalezienie ewentualnego błędu w tak skomplikowanych warunkach byłoby znacznie trudniejsze niż w aplikacji jednowątkowej.

Aby zapobiec opisanym trudnościom, należałoby wyposażyć bibliotekę VCL w mechanizmy synchronizujące dostęp do komponentów ze strony poszczególnych wątków; jest ona jednak takich mechanizmów pozbawiona, stąd ograniczenie dostępu do komponentów wyłącznie dla wątku głównego.

Metoda Synchronize()

Istnieje jednak pewna „furtka”, pozwalająca wątkom drugorzędnym na dostęp do kom­ponentów wykorzystywanych przez aplikację. Jest nią możliwość wykonywania wybranej metody wątku drugorzędnego w kontekście wątku głównego procesu. Zadanie to wykonuje metoda Synchronize()klasy wątkowej określona następująco:

procedure Synchronize(Method: TThreadMethod);

Jedynym parametrem jej wywołania jest wybrana metoda obiektu, która ma być wyko­nana w kontekście wątku głównego; jak wynika z deklaracji, musi być ona bezparametrową procedurą:

Type

TThreadMethod = procedure of object;

Powróćmy do naszego przykładu — wątku wykonującego czasochłonne sumowanie. Tajemnicza zmienna Answer, występująca w procedurze Execute(), jest po prostu prywatnym polem testowego obiektu wątkowego. Po zakończeniu sumowania chcielibyśmy wyświetlić jej zawartość w określonym polu formularza (Edit1.Text), jednak w świe­tle tego, co dotychczas napisaliśmy, wydaje się to niemożliwe, gdyż wątek drugorzęd­ny nie posiada dostępu do komponentów aplikacji. Wyjściem z tej sytuacji jest oczywiście zmiana właściwości komponentu Edit1 w ramach metody wykonywanej w kontekście wątku głównego; na prezentowanym poniżej wydruku metodą tą jest GiveAnswer().

Wydruk 5.1. Przykład wykorzystania metody Synchronize()

unit ThrdU;

interface

uses

Classes;

type

TTestThread = class(TThread)

private

Answer: integer;

protected

procedure GiveAnswer;

procedure Execute; override;

end;

implementation

uses SysUtils, Main;

{ TTestThread }

procedure TTestThread.GiveAnswer;

begin

MainForm.Edit1.Text := InttoStr(Answer);

end;

procedure TTestThread.Execute;

var

k: Integer;

begin

FreeOnTerminate := True;

for k := 1 to 2000000 do

begin

if Terminated

then

Break;

Inc(Answer, Round(Abs(Sin(Sqrt(k)))));

Synchronize(GiveAnswer);

end;

end;

end.

Przyjrzyjmy się bliżej działaniu metody Synchronize(). Podczas każdorazowego two­rzenia nowego wątku, procedury biblioteki VCL tworzą dla tego wątku ukryte okno (thread window), obsługiwane w kontekście wątku głównego; jego jedynym przeznaczeniem jest właśnie współpraca z procedurą Synchronize(). Procedura ta, jako metoda obiektu, zapisuje w jego polu FMethod swój jedyny parametr i wysyła pod adresem wspomnianego przed chwilą okna komunikat CM_EXEPROC (zdefiniowany w ramach biblioteki VCL); w jego polu lParam przekazywany jest adres obiektu wątkowego (Self). Procedura komunikacyjna okna, otrzymawszy wspomniany komunikat, wywołuje wskazaną metodę wątku (Self.FMethod); odbywa się to oczywiście w kontekście wątku głównego. Opisany scenariusz został zilu­strowany schematycznie na rysunku 5.2.

Rysunek 5.2. Schemat działania metody TThread.Synchronize

Wykorzystanie komunikatów do synchronizacji wątków

Alternatywą dla metody Synchronize() może być zupełne powstrzymanie wąt­ku drugorzędnego od wykonywania jakichkolwiek procedur operujących na komponen­tach VCL i ograniczenie jego roli do przekazywania wątkowi głównemu (lub bezpośrednio — komponentom formularza) jedynie komunikatów stanowiących polecenie wykonania od­powiednich czynności. Oto przykład wysłania komunikatu bezpośrednio do kontrolki edycyjnej SomeEdit:

var

S: String;

begin

S := 'Pozdrowienia z wątku drugorzędnego';

SendMessage(SomeEdit.Handle, WM_SETTEXT, 0, Integer(PChar(S)));

end;

Przesyłany komunikat WM_SETTEXT stano­wi tu polecenie zmiany tekstu reprezentowanego przez kontrolkę, ukrywającego się (w Delphi) pod właściwością Text. Adres nowej zawartości (którą jest łańcuch z zerowym ogranicznikiem) przekazywany jest w polu lParam komunikatu.

Przykładowa aplikacja wielowątkowa

Kompletnym przykładem aplikacji, która wykorzystuje wątek drugorzędny, jest projekt EzThrd.dpr, znajdujący się na załączonym krążku CD-ROM. Wykorzystuje on prezentowany przed chwilą moduł ThrdU.pas, zawiera­jący definicję klasy TTestThread. Obsługa komponentu Memo1 odbywa się całkowi­cie w ramach wątku głównego.

Formularz projektu jest przedstawiony na rysunku 5.3. Kliknięcie przycisku Start spowoduje uruchomienie wątku pobocznego, wykonującego sumowanie. W polu Odpowiedź wyświetlana jest poprawnie tymczasowa wartość sumy; zaś samo sumowanie w niczym nie koliduje z wprowadzaniem tekstu do Memo.

Rysunek 5.3. Formularz przykładowej aplikacji wielowątkowej

Kod źródłowy modułu formularza przedstawia wydruk 5.2.

Wydruk 5.2. Moduł główny aplikacji ilustrującej synchroniczny dostęp do komponentów VCL

unit Main;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

StdCtrls, ThrdU;

type

TMainForm = class(TForm)

Edit1: TEdit;

Button1: TButton;

Memo1: TMemo;

Label1: TLabel;

Label2: TLabel;

procedure Button1Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

MainForm: TMainForm;

implementation

{$R *.DFM}

procedure TMainForm.Button1Click(Sender: TObject);

begin

TTestThread.Create(False);

end;

end.

Priorytety i szeregowanie wątków

Jak już wcześniej pisaliśmy, wątki są obiektami API ubiegającymi się niezależnie o czas procesora. Rozdział czasu i wielkość przydzielanego kwantu uzależnione są od warto­ści priorytetu wątku (priority), który w Win32 jest wypadkową dwóch wielkości: klasy priorytetowej procesu (priority class) oraz priorytetu względnego wątku w ramach procesu.

Klasa priorytetowa procesu

Klasa priorytetowa określa stopień preferencji procesu (jako całości) podczas ubiegania się jego poszczególnych wątków o czas procesora. W Win32 procesowi może być przydzie­lona jedna z czterech następujących klas priorytetowych:

• Jałowy (Idle) — proces opatrzony tą klasą priorytetową otrzymuje czas pro­cesora jedynie wtedy, gdy nie potrzebują go procesy o wyższej klasie priory­tetowej. Przykładem procesów posiadających tę klasę priorytetową są wyga­szacze ekranu.

• Normalny (Normal) — jest to domyślna klasa priorytetowa, przypisywana przez system wszystkim procesom uruchamianym z pulpitu lub wiersza poleceń.

• Wysoki (High) — klasą tą opatruje się procesy, które powinny otrzymywać czas procesora tak szybko, jak tylko jest to możliwe. Proces z tą klasą prio­rytetową jest zdolny do wywłaszczania z czasu procesora procesów z klasami Idle i Normal. Przykładem tego typu procesu jest lista zadań Windows, która — niezależnie od innych czynności — musi ukazać się użytkownikowi nie­zwłocznie. Nie należy opatrywać tą klasą procesów wykonujących intensyw­ne obliczenia, gdyż grozi to sparaliżowaniem m.in. procesów o klasie Normal, a więc np. uruchamianych z pulpitu.

• Czasu rzeczywistego (Realtime) — wątki procesu posiadającego tę klasę prio­rytetową zdolne są do wywłaszczania wątków wszystkich innych procesów, włącznie z procesami systemowymi. Zmonopolizowanie procesora przez wątek procesu o tak wysokim priorytecie może stanowić zagrożenie dla nor­malnego funkcjonowania systemu i spowodować np. zablokowanie zapisywa­nia zawartości buforów dyskowych albo nieczułość na operowanie myszą bądź klawiaturą, dlatego też klasę tę rezerwuje się dla procesów wykonują­cych ekstremalnie krótkie czynności, stanowiące reakcję na zachodzące zda­rzenia — głównie procesów systemowych.

W Windows 2000/XP dostępne są ponadto klasy priorytetowe „Podnormalny” (Below Normal) i „Nadnormalny” (Above Normal), nie uwzględnia ich jednak moduł Windows.pas w Delphi 6.

Numeryczne wartości priorytetu każdej z wymienionych klas oraz związane z nimi identyfikatory Win32 przedstawia tabela 5.1.

Tabela 5.1. Klasy priorytetowe procesu

Klasa priorytetowa	Flaga Win32	Wartość
Idle	IDLE_PRIORITY_CLASS	$40
Below Normal	BELOW_NORMAL_PRIORITY_CLASS	$4000
Normal	NORMAL_PRIORITY_CLASS	$20
Above Normal	ABOVE_NORMAL_PRIORITY_CLASS	$8000
High	HIGH_PRIORITY_CLASS	$80
Realtime	REALTIME_PRIORITY_CLASS	$100

Domyślnie, procesy uruchamiane z poziomu pulpitu lub wiersza poleceń otrzymują klasę priorytetową Normal. Dla procesu tworzonego w sposób jawny (tj. za pomocą funkcji Create­Process()) możliwe jest także jawne określenie klasy priorytetowej — służy do tego szósty parametr wywołania dwCreationFlags; po­szczególnym klasom priorytetowym odpowiadają flagi wymienione w tabeli 5.2. Win32 umożliwia ponadto odczyt oraz dynamiczną zmianę aktualnej klasy priorytetowej wskazanego procesu. Służą do tego funkcje (odpowiednio) GetPriorityClass() i SetPriorityClass():

function GetPriorityClass(hProcess: THandle): DWORD; stdcall;

function SetPriorityClass(hProcess: THandle; dwPriorityClass:DWORD): BOOL; stdcall;

Parametr hProcess jest tutaj tzw. pseudouchwytem (pseudo-handle) odnośnego procesu — każdy proces może uzyskać swój własny pseudouchwyt wywołując funkcję GetCurrentProcess():

function GetCurrentProcess: THandle; stdcall;

Pseudouchwyt stanowi swego rodzaju „odnośnik” do „normalnego” uchwytu — nie jest więc odrębnym obiektem i nie podlega zamykaniu przez CloseHandle() (próba za­mknięcia pseudouchwytu nie powoduje w Win32 żadnego efektu).

Jeśli więc chciałbyś nadać swej aplikacji klasę priorytetową (powiedzmy) High, to sto­sowne wywołanie miałoby następującą postać:

if not SetPriorityClass(GetCurrentProcess, HIGH_PRIORITY_CLASS)

Then

ShowMessage('Błąd nadawania klasy priorytetowej');

Notatka

Modyfikacja klasy priorytetowej procesu w Windows NT/2000 wymaga określonych przywilejów procesowych. Domyślne dla aplikacji klasy priorytetowe mogą być ponadto zmienione przez administratora, zwłaszcza w intensywnie obciążonych serwerach Windows NT/2000.

Nie należy nadużywać klasy priorytetowej Realtime. Ponieważ wątki systemu operacyjnego funkcjonują w warunkach niższego priorytetu, przypisanie tak wysokiego priorytetu aplikacji może niekiedy doprowadzić do sparaliżowania systemu operacyjnego, przez nadmierne spowolnienie (lub wręcz zatrzymanie) obsługi komunikatów czy operacji wejścia-wyjścia.

Nawet jednak ustawienie „tylko” klasy High może powodować problemy, jeżeli wątki procesu opatrzonego tą klasą nie pozostają przez większość czasu w stanie oczekiwania, a dokonują intensywnych obliczeń. Zalety wielozadaniowości z wywłaszczaniem mogą wówczas szybko przeobrazić się w wady.

Priorytet względny wątku

Idea określania względnych priorytetów wątków ma na celu zróżnicowanie w ramach procesu „pilności” poszczególnych wątków w ubieganiu się o czas procesora; w przy­bliżeniu — priorytety względne są dla wątków danego procesu tym, czym klasa priory­tetowa dla poszczególnych procesów w systemie. Danemu wątkowi można przypisać je­den z siedmiu następujących priorytetów względnych:

• jałowy (tpIdle),

• niski (tpLowest),

• podnormalny (tpBelowNormal),

• normalny (tpNormal),

• nadnormalny (tpAboveNormal),

• wysoki (tpHighest),

• krytyczny (tpTimeCritical).

Podobnie jak każda z klas priorytetowych procesu, tak każdy z priorytetów względnych wątku posiada określoną wagę; dodając ją do klasy priorytetowej procesu, otrzymujemy ostateczną wartość określającą priorytet wątku w ubieganiu się o czas procesora (z tego względu priorytet względny wątku bywa często określany mianem priorytetu delta — ang. delta-priority). Wagi reprezentujące poszczególne kategorie priorytetu względnego, wraz z symbolicznymi oznaczeniami tych kategorii w Win32, przedstawia tabela 5.2.

Tabela 5.2. Priorytety względne wątku

Priorytet	Flaga Win32	Waga liczbowa
tpIdle	THREAD_PRIORITY_IDLE	-15
tpLowest	THREAD_PRIORITY_LOWEST	-2
tpLower	THREAD_PRIORITY_BELOW_NORMAL	-1
tpNormal	THREAD_PRIORITY_NORMAL	0
tpHigher	THREAD_PRIORITY_ABOVE_NORMAL	1
tpHighest	THREAD_PRIORITY_HIGHEST	2
tpTimeCritical	THREAD_PRIORITY_TIME_CRITICAL	15

W pewnych szczególnych przypadkach ostateczny priorytet wątku jest jednak inny niż suma klasy priorytetowej procesu i priorytetu względnego wątku, mianowicie:

• Wątek o priorytecie względnym tpIdle, należący do procesu o klasie priory­tetowej innej niż RealTime, posiada ostateczny priorytet równy 1.

• Wątek o priorytecie względnym tpIdle, należący do procesu o klasie priory­tetowej RealTime, posiada ostateczny priorytet równy 16.

• Wątek o priorytecie względnym tpTimeCritical, należący do procesu o kla­sie priorytetowej innej niż RealTime, posiada ostateczny priorytet równy 15.

• Wątek o priorytecie względnym tpTimeCritical, należący do procesu o kla­sie priorytetowej RealTime, posiada ostateczny priorytet równy 31.

Zawieszanie i wznawianie wątków

Przy okazji omawiania konstruktora TThread.Create() zwróciliśmy uwagę na to, że utworzony wątek może pozostawać w zawieszeniu; procedurą wyprowadzającą go z te­go stanu jest metoda Resume(). Czynność odwrotną — zawieszenie działającego wątku — realizuje metoda Suspend().

Z każdym wątkiem, jako obiektem Win32, związany jest tzw. licznik zawieszeń (suspend counter). Jeżeli ma niezerową wartość, wątek pozostaje w zawieszeniu. Zwiększaniem tego licznika zajmuje się metoda Suspend(), zaś zmniejszaniem — metoda Resume() (jeżeli metoda Resume() na­potka zerową wartość licznika, nic się nie dzieje). Konstruktor klasy TThread ustawia początkowo wartość wspomnianego licznika na 0, a jeżeli parametr wywołania tego konstruktora ma wartość True, wywoływana jest automatycznie metoda Suspend().

Wynika stąd wniosek, iż wywołanie metody Resume() nie zawsze wyprowadza wątek ze stanu zawieszenia.

Pomiar czasu w ramach wątku

W środowisku Windows 3.x pomiar czasu nie stanowił żadnego problemu — proces nie mógł zostać wywłaszczony przez system, a więc mierzony czas rzeczywisty tożsamy był z czasem poświęconym danemu procesowi przez procesor centralny. Przykładowa se­kwencja rozkazów, dokonująca pomiaru czasu w tych warunkach, mogła wyglądać mniej więcej tak:

{WIN16 API}

var

StartTime, Total : Longint;

begin

...

StartTime := GetTickCount;

... // tutaj biegną obliczenia, których czas mierzymy

Total := GetTickCount - StartTime;

W środowisku wielozadaniowym stosującym wywłaszczanie nie można jednak utożsa­miać czasu rzeczywistego z czasem przeznaczonym dla danego wątku, gdyż każda se­kwencja rozkazów może być w dowolnej chwili przerwana przez system w celu przeka­zania procesora innemu wątkowi.

Sprawa ta jest o tyle smutna, że Windows 95/98 nie posiadają żadnego mechanizmu pozwalającego mierzyć czas biegnącej aplikacji! W Windows NT/2000/XP istnieje natomiast funkcja o nazwie GetThreadTimes(). Jej nagłówek ma następu­jącą postać:

function GetThreadTimes(hThread: THandle;

var lpCreationTime, lpExitTime, lpKernelTime, lpUserTime:TFileTime): BOOL; stdcall;

Parametr hThread jest uchwytem identyfikującym wątek, a pozostałe parametry, po po­myślnym wykonaniu funkcji, zawierają informację zgodnie z poniższą tabelą; wynik funk­cji informuje, czy jej wykonanie zakończyło się pomyślnie.

lpCreationTime	Czas utworzenia wątku
lpExitTime	Czas zakończenia realizacji wątku; jeżeli wątek wciąż działa, to wartość ta jest nieokreślona
lpKernelTime	Czas realizacji usług systemowych na rzecz wątku
lpUserTime	Czas realizacji kodu wątku poza usługami systemowymi

Zwracane przez funkcje API wskazania czasu są wartościami 64-bitowymi, liczonymi w jednostkach 100-nanosekundowych. Ponieważ jednak 64-bitowe liczby całkowite pojawiły się (jako rodzimy typ Object Pascala) dopiero w Delphi 4, wartości te rozdzielane są pomiędzy dwie liczby 32-bitowe, stanowiące pola następującego rekordu:

TFileTime = record

dwLowDateTime :DWORD //część mniej znacząca

dwHighDateTime :DWORD //część bardziej znacząca

end;

Typ TFileTime używany jest też do oznaczania momentu utworzenia (modyfikacji) pliku; zerowa wartość obydwu pól oznacza północ rozpoczynającą dzień 1 stycznia 1601 roku (trudno byłoby więc reprezentować w tej konwencji czas rozpoczęcia np. bitwy pod Grunwaldem), jednostka ma oczywiście wartość 100 nanosekund.

Wskazówka

Dysponując już typem Int64, reprezentującym 64-bitową liczbę ze znakiem, możemy z powodzeniem dokonywać rzutowania nań typu TFileTime, co upraszcza porównywanie wskazań czasowych, np.

var

UserTine, KernelTime: TFileTime;

...

if Int64(UserTime) > Int64(KernelTime)

then

Beep;

Dla przypomnienia — reprezentacja czasu w ramach standardowego dla Delphi typu TDateTime jest krańcowo odmienna: czas reprezentowany jest jako liczba zmiennoprzecinkowa typu double

type

TDateTime = type Double;

zawierająca ilość dni (ilość, nie liczbę, wynik bowiem niekoniecznie jest liczbą całkowitą), które upłynęły od północy rozpoczynającej dzień 30 grudnia 1899 roku; tej właśnie chwili odpowiada wartość zero, chwile wcześniejsze reprezentowane są przez wartości ujemne.

Konwersję pomiędzy obydwiema reprezentacjami — TFileTime i TDateTime — wykonują poniższe funkcje:

Function FileTimeToDateTime(FileTime: TFileTime): TDateTime;

var

SysTime: TSystemTime;

begin

if not FileTimetoSystemTime(FileTime, SysTime)

Then

raise EConvertError.CreateFmt

('Błąd konwersji FileTimetoSystemTime - kod błędu %d', [GetLastError]);

with SysTime do

Result := EncodeDate(wYear, wMonth, wDay) +

EncodeTime (wHour, wMinute, wSecond, wMilliSeconds);

end;

Function DateTimeToFileTime(DateTime: TDateTime): TFileTime;

var

SysTime: TSystemTime;

begin

with Systime do

begin

DecodeDate(DateTime, wYear, wMonth, wDay);

DecodeTime(DateTime, wHour, wMinute, wSecond, wMilliseconds);

wDayOfWeek := DayOfWeek(DateTime);

end;

if not SystemTimeToFileTime(SysTime, Result)

then

raise EConvertError.CreateFmt

('Błąd konwersji SystemTimeToFileTime - kod błędu %d', [GetLastError]);

end;

Wskazówka

Przypominamy, iż funkcja GetThreadTime() nie jest zaimplementowana w Windows 95/98 — jej wywołanie daje wynik False i nieokreślone wartości parametrów.

Współdziałanie wątków aplikacji

Wraz z pojawieniem się wielowątkowości (i w ogóle programowania współbieżnego) ujawniło się wiele problemów przedtem niespotykanych. Podczas analizy kodu poszczegól­nych wątków nie sposób już określić zachowania się aplikacji tak jednoznacznie, jak w przypadku aplikacji jednowątkowych. Oddziaływanie na siebie po­szczególnych wątków uwidacznia się głównie w dwóch aspektach przetwarzania: współdzieleniu globalnych zasobów oraz synchronizacji określonych czynności.

W warunkach niekontrolowanego dostępu wątków do danego zasobu, jego stan zależny jest na ogół od względnej szybkości tych wątków; ponadto niektóre ciągi operacji dotyczących zasobu muszą być wykonane w sposób niepodzielny, pod groźbą utraty jego integralności.

Czynności wykonywane przez poszczególne wątki procesu bywają w mniejszym lub większym stopniu uzależnione od siebie — w „konkretnym miejscu” konkretnego wątku, przed kontynuacją przetwarzania, konieczne może być założenie, iż inny wątek wykonał już określoną czynność. Takie założenie musi być oczywiście oparte na rzetelnych pod­stawach, których dostarczyć mogą jedynie niezawodne narzędzia systemowe.

Zobaczmy, jak z opisanymi problemami radzą sobie Delphi i Win32 API.

Pamięć lokalna wątku

Każdy wątek reprezentuje (w pewnym sensie) niezależną część przetwarzania, powinien zatem używać własnego zestawu zmiennych roboczych. Taka rozłączność za­pewniona jest w sposób automatyczny, jeżeli zmienne te stanowią pola obiektu reprezentu­jącego wątek — w rozpatrywanym niedawno obiekcie TTestThread polem takim jest Answer. Nie ma również problemu z lokalnymi zmiennymi procedur i funkcji — egzystują one na stosie, zaś każdy wątek posiada swój prywatny stos.

Ze zmiennymi globalnymi sprawa jest nieco bardziej złożona, ponieważ ich rozłączność (dla poszczególnych wątków) musi być zapewniona za pomocą specjalnych środków, na szczęście bardzo łatwych w użyciu.

Pamięć obiektu wątkowego

Najwygodniejszym i najbardziej zgodnym z obiektową filozofią Delphi jest przechowywanie prywatnych danych wątku w polach jego obiektu wątkowego, jak w poniższym przykładzie:

type

TMyThread = class(TThread)

private

FLocalInt : integer;

FLocalStr: String;

…

end;

Oprócz tego, że rozwiązanie takie jest klarowne, jest ponadto bardziej efektywne od mechanizmów oferowanych przez Win32 API, dostępnych w Delphi za pośrednictwem dyrektywy threadvar — dostęp do pól obiektu wątkowego jest średnio 10 razy szybszy niż dostęp do tzw. pamięci TLS (thread-local storage). Ponadto zmienne, których wartość istotna jest jedynie w obrębie określonych metod obiektu wątkowego, powinny być zmiennymi lokalnymi tychże metod — dostęp do zmiennych lokalnych jest jeszcze szybszy niż dostęp do pól obiektu.

threadvar — pamięć wątkowa Win32 API

Jak już wcześniej wspominaliśmy, zmienne globalne aplikacji współdzielone są przez jej poszczególne wątki, a to rodzi określone konsekwencje typowe dla współdzielenia zasobów, którymi przecież są wspomniane zmienne. Spójrzmy na poniższy fragment:

var

GlobalStr: String;

...

procedure SetShowStr(const S: String);

begin

if S = ''

Then

MessageBox(0, PChar(GlobalStr), 'Wartość zmiennej globalnej wynosi', MB_OK.)

Else

GlobalStr := S;

end;

Działanie powyższej procedury nie wymaga komentarzy, jeżeli jest ona wykonywana w ramach tylko jednego wątku: jej wywołanie z „pustym” parametrem spowoduje wyświetlenie zawartości zmiennej globalnej GlobalStr, zaś wywołanie z parametrem „niepustym” spowoduje przypisanie jego wartości do zmiennej GlobalStr. Jeżeli jednak procedura SetShowStr() wykorzystywana jest przez kilka wątków, to jej wykonywanie w ramach jednego wątku może być przerwane przez inny wątek, który nieoczekiwanie zmieni wartość zmiennej GlobalStr. W charakterze przykładu przeanalizujmy współdziałanie dwóch wątków: niech pierwszy z nich wykonuje taką oto sekwencję:

SetShowStr('Biały');

SetShowStr('');

drugi zaś następującą:

SetShowStr('Czarny');

SetShowStr('');

Załóżmy teraz, iż pierwszy wątek, po wykonaniu pierwszej instrukcji (SetShowStr('Biały')) zostanie wywłaszczony przez system operacyjny z czasu procesora, po czym drugi wątek wykona swą pierwszą instrukcję SetShowStr('Czarny'). Jeżeli teraz nastąpi wywłaszczenie drugiego wątku i pierwszy wątek wykona swą drugą instrukcję (SetShowStr('')), wyświetlony przezeń komunikat informować będzie, iż zawartością zmiennej GlobalStr jest … 'Czarny' — gdyż taką wartość ustalił przed chwilą drugi wątek. Z punktu widzenia pierwszego wątku to kompletne zaskoczenie, z punktu widzenia wielowątkowości — zwyczajna rzecz, gdy nie kontroluje się dostępu do wspólnych zasobów.

Za pomocą mechanizmu Win32, zwanego w skrócie TLS (thread-local storage), możliwe jest jednak takie zadeklarowanie zmiennej globalnej, by każdy z wątków posługiwał się jej oddzielnym egzemplarzem. Zadanie to spełnia w Object Pascalu dyrektywa threadvar, zastępująca w takiej sytuacji tradycyjną dyrektywę var:

threadvar

GlobalStr: String;

Wskazówka

Jeżeli interesuje Cię realizacja pamięci TLS w Win32 API, czyli to, co kryje się pod magiczną dyrektywą threadvar, zajrzyj na strony 884÷891 książki „Delphi 3. Księga eksperta”, wyd. HELION 1998 (przyp. tłum.).

Opisywaną sytuację ilustruje projekt o nazwie TLS.dpr znajdujący się na załączonym krążku CD-ROM; jego moduł główny prezentujemy na wydruku 5.3. Na formularzu projektu znajduje się pojedynczy przycisk. Kliknięcie go powoduje dwukrotne wywołanie procedury SetShowStr() w celu nadania wartości zmiennej GlobalStr, a następnie jej wyświetlenia. W tym momencie startuje drugi wątek, wykonując analogiczne czynności w odniesieniu do tej samej zmiennej GlobalStr. Gdy wykonana zostanie ostatnia instrukcja procedury Button1Click, wyświetlona wartość zmiennej GlobalStr niekoniecznie będzie miała wartość nadaną jej w pierwszej instrukcji (z powodów wcześniej opisanych). Jeżeli jednak zadeklarujemy zmienną GlobalStr jako threadvar, opisany problem nie wystąpi, bo każdy z wątków posługiwać się będzie oddzielnym egzemplarzem tej zmiennej.

Wydruk 5.3. Ilustracja lokalnej pamięci wątku

unit Main;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

StdCtrls;

type

TMainForm = class(TForm)

Button1: TButton;

procedure Button1Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

MainForm: TMainForm;

implementation

{$R *.DFM}

{ NOTE: zmień dyrektywę "var" na "threadvar", by zobaczyć różnicę }

var

//threadvar

GlobalStr: string;

type

TTLSThread = class(TThread)

private

FNewStr: String;

protected

procedure Execute; override;

public

constructor Create(const ANewStr: String);

end;

procedure SetShowStr(const S: String);

begin

if S = '' then

MessageBox(0, PChar(GlobalStr), 'Wartość zmiennej globalnej wynosi...', MB_OK)

else

GlobalStr := S;

end;

constructor TTLSThread.Create(const ANewStr: String);

begin

FNewStr := ANewStr;

inherited Create(False);

end;

procedure TTLSThread.Execute;

begin

FreeOnTerminate := True;

SetShowStr(FNewStr);

SetShowStr('');

end;

procedure TMainForm.Button1Click(Sender: TObject);

begin

SetShowStr('Cześć');

SetShowStr('');

TTLSThread.Create('A kuku!');

Sleep(100);

SetShowStr('');

end;

end.

Wskazówka

W powyższym przykładzie pomogliśmy nieco przypadkowi, zwiększając prawdopodobieństwo ingerencji drugiego wątku w pracę pierwszego. Zastosowana przez nas procedura Sleep()

procedure Sleep(dwMilliseconds:DWORD); stdcall;

symuluje „uśpienie wątku” na wskazany interwał czasowy, a dokładniej — stanowi ona informację dla systemu, iż nie należy w tym czasie przydzielać wątkowi cza­su procesora. W warunkach pracy wielowątkowej wprowadza to dodatkowy ele­ment losowości — ponieważ niepodobna określić, co dzieje się z pozostałymi wąt­kami w momencie „obudzenia” uśpionego wątku.

Często stosowaną praktyką jest wywoływanie procedury Sleep() z zerową war­tością argumentu — choć nie powoduje ono uśpienia wątku, to prawie na pewno spowoduje jego chwilowe wywłaszczenie z czasu procesora na rzecz in­nego wątku o podobnym lub wyższym priorytecie.

Efekt wspomnianej „losowości” uwidacznia się jeszcze wyraźniej wówczas, gdy przeniesiemy daną aplikację na (znacząco) wolniejszy lub (znacząco) szybszy komputer. Wypływa stąd wniosek, iż procedura Sleep() nie zapewnia synchronizowania wątków — nawet jeżeli wydaje się, iż w czasie „odpoczywania” pierwszego wątku drugi wątek zdążył już coś zrobić, założenie takie wcale nie musi być prawdziwe.

Synchronizacja wątków

Jak wspominaliśmy na wstępie, niekontrolowany dostęp do wspólnie wykorzystywanych zasobów może dawać nieoczekiwane efekty; losowe zachowanie się ostatniej aplikacji było tego dobrym przykładem. W przykładzie tym problem wspólnego wykorzystywania zasobu został nie tyle rozwiązany, co usunięty — zastąpienie deklaracji var przez threadvar spowodowało „rozszczepienie” zmiennej GlobalStr na dwa niezależne egzemplarze, bo celem aplikacji było zademonstrowanie wykorzystania lokalnej pamięci wątku, nie zaś — współdzielenia zasobu.

Zajmiemy się teraz problemem synchronizacji wątków w ścisłym tego słowa znaczeniu. Załóżmy mianowicie funkcjonowanie dwóch wątków, z których pierwszy wczytuje zawartość pliku dyskowego do pamięci, drugi natomiast zlicza wszystkie wystąpienia (we wczytanym fragmencie) znaku o kodzie (na przykład) 128. Jest oczywiste, iż zliczanie nie może rozpocząć się wcześniej, niż w momencie, gdy pierwszy wątek wczyta całą zawartość pliku; ponieważ jednak obydwa wątki traktowane są przez system operacyjny całkowicie niezależnie, takiej gwarancji (domyślnie) nie ma i synchronizację obydwu wątków należy zapewnić w sposób jawny.

Win32 API udostępnia cztery mechanizmy synchronizacji wątków: sek­cje krytyczne (critical sections), wykluczenia wzajemne zwane też muteksami (mutexes), semafo­ry (semaphores) i zdarzenia (events). Aby zademonstrować ich wykorzystanie, rozpatrzmy przykłado­wy projekt, w którym dwa wątki drugorzędne w sposób niekontrolowany zapełniają ta­blicę kolejnymi liczbami całkowitymi; po zakończeniu obydwu wątków zawartość tabli­cy jest wyświetlana na ekranie przez wątek główny. Projekt ten znajduje się na załączonym krążku CD-ROM pod nazwą NoSynch.dpr — jego moduł główny prezentujemy na wydruku 5.4.

Wydruk 5.4. Niekontrolowane współdziałanie wątków

unit Main;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

StdCtrls;

type

TMainForm = class(TForm)

Button1: TButton;

ListBox1: TListBox;

procedure Button1Click(Sender: TObject);

private

procedure ThreadsDone(Sender: TObject);

end;

TFooThread = class(TThread)

protected

procedure Execute; override;

end;

var

MainForm: TMainForm;

implementation

{$R *.DFM}

const

MaxSize = 128;

var

NextNumber: Integer = 0;

DoneFlags: Integer = 0;

GlobalArray: array[1..MaxSize] of Integer;

function GetNextNumber: Integer;

begin

Result := NextNumber; // zwróć wartość zmiennej globalnej

Inc(NextNumber); // i zwiększ ją

end;

procedure TFooThread.Execute;

var

i: Integer;

begin

OnTerminate := MainForm.ThreadsDone;

for i := 1 to MaxSize do

begin

GlobalArray[i] := GetNextNumber; // przypisz wartość elementowi tablicy

Sleep(3+random(12)); // pozwól działać drugiemu wątkowi

end;

end;

procedure TMainForm.ThreadsDone(Sender: TObject);

var

i: Integer;

begin

Inc(DoneFlags);

if DoneFlags = 2 then // upewnij się, że obydwa wątki zakończyły się

for i := 1 to MaxSize do

{ wypełnij listę elementami tablicy }

Listbox1.Items.Add(IntToStr(GlobalArray[i]));

end;

procedure TMainForm.Button1Click(Sender: TObject);

begin

// utwórz i uruchom obydwa wątki

TFooThread.Create(False);

TFooThread.Create(False);

end;

end.

Każdy z wątków dokonuje wypełniania tablicy GlobalArray kolejnymi liczbami całkowitymi; ponieważ jednak obydwa wątki wykorzystują tę tablicę w sposób całkowicie niesynchroniczny, jej końcowa zawartość jest różna od oczekiwanej, o czym świadczy lista na formularzu (rys. 5.4).

Rysunek 5.4. Rezultat niesynchronizowanego wypełniania tablicy

I nie może być inaczej, dopóki nie wprowadzimy jakichkolwiek mechanizmów synchro­nizacyjnych. Istotnie, co najmniej dwa „zasoby” — zmienna NextNumber oraz tablica GlobalArray — wykorzystywane są tu w sposób niekontrolowany przez obydwa wątki, których losowe zachowanie zostało dodatkowo spotęgowane wplatanym oczekiwaniem (o losowej długości) po wpisaniu wartości do kolejnego elementu.

Sekcje krytyczne

Opisany chaos w tablicy z poprzedniego przykładu z pewnością udałoby się wyeliminować, gdybyśmy pozwolili każdemu z wątków wykonać swoją pracę „w spokoju”, bez ingerencji ze stro­ny drugiego wątku. Na przykład, pierwszy wątek mógłby zapełniać tablicę liczbami od 0 do 127, drugi — liczbami od 128 do 255; na formularzu ujrzeliby­śmy oczywiście tę drugą zawartość.

Najprostszym narzędziem Win32 zapewniającym opisaną wyłączność są sekcje kry­tyczne (critical sections). Fragment kodu stanowiący sekcję krytyczną wykony­wany jest w danej chwili przez co najwyżej jeden wątek — inne wątki nie mają w tym czasie dostępu do tego fragmentu. Wracając do poprzedniego projektu, nietrudno skonstatować, iż w ramy sekcji krytycznej powinna zostać ujęta pętla zapełniająca elementy tablicy, za­warta w procedurze TFooThreadExecute().

Sekcja krytyczna w Win32 ma postać rekordu TRTLCriticalSection. Jego szcze­gółowa struktura nie jest tu istotna, znacznie ważniejsze są natomiast cztery podstawowe operacje z jego udziałem. Pierwszą operacją wykonywaną na sekcji krytycznej jest jej zainicjowanie, wykonywane przez następującą procedurę API:

procedure InitializeCriticalSection(var lpCriticalSection:TRTLCriticalSection);stdcall;

Rozpoczęcie wykonywania krytycznego fragmentu kodu musi być poprzedzone wej­ściem do sekcji krytycznej (entering critical section). Jest ono realizowane przez procedurę EnterCriticalSection():

procedure EnterCriticalSection(var lpCriticalSection:TRTLCriticalSection);stdcall;

W danej chwili wewnątrz określonej sekcji krytycznej może przebywać co najwyżej je­den wątek — pozostałe wątki zamierzające do niej wejść (ściślej — te, które wywołają w stosunku do niej procedurę EnterCriticalSection()), zostaną przez system zawieszone.

Po zakończeniu wykonywania krytycznego fragmentu kodu wątek znajdujący się w sek­cji krytycznej musi dokonać wyjścia z niej (leaving critical section) przez wywołanie następującej procedury:

procedure LeaveCriticalSection(var lpCriticalSection: TRTLCriticalSection);stdcall;

Umożliwi to wejście do sekcji krytycznej któremuś z oczekujących wątków.

Ostatnią operacją dotyczącą sekcji krytycznej jest jej zwolnienie, gdy nie jest już dłużej potrzebna; służy do tego następująca procedura:

procedure DeleteCriticalSection(var lpCriticalSection: TRTLCriticalSection);stdcall;

Wskazówka

Microsoft konsekwentnie ukrywa strukturę rekordu TRTLCriticalSection, ponieważ zmienia się ona w zależności od platformy sprzętowej, a więc uzależnienie aplikacji od jej konkretnej postaci mogłoby powodować problemy. W systemach „intelowskich” sekcja krytyczna zawiera licznik, pole przechowujące uchwyt przebywającego w niej wątku i (ewentualnie) wskaźnik do procedury obsługi zdarzeń systemowych. Komputery serii Alpha posługują się własną postacią sekcji krytycznej o nazwie spinlock, znacznie efektywniejszą od intelowskiej.

Wykorzystanie sekcji krytycznej do synchronizacji zapełniania tablicy z poprzedniego przykładu ilustruje projekt CritSec.dpr znajdujący się na załączonym krążku CD-ROM. Jego moduł główny prezentujemy na wydruku 5.5.

Wydruk 5.5. Przykład synchronizacji z wykorzystaniem sekcji krytycznej

unit Main;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

StdCtrls;

type

TMainForm = class(TForm)

Button1: TButton;

ListBox1: TListBox;

procedure Button1Click(Sender: TObject);

private

procedure ThreadsDone(Sender: TObject);

end;

TFooThread = class(TThread)

protected

procedure Execute; override;

end;

var

MainForm: TMainForm;

implementation

{$R *.DFM}

const

MaxSize = 128;

var

NextNumber: Integer = 0;

DoneFlags: Integer = 0;

GlobalArray: array[1..MaxSize] of Integer;

CS: TRTLCriticalSection;

function GetNextNumber: Integer;

begin

Result := NextNumber; // zwróć wartość zmiennej globalnej

inc(NextNumber); // zwiększ zmienną globalną

end;

procedure TFooThread.Execute;

var

i: Integer;

begin

OnTerminate := MainForm.ThreadsDone;

EnterCriticalSection(CS); // początek sekcji krytycznej

for i := 1 to MaxSize do

begin

GlobalArray[i] := GetNextNumber; // ustaw element tablicy

Sleep(3+Random(12)); // pozwól działać innemu wątkowi

end;

LeaveCriticalSection(CS); // koniec sekcji krytycznej

end;

procedure TMainForm.ThreadsDone(Sender: TObject);

var

i: Integer;

begin

inc(DoneFlags);

if DoneFlags = 2 then

begin // upewnij się, że zwolniono obydwa wątki

for i := 1 to MaxSize do

{ wypełnij listę zawartością tablicy }

Listbox1.Items.Add(IntToStr(GlobalArray[i]));

DeleteCriticalSection(CS);

end;

end;

procedure TMainForm.Button1Click(Sender: TObject);

begin

InitializeCriticalSection(CS);

// utwórz i uruchom wątki

TFooThread.Create(False);

TFooThread.Create(False);

end;

end.

Krytycznym fragmentem kodu, stanowiącym treść sekcji krytycznej jest pętla wypełniająca tablicę:

for i := 1 to MaxSize do

begin

GlobalArray[i] := GetNextNumber;

Sleep(3 + Random(12));

end;

Wątek, który zostanie wpuszczo­ny do sekcji krytycznej jako pierwszy, zapełni tablicę liczbami od 0 do 127; po jego wyjściu z sekcji krytycz­nej zostanie do niej wpuszczony drugi wątek, który — niwecząc pracę wykonaną przez poprzednika — zapełni tablicę liczbami od 128 do 255 i również opuści sekcję krytycz­ną; efekt jego działań zostanie wyświetlony na formularzu (rys. 5.5).

Rysunek 5.5. Efekt zapełniania tablicy synchronizowanego sekcją krytyczną

Wykluczenia wzajemne (muteksy)

Mechanizm wykluczenia wzajemnego (mutex — od mutual exclusion) podobny jest do sekcji krytycznej, odróżniają go jednak dwie istotne własności. Po pierwsze, w przeciwieństwie do sekcji krytycznej, będącej lokalnym obiektem procesu, muteks jest globalnym obiektem Win32 API, reprezentowanym przez uchwyt (handle), po drugie — jest on dostępny dla wszystkich wątków wszystkich procesów poprzez swą nazwę symboliczną.

Wskazówka

Poza oczywistymi różnicami semantycznymi, istotną różnicą między muteksem a sekcją krytyczną jest ich efektywność. Sekcje krytyczne, jako obiekty w gruncie rzeczy nieskomplikowane, są niesamowicie efektywne — wejście do sekcji krytycznej lub wyjście z niej, przy braku wątków kolidujących, trwa zaledwie kilkanaście cykli zegara! Gdy jednak próba wejścia wątku do sekcji krytycznej musi zakończyć się jego wstrzymaniem, system tworzy związany z tym obiekt zdarzeniowy (zazwyczaj muteks). Używanie obiektów zdarzeniowych jest znacznie bardziej czasochłonne, gdyż wiąże się z wywoływaniem procedur jądra systemu, co z kolei wymaga przełączenia kontekstu procesu i zmiany (sprzętowego) poziomu ochrony. Trwa to zazwyczaj kilkaset cykli zegarowych, również wtedy, gdy aplikacja nie wykorzystuje aktualnie wątków pobocznych i gdy nie ma konkurencyjnych żądań w stosunku do chronionego zasobu.

Utworzenie muteksu następuje w wyniku wywołania funkcji CreateMutex():

function CreateMutex(lpMutexAttributes: PSecurityAttributes; bInitialOwner: BOOL;

lpName: PCHar): THandle; stdcall;

Parametr lpMutexAttributes jest wskaźnikiem do struktury określającej tzw. atry­buty bezpieczeństwa; podanie pustego wskaźnika (NIL) spowoduje przyjęcie atrybutów domyślnych.

Parametr bInitialOwner określa, czy wątek tworzący muteks ma być uważany za jego właściciela; wartość False oznacza, że utworzony muteks nie posiada właściciela.

Parametr lpName jest globalną nazwą identyfikującą muteks; wartość NIL powoduje utworzenie muteksu nienazwanego. Globalny charakter nazwy muteksu przejawia się w tym, iż funkcja CreateMutex() poszukuje w systemie ewentualnie istniejącego już muteksu o podanej nazwie i w przypadku jego znale­zienia tworzy do niego dodatkowy uchwyt, w przeciwnym wypadku tworzy nowy muteks.

Zwolnienie muteksu sprowadza się do zamknięcia (za pomocą CloseHandle()) jego uchwytu zwracanego jako wynik funkcji CreateMutex().

Prezentowany na wydruku 5.6 kod modułu źródłowego kolejnego projektu — Mutex.dpr — ilustruje wykorzystanie muteksów do synchronizacji wątków zapełniających tablicę.

Wydruk 5.6. Synchronizacja dostępu do tablicy za pomocą wykluczenia wzajemnego

unit Main;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

StdCtrls;

type

TMainForm = class(TForm)

Button1: TButton;

ListBox1: TListBox;

procedure Button1Click(Sender: TObject);

private

procedure ThreadsDone(Sender: TObject);

end;

TFooThread = class(TThread)

protected

procedure Execute; override;

end;

var

MainForm: TMainForm;

implementation

{$R *.DFM}

const

MaxSize = 128;

var

NextNumber: Integer = 0;

DoneFlags: Integer = 0;

GlobalArray: array[1..MaxSize] of Integer;

hMutex: THandle = 0;

function GetNextNumber: Integer;

begin

Result := NextNumber; // zwróć wartość zmiennej globalnej

Inc(NextNumber); // zwiększ zmienną globalną

end;

procedure TFooThread.Execute;

var

i: Integer;

begin

FreeOnTerminate := True;

OnTerminate := MainForm.ThreadsDone;

if WaitForSingleObject(hMutex, INFINITE) = WAIT_OBJECT_0 then

begin

for i := 1 to MaxSize do

begin

GlobalArray[i] := GetNextNumber; // ustaw element tablicy

Sleep(3 + Random(12)); // pozwól działać innemu wątkowi

end;

end;

ReleaseMutex(hMutex);

end;

procedure TMainForm.ThreadsDone(Sender: TObject);

var

i: Integer;

begin

Inc(DoneFlags);

if DoneFlags = 2 then // upewnij się, że zwolniono obydwa wątki

begin

for i := 1 to MaxSize do

{ wypełnij listę zawartością tablicy }

Listbox1.Items.Add(IntToStr(GlobalArray[i]));

CloseHandle(hMutex);

end;

end;

procedure TMainForm.Button1Click(Sender: TObject);

begin

hMutex := CreateMutex(nil, False, nil);

// Utwórz i uruchom wątki

TFooThread.Create(False);

TFooThread.Create(False);

end;

end.

Istotą mechanizmu wzajemnego wykluczenia jest w powyższym przykładzie oczekiwanie wątku na dostęp do zaso­bu, realizowane przez następującą funkcję API:

function WaitForSingleObject(

hHandle: THandle; dwMilliseconds : DWORD):DWORD;stdcall;

Funkcja powoduje, że wątek czeka tak długo, aż obiekt reprezentowany przez uchwyt hHandle znajdzie się w tzw. stanie sygnalnym (signaled state) — nie dłużej jed­nak, niż przez czas określony przez parametr dwMilliseconds. Określenie „stan sygnalny” ma różne znaczenia w stosunku do różnych typów obiektów Win32, na przykład muteks znajduje się w stanie sygnalnym, gdy żaden wątek nie jest jego właścicielem, zaś proces wchodzi w stan sygnalny z chwilą swego zakończenia.

Limit czasu oczekiwania, określony przez drugi parametr, wyrażony jest w milisekun­dach; podanie wartości INFINITE oznacza oczekiwanie do skutku. Podanie zerowego limitu oczekiwania powoduje jedynie sprawdzenie statusu obiektu i natychmiastowy powrót do wątku wywołującego.

Wynikiem funkcji może być jedna z trzech wartości, których znaczenie wyjaśnia tabela 5.3.

Tabela 5.3. Znaczenie wyniku zwracanego przez funkcję WaitForSingleObject()

Wartość	Znaczenie
WAIT_ABANDONED	Przedmiotem oczekiwania jest obiekt muteks. Wątek będący jego właścicielem zakończył się, nie dokonując jednak jego zwolnienia; mamy więc do czynienia z muteksem porzuconym (abandoned). Kolejnym właścicielem wątku staje się wątek wywołujący (tj. wątek, który utworzył wątek właśnie zakończony). W rezultacie muteks nie znajduje się więc w stanie sygnalnym.
WAIT_OBJECT_0	Przedmiotowy obiekt znalazł się w stanie sygnalnym.
WAIT_TIMEOUT	Został wyczerpany limit czasu oczekiwania, przedmiotowy obiekt nie znajduje się w stanie sygnalnym.

W procedurze FooThread.Execute() realizowane jest oczekiwanie do skutku. Po „doczekaniu się” wątek staje się właścicielem muteksu, zwalnianego następnie za pomocą procedury ReleaseMutex(). Tworzony muteks nie posiada początkowo ani właściciela, ani nazwy i jest identyfikowany jedynie przez uchwyt. Jego właścicie­lem staje się wątek, który wykonuje w stosunku do niego funkcję WaitForSingleOb­ject(), używając jego uchwytu jako pierwszego parametru. Ów stosunek własności ustaje w momencie wywołania przez wątek funkcji ReleaseMutex() — muteks wchodzi wówczas w stan sygnalny.

Wskazówka

Win32 oferuje także bardziej skomplikowany wariant oczekiwania — oczeki­wanie na stan sygnalny jednego lub większej liczby obiektów z zadanego ich zbioru. Do jego realizacji służą funkcje WaitForMultipleObjects() oraz MsgWait­ForMultipleObjects(), opisane w systemie pomocy Win32 API.

Semafory

Pod względem funkcjonalnym semafor (semaphore) podobny jest do muteksu, po­siada jednak dodatkowe wyposażenie w postaci licznika, którego wartość zależna jest od liczby synchronizowanych wątków (pokażemy za chwilę, w jaki sposób). Niezerowa (dodat­nia) wartość tego licznika oznacza stan sygnalny semafora. Do utworzenia semafora służy funkcja CreateSemaphore():

function CreateSemaphore

(lpSemaphoreAttributes:PSecurityAttributes;

lInitialCount, lMaximumCount: Longint;

lpName: PChar): THandle; stdcall;

Parametry lpSemaphoreAttributes i lpName mają takie samo znaczenie, jak w przy­padku funkcji CreateMutex().

Parametr lInitialCount określa początkową war­tość licznika semafora — nie może ona wykraczać poza zakres 0÷lMaximumCount.

Każdorazowe wystąpienie semafora jako parametru wywołania funkcji WaitForSin­gleObject() (lub analogicznej funkcji powodującej oczekiwanie) zmniejsza o jeden jego licznik (chyba że ma on w tym momencie wartość zero — o tym za chwilę) i vice versa — licznik ten jest zwiększany po każdym wywołaniu procedury ReleaseSema­phore(). Nietrudno się więc domyślić, iż wartość lMaximumCount określa maksymal­ną liczbę zasobów, które zostaną „przepuszczone” przez semafor, czyli — w momencie użycia semafora jako parametru wywołania funkcji synchronizującej (np. WaitForSin­gleObject()) zastaną go z dodatnią wartością licznika. Wyjaśnia to jednocześnie ty­powe zastosowanie semafora — służy on do synchronizacji dostępu do zasobu, który może być współdzielony przez co najwyżej zadaną a priori liczbę procesów; liczba ta jest jednocześnie wartością początkową licznika semafora.

Powracając do naszego przykładu z inicjowaniem tablicy — może być ona „obsługiwa­na” w danej chwili przez co najwyżej jeden wątek — jeżeli więc użyjemy do synchroni­zacji semafora, jego wartość początkowa (lInitialCount) powinna wynosić właśnie 1.

Poniższy wydruk, pochodzący z projektu Sema4.dpr, przedstawia ostatnią już wersję dwuwątkowego inicjowania tablicy, oczy­wiście z wykorzystaniem semafora.

Wydruk 5.7. Synchronizacja dostępu do tablicy za pomocą semafora

unit Main;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

StdCtrls;

type

TMainForm = class(TForm)

Button1: TButton;

ListBox1: TListBox;

procedure Button1Click(Sender: TObject);

private

procedure ThreadsDone(Sender: TObject);

end;

TFooThread = class(TThread)

protected

procedure Execute; override;

end;

var

MainForm: TMainForm;

implementation

{$R *.DFM}

const

MaxSize = 128;

var

NextNumber: Integer = 0;

DoneFlags: Integer = 0;

GlobalArray: array[1..MaxSize] of Integer;

hSem: THandle = 0;

function GetNextNumber: Integer;

begin

Result := NextNumber; // zwróć wartość zmiennej globalnej

Inc(NextNumber); // zwiększ zmienną globalną

end;

procedure TFooThread.Execute;

var

i: Integer;

WaitReturn: DWORD;

begin

OnTerminate := MainForm.ThreadsDone;

WaitReturn := WaitForSingleObject(hSem, INFINITE);

if WaitReturn = WAIT_OBJECT_0 then

begin

for i := 1 to MaxSize do

begin

GlobalArray[i] := GetNextNumber; // ustaw element tablicy

Sleep(3 + Random(12)); // pozwól działać innym wątkom

end;

end;

ReleaseSemaphore(hSem, 1, nil);

end;

procedure TMainForm.ThreadsDone(Sender: TObject);

var

i: Integer;

begin

Inc(DoneFlags);

if DoneFlags = 2 then // upewnij się, że obydwa wątki zostały zwolnione

begin

for i := 1 to MaxSize do

{ wypełnij listę zawartością tablicy }

Listbox1.Items.Add(IntToStr(GlobalArray[i]));

CloseHandle(hSem);

end;

end;

procedure TMainForm.Button1Click(Sender: TObject);

begin

hSem := CreateSemaphore(nil, 1, 1, nil);

// utwórz i uruchom obydwa wątki

TFooThread.Create(False);

TFooThread.Create(False);

end;

end.

Utworzenie semafora następuje bezpośrednio przed utworzeniem obydwu wątków (war­tością początkową licznika semafora jest 1, co przed chwilą już wyjaśniliśmy):

hSem := CreateSemaphore(nil, 1, 1, nil);

TFooThread.Create(False);

TFooThread.Create(False);

Przed rozpoczęciem krytycznej pętli inicjującej elementy tablicy wywoływana jest funk­cja synchronizująca WaitForSingleObject(), odwołująca się do semafora za pośred­nictwem jego uchwytu hSem:

WaitReturn := WaitForSingleObject(hSem, INFINITE);

Rozpoczęcie realizacji pętli odbywa się tylko wtedy, gdy oczekiwanie zakończyło się na skutek stanu sygnalnego semafora:

if WaitReturn = WAIT_OBJECT_0

then

…

Wątek, opuszczając krytyczną pętlę (stanowiącą w tym wypadku rodzaj zasobu o synchronizo­wanym dostępie) sygnalizuje ten fakt przez wywołanie funkcji ReleaseSemaphore():

Function ReleaseSemaphore(hSEmaphore: THandle; lReleaseCount: Longint;

lpPreviousCount: Pointer): BOOL; stdcall;

Pierwszym parametrem wywołania jest oczywiście uchwyt semafora używanego do syn­chronizacji. Parametr lReleaseCount określa, o ile należy zwiększyć wartość licznika semafora — musi to być wartość dodatnia, niekoniecznie równa 1 (choć akurat w tym przypadku jest).

Możliwość zwiększenia licznika semafora o więcej niż 1 w pojedynczym wywołaniu funkcji ReleaseSemaphore() okazuje się czasem niezwykle przydatna. Jako przykład rozpatrzmy aplikację, w ramach której większa liczba wątków drugorzędnych wykorzy­stuje współbieżnie jakiś zasób, zdolny „obsłużyć” jednocześnie co najwyżej 10 z nich. Je­denasty wątek, zgłaszając żądanie dostępu do zasobu, napotka na zerową wartość semafo­ra i będzie musiał poczekać. Załóżmy teraz, iż podczas tego oczekiwania wszystkie 10 wątków zakończyło się w sposób awaryjny i żaden z nich nie zdążył „podnieść” semafo­ra, tj. wywołać funkcji ReleaseSemaphore(). Efekt jest taki, iż aktualnie żaden wątek z zasobu nie korzysta, lecz dostęp do niego jest w dalszym ciągu zablokowany, gdyż licz­nik semafora ma wartość 0. W tej sytuacji wątek główny mógł­by (po wykonaniu ewentualnych czynności „naprawczych”) zadecydować o ponownym udostępnieniu zasobu — musiałby w tym celu zwiększyć odpowiednio wartość licznika, właśnie o 10. Z powyższego opisu wynika jednocześnie „kosmopolityczny” charakter semaforów — żaden semafor nie jest przynależny do żadnego szczególnego wątku, a więc wszystkie wątki mogą używać go bez ograniczeń.

Innym ciekawym wykorzystaniem procedury ReleaseSemaphore() — sugerowanym przez system pomocy Delphi — jest zablokowanie dostępu do chronionego zasobu na czas wykonywania przez wątek lub aplikację pewnych czynności inicjujących. Semafor jest tworzony z zerową wartością początkową licznika, co chwilowo blokuje dostęp do zasobu; ostateczne nadanie licznikowi semafora żądanej (dodatniej) wartości początkowej następuje właśnie za pomocą funkcji ReleaseSemaphore().

Próba zwiększenia licznika semafora ponad ustalony limit (określony przez trzeci parametr funk­cji CreateSemaphore()) nie powiedzie się — funkcja ReleaseSemaphore() zwróci wartość FALSE.

Ostatni parametr wywołania funkcji ReleaseSemaphore() — lpPreviousCount — umożliwia wskazanie zmiennej typu longint, do której wpisana zostanie poprzednia wartość licznika — tj. ta sprzed wywołania funkcji; podanie wartości NIL oznacza rezy­gnację z tej możliwości. Może to dziwne, ale nie istnieje w Win32 możliwość odczytania bieżącej wartości licznika semafora; można ją ustalić jedynie post factum, w ten właśnie sposób.

Jak każdy obiekt Win32 identyfikowany przez uchwyt, również semafor podlega zwol­nieniu za pomocą procedury CloseHandle().

Przykład zastosowania wielowątkowości: zaawansowane wyszukiwanie tekstu

Opisane mechanizmy pracy wielowątkowej zilustrujemy na przykładzie rzeczywistej apli­kacji, służącej do wyszukiwania podanego ciągu znaków w grupie plików tekstowych. Jej kompletny projekt o nazwie DelSrch.dpr znajduje się na załączonym krążku CD-ROM; formularz główny tego projektu przedstawiamy na rysunku 5.6.

Rysunek 5.6. Formularz główny projektu DelSrch.dpr

Właściwe wyszukiwanie odbywa się w ramach wątku drugorzędnego, wątek główny zajmuje się natomiast obsługą interfejsu użytkownika, pozwalającego ustalić różnorodne aspekty przeszukiwania — lokalizację przeszukiwanych plików, ich maskę, postać ra­portu wyszukiwania itd. Rozpoczęcie wyszukiwania następuje w momencie kliknięcia przycisku Szukaj; przeszukane zostają wszystkie pliki, których nazwa pasuje do podanego wzorca, zlokalizowane w podanym katalogu oraz (jeżeli użytkownik sobie tego zażyczy) również w jego podkatalogach. Stwierdzenie obecności poszukiwanego wzorca w danym pliku spowoduje dodanie nazwy tego pliku do listy, opcjonalnie wraz z wykazem linii zawierających wzorzec. Wygląd listy jest na bieżąco uaktualniany w oknie raportu.

Dwukrotne kliknięcie linii zawierającej nazwę pliku spowoduje uruchomienie skojarzonej z tym pli­kiem aplikacji; przy braku skojarzenia uruchamiany jest notatnik (notepad).

Przyjrzyjmy się teraz modułom realizującym obydwa wątki aplikacji: za interfejs użytkownika odpowiedzialny jest moduł Main.Pas, zaś implementację wątku przeszukującego zawiera moduł SrchU.Pas.

Interfejs użytkownika

Moduł implementujący interfejs użytkownika zawie­ra wiele interesujących elementów — ilustruje m.in. zarządzanie listami wyboru, uru­chamianie aplikacji skojarzonych z plikami, przeglądanie plików, tworzenie i urucha­mianie wątków pobocznych, drukowanie wyników, zapis i odczyt pliku .ini itp. Jego treść została przedstawiona na wydruku 5.8.

Wydruk 5.8. Moduł główny aplikacji realizujący interfejs użytkownika

unit Main;

interface

uses

SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,

Forms, Dialogs, StdCtrls, Buttons, ExtCtrls, Menus, SrchIni,

SrchU, ComCtrls, AppEvnts;

type

TMainForm = class(TForm)

lbFiles: TListBox;

StatusBar: TStatusBar;

pnlControls: TPanel;

PopupMenu: TPopupMenu;

FontDialog: TFontDialog;

pnlOptions: TPanel;

gbParams: TGroupBox;

LFileSpec: TLabel;

LToken: TLabel;

lPathName: TLabel;

edtFileSpec: TEdit;

edtToken: TEdit;

btnPath: TButton;

edtPathName: TEdit;

gbOptions: TGroupBox;

cbCaseSensitive: TCheckBox;

cbFileNamesOnly: TCheckBox;

cbRecurse: TCheckBox;

cbRunFromAss: TCheckBox;

pnlButtons: TPanel;

btnSearch: TBitBtn;

btnClose: TBitBtn;

btnPrint: TBitBtn;

btnPriority: TBitBtn;

Font1: TMenuItem;

Clear1: TMenuItem;

Print1: TMenuItem;

N1: TMenuItem;

Exit1: TMenuItem;

ApplicationEvents: TApplicationEvents;

procedure btnSearchClick(Sender: TObject);

procedure btnPathClick(Sender: TObject);

procedure lbFilesDrawItem(Control: TWinControl; Index: Integer;

Rect: TRect; State: TOwnerDrawState);

procedure Font1Click(Sender: TObject);

procedure FormDestroy(Sender: TObject);

procedure FormCreate(Sender: TObject);

procedure btnPrintClick(Sender: TObject);

procedure btnCloseClick(Sender: TObject);

procedure lbFilesDblClick(Sender: TObject);

procedure FormResize(Sender: TObject);

procedure btnPriorityClick(Sender: TObject);

procedure edtTokenChange(Sender: TObject);

procedure Clear1Click(Sender: TObject);

procedure ApplicationEventsHint(Sender: TObject);

private

procedure ReadIni;

procedure WriteIni;

public

Running: Boolean;

SearchPri: Integer;

SearchThread: TSearchThread;

procedure EnableSearchControls(Enable: Boolean);

end;

var

MainForm: TMainForm;

implementation

{$R *.DFM}

uses Printers, ShellAPI, FileCtrl, PriU, StrUtils;

procedure PrintStrings(Strings: TStrings);

{ Wydruk wszystkich pozycji z listy Strings }

var

Prn: TextFile;

I: Integer;

begin

if Strings.Count = 0 then // czy jest co drukować?

raise Exception.Create('Brak tekstu do wydruku!');

AssignPrn(Prn); // przypisz Prn do drukarki

try

Rewrite(Prn); // otwórz plik drukarki

try

for I := 0 to Strings.Count - 1 do // iteracja po pozycjach listy

WriteLn(Prn, Strings.Strings[I]); // pisz na drukarkę

finally

CloseFile(Prn); // zamknij plik drukarki

end;

except

on EInOutError do

MessageDlg('Błąd drukowania.', mtError, [mbOk], 0);

end;

end;

procedure TMainForm.EnableSearchControls(Enable: Boolean);

{ Sterowanie dostępnością poszczególnych elementów interfejsu użytkownika }

begin

btnSearch.Enabled := Enable;

cbRecurse.Enabled := Enable;

cbFileNamesOnly.Enabled := Enable;

cbCaseSensitive.Enabled := Enable;

btnPath.Enabled := Enable;

edtPathName.Enabled := Enable;

edtFileSpec.Enabled := Enable;

edtToken.Enabled := Enable;

Running := not Enable; // ustaw flagę Running

edtTokenChange(nil);

with btnClose do

begin

if Enable then

begin

Caption := 'Zamknij';

Hint := 'Zamknij aplikację';

end

else begin

Caption := 'Zatrzymaj';

Hint := 'Zatrzymaj przeszukiwanie';

end;

end;

end;

procedure TMainForm.btnSearchClick(Sender: TObject);

{ Wywołanie wątku wyszukującego }

begin

EnableSearchControls(False); // zablokuj kontrolki

lbFiles.Clear; // wyczyść listę

{ uruchom wątek wywołujący }

SearchThread := TSearchThread.Create(cbCaseSensitive.Checked,

cbFileNamesOnly.Checked, cbRecurse.Checked, edtToken.Text,

edtPathName.Text, edtFileSpec.Text);

end;

procedure TMainForm.edtTokenChange(Sender: TObject);

begin

btnSearch.Enabled := not Running and (edtToken.Text <> '');

end;

procedure TMainForm.btnPathClick(Sender: TObject);

{ Wybór lokalizacji plików }

var

ShowDir: string;

begin

ShowDir := edtPathName.Text;

if SelectDirectory('Wybierz katalog...', '', ShowDir) then

edtPathName.Text := ShowDir;

end;

procedure TMainForm.lbFilesDrawItem(Control: TWinControl;

Index: Integer; Rect: TRect; State: TOwnerDrawState);

{ rysowanie specyficzne listy }

var

CurStr: string;

begin

with lbFiles do

begin

CurStr := Items.Strings[Index];

Canvas.FillRect(Rect);

if not cbFileNamesOnly.Checked then // jeśli nie tylko nazwy plików...

{ jeżeli bieżąca linia zawiera nazwę pliku }

if (Pos('Plik ', CurStr) = 1) and

(CurStr[Length(CurStr)] = ':') then

with Canvas.Font do

begin

// podkreślone i na czerwono

Style := [fsUnderline];

Color := clRed;

end

else

Rect.Left := Rect.Left + 15; // w przeciwnym razie wcięcie

DrawText(Canvas.Handle, PChar(CurStr), Length(CurStr), Rect,

DT_SINGLELINE);

end;

end;

procedure TMainForm.Font1Click(Sender: TObject);

{ Wybór czcionki }

begin

if FontDialog.Execute

then

lbFiles.Font := FontDialog.Font;

end;

{ Odczyt/zapis pliku .INI podczas tworzenia/zwalniania formularza }

procedure TMainForm.FormCreate(Sender: TObject);

begin

ReadIni;

end;

procedure TMainForm.FormDestroy(Sender: TObject);

begin

WriteIni;

end;

procedure TMainForm.btnPrintClick(Sender: TObject);

{ użytkownik wyraża chęć drukowania }

begin

if MessageDlg('Czy wydrukować wyniki poszukiwania??', mtConfirmation,

[mbYes, mbNo], 0) = mrYes

then

PrintStrings(lbFiles.Items);

end;

procedure TMainForm.btnCloseClick(Sender: TObject);

begin

// jeśli trwa przeszukiwanie, zakończ wątek przeszukujący

if Running then SearchThread.Terminate

// w przeciwnym razie zakończ aplikację

else Close;

end;

procedure TMainForm.lbFilesDblClick(Sender: TObject);

{ obsługa dwukrotnego kliknięcia linii zawierającej nazwę pliku }

var

ProgramStr, FileStr: string;

RetVal: THandle;

begin

{ jeśli kliknięto linię zawierającą nazwę pliku.. }

if (Pos('Plik ', lbFiles.Items[lbFiles.ItemIndex]) = 1) then

begin

{ załaduj edytor tekstowy zgodnie z plikiem INI - domyślnie Notepad }

ProgramStr := SrchIniFile.ReadString('Defaults', 'Editor', 'notepad');

FileStr := lbFiles.Items[lbFiles.ItemIndex]; // wybrany plik

FileStr := Copy(FileStr, 6, Length(FileStr) - 5); // usuń prefiks

if FileStr[Length(FileStr)] = ':'

then // usuń ":"

DecStrLen(FileStr, 1);

if cbRunFromAss.Checked then

{ uruchom skojarzony program }

RetVal := ShellExecute(Handle, 'open', PChar(FileStr), nil, nil,

SW_SHOWNORMAL)

else

{ uruchom edytor }

RetVal := ShellExecute(Handle, 'open', PChar(ProgramStr),

PChar(FileStr), nil, SW_SHOWNORMAL);

{ sprawdź poprawność wykonania }

if RetVal < 32 then RaiseLastWin32Error;

end;

end;

procedure TMainForm.FormResize(Sender: TObject);

{ Obsługa zdarzenia OnResize. Wyśrodkowuje kontrolki na formularzu }

begin

{ podziel pasek statusu na dwa panele w stosunku 1:2 }

with StatusBar do

begin

Panels[0].Width := Width div 3;

Panels[1].Width := Width * 2 div 3;

end;

end;

procedure TMainForm.btnPriorityClick(Sender: TObject);

{ Wyświetl formularz priorytetów }

begin

ThreadPriWin.Show;

end;

procedure TMainForm.ReadIni;

{ Odczytaj ustawienia z pliku INI }

begin

with SrchIniFile do

begin

edtPathName.Text := ReadString('Defaults', 'LastPath', 'C:\');

edtFileSpec.Text := ReadString('Defaults', 'LastFileSpec', '*.*');

edtToken.Text := ReadString('Defaults', 'LastToken', '');

cbFileNamesOnly.Checked := ReadBool('Defaults', 'FNamesOnly', False);

cbCaseSensitive.Checked := ReadBool('Defaults', 'CaseSens', False);

cbRecurse.Checked := ReadBool('Defaults', 'Recurse', False);

cbRunFromAss.Checked := ReadBool('Defaults', 'RunFromAss', False);

Left := ReadInteger('Position', 'Left', Left);

Top := ReadInteger('Position', 'Top', Top);

Width := ReadInteger('Position', 'Width', Width);

Height := ReadInteger('Position', 'Height', Height);

end;

end;

procedure TMainForm.WriteIni;

{ zapisz ustawienia w pliku INI }

begin

with SrchIniFile do

begin

WriteString('Defaults', 'LastPath', edtPathName.Text);

WriteString('Defaults', 'LastFileSpec', edtFileSpec.Text);

WriteString('Defaults', 'LastToken', edtToken.Text);

WriteBool('Defaults', 'CaseSens', cbCaseSensitive.Checked);

WriteBool('Defaults', 'FNamesOnly', cbFileNamesOnly.Checked);

WriteBool('Defaults', 'Recurse', cbRecurse.Checked);

WriteBool('Defaults', 'RunFromAss', cbRunFromAss.Checked);

WriteInteger('Position', 'Left', Left);

WriteInteger('Position', 'Top', Top);

WriteInteger('Position', 'Width', Width);

WriteInteger('Position', 'Height', Height);

end;

end;

procedure TMainForm.Clear1Click(Sender: TObject);

begin

lbFiles.Items.Clear;

end;

procedure TMainForm.ApplicationEventsHint(Sender: TObject);

{ Wyświetlenie podpowiedzi na pasku statusu }

begin

StatusBar.Panels[0].Text := Application.Hint;

end;

end.

Co najmniej dwa elementy powyższego wydruku zasługują na szczególną uwagę. Pierw­szym jest prosta procedura PrintStrings(), drukująca wszystkie zawarte na li­ście łańcuchy. Procedura ta wykorzystuje drukarkę jako plik tekstowy, przypisując ją wpierw do zmiennej Prn typu TextFile, a następnie wykonując instrukcję Writeln dla każdego łańcucha na liście. Po wydrukowaniu łańcuchów drukarka jest zwalniana za pomocą instrukcji CloseFile().

Drugim interesującym elementem jest sposób uruchomienia programu skojarzonego z za­rejestrowanym typem plików; służy do tego funkcja API o nazwie ShellExecute(). W Windows skojarzenia oparte są na rozszerzeniach plików: jeżeli, na przykład, odnośny plik będzie posiadał rozszerzenie .PAS, jego wybranie spowoduje uru­chomienie Delphi.

Wskazówka

W sytuacji, gdy wywołanie funkcji ShellExecute() nie powiedzie się (zwróco­ny wynik będzie mniejszy od 32), aplikacja wywołuje procedurę RaiseLastWin­32Error(). Procedura ta, zlokalizowana w module SYSUTILS.PAS, pobiera (za pomocą funkcji GetLastError()) kod ostatniego błędu i na jego podstawie wy­świetla czytelny komunikat::

procedure RaiseLastWin32Error;

var

LastError: DWORD;

Error: EWin32Error;

begin

LastError := GetLastError;

if LastError <> ERROR_SUCCESS then

Error := EWin32Error.CreateFmt(SWin32Error,

[LastError, SysErrorMessage(LastError)])

else

Error := EWin32Error.Create(SUnkWin32Error);

Error.ErrorCode := LastError;

raise Error;

end;

Czyni to z niej użyteczne narzędzie do czytelnego informowania użytkownika apli­kacji o zaistniałych błędach Win32 API i tym samym — rekomenduje ją jako narzędzie dla projektantów.

Proces przeszukiwania

Wątek realizujący przeszukiwanie również obfituje w ciekawostki. Demonstru­je on m.in. zasto­sowanie rekursji do obsługi podkatalogów oraz komunikację z wątkiem głównym. Treść jego modułu SrchU.Pas przedstawiono na wydruku 5.9.

Wydruk 5.9. Moduł realizujący wątek przeszukujący

unit SrchU;

interface

uses Classes, StdCtrls;

type

TSearchThread = class(TThread)

private

LB: TListbox;

CaseSens: Boolean;

FileNames: Boolean;

Recurse: Boolean;

SearchStr: string;

SearchPath: string;

FileSpec: string;

AddStr: string;

FSearchFile: string;

procedure AddToList;

procedure DoSearch(const Path: string);

procedure FindAllFiles(const Path: string);

procedure FixControls;

procedure ScanForStr(const FName: string; var FileStr: string);

procedure SearchFile(const FName: string);

procedure SetSearchFile;

protected

procedure Execute; override;

public

constructor Create(CaseS, FName, Rec: Boolean; const Str, SPath,

FSpec: string);

destructor Destroy; override;

end;

implementation

uses SysUtils, StrUtils, Windows, Forms, Main;

constructor TSearchThread.Create(CaseS, FName, Rec: Boolean; const Str,

SPath, FSpec: string);

begin

CaseSens := CaseS;

FileNames := FName;

Recurse := Rec;

SearchStr := Str;

SearchPath := AddBackSlash(SPath);

FileSpec := FSpec;

inherited Create(False);

end;

destructor TSearchThread.Destroy;

begin

FSearchFile := '';

Synchronize(SetSearchFile);

Synchronize(FixControls);

inherited Destroy;

end;

procedure TSearchThread.Execute;

begin

FreeOnTerminate := True; // zwolnij wątek po zakończeniu

LB := MainForm.lbFiles;

Priority := TThreadPriority(MainForm.SearchPri);

if not CaseSens then SearchStr := UpperCase(SearchStr);

FindAllFiles(SearchPath); // bieżący katalog

if Recurse then //

DoSearch(SearchPath); // i podkatalogi

end;

procedure TSearchThread.FixControls;

// Odblokowuje kontrolki na formularzu; musi być wywoływana przez Synchronize()

begin

MainForm.EnableSearchControls(True);

end;

procedure TSearchThread.SetSearchFile;

{ Uaktualnia nazwę pliku na pasku statusu;

musi być wywoływana przez Synchronize() }

begin

MainForm.StatusBar.Panels[1].Text := FSearchFile;

end;

procedure TSearchThread.AddToList;

{ Dodaje pozycję do listy; musi być wywoływana przez Synchronize() }

begin

LB.Items.Add(AddStr);

end;

procedure TSearchThread.ScanForStr(const FName: string;

var FileStr: string);

{ Skanuje FileStr w celu znalezienia nazwy pliku }

var

Marker: string[1];

FoundOnce: Boolean;

FindPos: integer;

begin

FindPos := Pos(SearchStr, FileStr);

FoundOnce := False;

while (FindPos <> 0) and not Terminated do

begin

if not FoundOnce then

begin

{ użyj ":" , jeśli nie "tylko nazwy plików" }

if FileNames then

Marker := ''

else

Marker := ':';

{ dodaj linię z nazwą pliku do listy }

AddStr := Format('Plik %s%s', [FName, Marker]);

Synchronize(AddToList);

FoundOnce := True;

end;

{ nie poszukuj dalszych wystąpień wzorca, jeśli "tylko nazwy plików" }

if FileNames then Exit;

{ Dodaj linię, jeśli nie "tylko nazwy plików"}

AddStr := GetCurLine(FileStr, FindPos);

Synchronize(AddToList);

FileStr := Copy(FileStr, FindPos + Length(SearchStr),

Length(FileStr));

FindPos := Pos(SearchStr, FileStr);

end;

end;

procedure TSearchThread.SearchFile(const FName: string);

var

DataFile: THandle;

FileSize: Integer;

SearchString: string;

begin

FSearchFile := FName;

Synchronize(SetSearchFile);

try

DataFile := FileOpen(FName, fmOpenRead or fmShareDenyWrite);

if DataFile = 0 then raise Exception.Create('');

try

{ ustaw długość przeszukiwanego łańcucha }

FileSize := GetFileSize(DataFile, nil);

SetLength(SearchString, FileSize);

{ Kopiuj zawartość pliku do łańcucha }

FileRead(DataFile, Pointer(SearchString)^, FileSize);

finally

CloseHandle(DataFile);

end;

if not CaseSens then SearchString := UpperCase(SearchString);

ScanForStr(FName, SearchString);

except

on Exception do

begin

AddStr := Format('Błąd odczytu pliku: %s', [FName]);

Synchronize(AddToList);

end;

end;

end;

procedure TSearchThread.FindAllFiles(const Path: string);

{ wyszukuje pliki we wskazanym katalogu }

var

SR: TSearchRec;

begin

// rozpocznij szukanie plików

if FindFirst(Path + FileSpec, faArchive, SR) = 0 then

try

repeat

SearchFile(Path + SR.Name); // przetwórz plik

until (FindNext(SR) <> 0) or Terminated; // następny plik

finally

SysUtils.FindClose(SR); // zakończ szukanie plików

end;

end;

procedure TSearchThread.DoSearch(const Path: string);

{ rekursywne przetwarzanie katalogów }

var

SR: TSearchRec;

begin

{ rozpocznij szukanie katalogów }

if FindFirst(Path + '*.*', faDirectory, SR) = 0 then

try

repeat

{ jeśli katalog różny od '.' i '..' }

if ((SR.Attr and faDirectory) <> 0) and (SR.Name[1] <> '.') and

not Terminated then

begin

FindAllFiles(Path + SR.Name + '\'); // przetwórz katalog

DoSearch(Path + SR.Name + '\'); // i jego podkatalogi

end;

until (FindNext(SR) <> 0) or Terminated; // znajdź następny katalog

finally

SysUtils.FindClose(SR); // zakończ szukanie

end;

end;

end.

Zasadniczą akcję wątku przeszukującego można podzielić na dwa etapy. W pierwszym zostają przeszukane pliki bieżącego katalogu, których nazwa pasuje do zadanej maski; czynność tę wykonuje procedura FindAllFiles(), toteż cały pierwszy etap sprowa­dza się do jej wywołania. Drugi etap, wykonywany tylko wtedy, gdy zażądano przeszu­kiwania podkatalogów, polega na wykonaniu procedury FindAllFiles() we wszyst­kich podkatalogach katalogu bieżącego; określenie „wszystkie podkatalogi” rozumia­ne jest w sposób rekurencyjny i obejmuje również podkatalogi dalszych rzędów. Reku­rencja ta znajduje swoje odzwierciedlenie w kodzie programu — wykonanie procedury DoSearch() w stosunku do danego katalogu polega na wykonaniu najpierw w stosunku do niego samego procedury FindAllFiles(), a następnie — procedury DoSearch() w sto­sunku do wszystkich jego (i tylko jego) podkatalogów.

Wskazówka

Rekurencyjny algorytm stosowany przez procedurę DoSearch() jest standardową techniką przetwarzania drzewa katalogów. Ponieważ algorytmy rekurencyjne są z natury trudne w śledzeniu, szczególnie cennymi algorytmami tej kategorii są algorytmy już przetestowane i pracujące bez zarzutu — jak procedura DoSearch(), którą można polecić jako narzędzie uniwersalne.

Należy zwrócić uwagę na pewną subtelność kryjącą się w rekurencyjnym przeszukiwa­niu katalogów. Otóż funkcje FindFirst()i FindNext(), wśród znalezionych nazw katalogów udostępniają również pozycje '.' oraz '..' nie stanowiące podkatalogów w zwykłym tego słowa znaczeniu — jak wiadomo, pierwsza z nich ozna­cza dany katalog jako samego siebie, druga zaś reprezentuje jego katalog nadrzędny. Uwzględnienie tych pozycji na równi z „prawdziwymi” pod­katalogami podczas rekurencyjnego ich przeszukiwania doprowadziłoby do zapętlenia się procedury DoSearch() już na pierwszym katalogu. Stąd też drugi warunek w instrukcji

if ((SR.Attr and faDirectory) <> 0) and (SR.Name[1] <> '.')
and …

Kompletny algorytm przeszukujący realizowany jest w następujących etapach:

1. Gdy procedura FindAllFiles() znajdzie kolejny plik, którego nazwa pasuje do zadanej maski, wywoływana jest dla niego metoda SearchFile().

2. Metoda SearchFile() wczytuje zawartość pliku do łańcucha (za pomocą funkcji FileRead()); dla tego łańcucha przydzielana jest uprzednio pamięć o rozmiarze równym rozmiarowi pliku (za pomocą procedury SetLength()). Jeżeli podczas przeszukiwania nieistotna jest wielkość liter, łańcuch jest „normalizowany” przez zamianę jego znaków na duże litery.

3. Metoda SearchFile() wywołuje metodę ScanForStr(). Metoda ScanForStr() przeszukuje łańcuch w celu znalezienia żądanego wzorca. Jeżeli wzorzec zostanie znaleziony, do wynikowej listy dodawana jest pozycja zawierająca nazwę pliku; jeżeli na formularzu nie jest zaznaczone pole „Tylko nazwy plików”, do listy dodawane są również pozycje reprezentujące poszczególne wystąpienia wzorca w łańcuchu.

Zwróć uwagę, iż większość metod wątku dokonuje okresowo sprawdzenia właściwości Terminate w celu ewentualnego przerwania (na żądanie) realizacji wątku.

Nie zapominaj, iż wszelkie odwołania wątku przeszukującego do komponentów formularza muszą odbywać się za pośrednictwem metody Synchronize(); przekonaj się, iż jest tak istotnie.

Zmiana priorytetu wątku przeszukującego

Dodatkową opcją programu DelSrch jest możliwość dynamicznej zmiany priorytetu względnego wątku przeszukującego. Formularz spełniający to zadanie przedstawiony jest na rysunku 5.7, a na wydruku 5.10 prezentujemy treść odpowiadającego mu modułu źródłowego.

Rysunek 5.7. Formularz ustalania priorytetu wątku przeszukującego

Wydruk 5.10. Dynamiczna zmiana priorytetu wątku

unit PriU;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls, ComCtrls, Buttons, ExtCtrls;

type

TThreadPriWin = class(TForm)

tbrPriTrackBar: TTrackBar;

Label1: TLabel;

Label2: TLabel;

Label3: TLabel;

btnOK: TBitBtn;

btnRevert: TBitBtn;

Panel1: TPanel;

procedure tbrPriTrackBarChange(Sender: TObject);

procedure btnRevertClick(Sender: TObject);

procedure FormClose(Sender: TObject; var Action: TCloseAction);

procedure FormShow(Sender: TObject);

procedure btnOKClick(Sender: TObject);

procedure FormCreate(Sender: TObject);

private

{ Private declarations }

OldPriVal: Integer;

public

{ Public declarations }

end;

var

ThreadPriWin: TThreadPriWin;

implementation

{$R *.DFM}

uses Main, SrchU;

procedure TThreadPriWin.tbrPriTrackBarChange(Sender: TObject);

begin

with MainForm do

begin

SearchPri := tbrPriTrackBar.Position;

if Running then

SearchThread.Priority := TThreadPriority(tbrPriTrackBar.Position);

end;

end;

procedure TThreadPriWin.btnRevertClick(Sender: TObject);

begin

tbrPriTrackBar.Position := OldPriVal;

end;

procedure TThreadPriWin.FormClose(Sender: TObject;

var Action: TCloseAction);

begin

Action := caHide;

end;

procedure TThreadPriWin.FormShow(Sender: TObject);

begin

OldPriVal := tbrPriTrackBar.Position;

end;

procedure TThreadPriWin.btnOKClick(Sender: TObject);

begin

Close;

end;

procedure TThreadPriWin.FormCreate(Sender: TObject);

begin

tbrPriTrackBarChange(Sender); // ustaw początkowy priorytet wątku

end;

end.

Treść powyższego modułu nie jest skomplikowana — sprowadza się do uaktualniania priorytetu wątku stosownie do jednego z pięciu możliwych położeń suwaka; zadanie to wykonywane jest w procedurze Pri­TrackBarChange(). Bieżący priorytet jest dodatkowo zapisywany w polu Search­Pri formularza głównego, możliwe jest więc zachowanie priorytetu przeszukiwania po­między kolejnymi uruchomieniami wątku przeszukującego.

Wielowątkowy dostęp do BDE

Problematyką obsługi baz danych w Delphi zajmiemy się szczegółowo w dalszych rozdziałach niniejszej książki, obecnie chcielibyśmy jednak zademonstrować wyjątkową użyteczność pracy wielowąt­kowej w trakcie operowania bazami danych, a ściślej — podczas wyszukiwania informacji. Je­żeli niektóre używane tu pojęcia będą dla Ciebie niezrozumiałe, możesz znaleźć ich wy­jaśnienie m.in. w rozdziale 7.

Najbardziej cenną własnością baz danych w Win32 jest niewątpliwie możliwość realiza­cji złożonych zapytań i procedur zapamiętanych (stored procedures) w tle, nieza­leżnie od dialogu prowadzonego z użytkownikiem, przez co aplikacja wyraźnie zysku­je na mobilności. Jest to możliwe dzięki 32-bitowej bibliotece obsługi baz danych, zwa­nej Borland Database Engine (w skrócie BDE). Wykorzystanie tej możliwości jest jednak obwarowane dwoma ograniczeniami:

• Każde zapytanie formułowane w ramach odrębnego wątku musi dokonywać się w odrębnej sesji. Wymóg ten realizuje się za pomocą komponentu TSession, którego nazwa (właściwość Name) powinna być przypisana do właściwości SessionName komponentu TQuery. Oznacza to jednocześnie, iż jeżeli komponent TQuery komunikuje się z komponentem TDatabase, to każda sesja musi używać odrębnych komponen­tów tej klasy.

• Nie wolno kojarzyć komponentu TQuery z komponentem TDataSource, je­żeli w ramach wątku drugorzędnego otwarte zostało zapytanie; kojarzenie ta­kie może odbywać się wyłącznie w kontekście wątku głównego. Staje się to zrozumiałe, jeżeli uświadomimy sobie rolę komponentu TDataSource — stanowi on środek komunikacji pomiędzy zbiorem danych a komponentami interfejsu użytkownika; te ostatnie mogą być obsługiwane jedynie w kontekście wątku głównego.

Na załączonym krążku CD-ROM znajduje się projekt o nazwie BdeThrd.dpr, ilustrujący wielowątkowe zapytania; jego formularz główny jest przedstawiony na rysunku 5.8.

Rysunek 5.8. Formularz główny projektu BdeThrd.dpr

Po wybraniu konkretnego aliasu bazy danych, zalogowaniu się, wpisaniu zapytania i kliknięciu przycisku Wykonaj nastąpi uruchomienie nowego wątku, z dynamicznie tworzonym formularzem klasy TQueryForm, zawierającym po jednym komponencie TQuery, TSession, TDatabase, TDBGrid i TDataSource. Każde zapytanie obsługiwane jest więc przez odrębny zestaw komponentów, możliwe jest zatem otwarcie kilku zapytań jednocześnie. Przykład trzech formularzy, wyświetlających wyniki trzech różnych zapytań jest przedstawiony na rysunku 5.9.

Rysunek 5.9. Formularze wyświetlające wyniki trzech niezależnych zapytań

Treść modułu głównego projektu została przedstawiona na wydruku 5.11.

Wydruk 5.11. Moduł główny projektu BdeThrd.dpr

unit Main;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,

Dialogs, Grids, StdCtrls, ExtCtrls;

type

TMainForm = class(TForm)

pnlBottom: TPanel;

pnlButtons: TPanel;

btnGo: TButton;

btnExit: TButton;

memQuery: TMemo;

pnlTop: TPanel;

Label1: TLabel;

cbAlias: TComboBox;

Label3: TLabel;

edUserName: TEdit;

Label4: TLabel;

edPassword: TEdit;

Label2: TLabel;

procedure btnExitClick(Sender: TObject);

procedure btnGoClick(Sender: TObject);

procedure FormCreate(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

MainForm: TMainForm;

implementation

{$R *.DFM}

uses QryU, DB, DBTables;

var

FQueryNum: Integer = 0;

procedure TMainForm.btnExitClick(Sender: TObject);

begin

Close;

end;

procedure TMainForm.btnGoClick(Sender: TObject);

begin

Inc(FQueryNum); // unikatowy numer zapytania

{ wygeneruj nowe zapytanie }

NewQuery(FQueryNum, memQuery.Lines, cbAlias.Text, edUserName.Text,

edPassword.Text);

end;

procedure TMainForm.FormCreate(Sender: TObject);

begin

{ wypełnij listę dostępnymi aliasami }

Session.GetAliasNames(cbAlias.Items);

end;

end.

Nie dzieje się tu zbyt wiele: po utworzeniu formularza lista rozwijalna AliasCombo wypełniana jest zarejestrowany­mi w systemie aliasami baz danych — za pomocą metody GetAliasNames komponentu TSession. Po kliknięciu przycisku Wykonaj następuje wywołanie procedury NewQuery(), wykonującej kompletną obsługę nowego zapytania; zauważ, iż poszczególne zapytania są zliczane (za pomocą licznika FQueryNum), a kolejny numer zapytania przekazywany jest jako parametr do procedury, która wykorzystuje go do stworzenia unikatowej nazwy sesji. Procedura NewQuery() jest centralną częścią modułu QryU.PAS, zawierającego ponadto definicję formularza QueryForm. Jego kod źródłowy jest przedstawiony na wydruku 5.12.

Wydruk 5.12. Kod źródłowy formularza TQueryForm

unit QryU;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,

Grids, DBGrids, DB, DBTables, StdCtrls;

type

TQueryForm = class(TForm)

Query: TQuery;

DataSource: TDataSource;

QuerySession: TSession;

QueryDatabase: TDatabase;

dbgQueryGrid: TDBGrid;

memSQL: TMemo;

procedure FormClose(Sender: TObject; var Action: TCloseAction);

private

{ Private declarations }

public

{ Public declarations }

end;

procedure NewQuery(QryNum: integer; Qry: TStrings; const Alias, UserName,

Password: string);

implementation

{$R *.DFM}

type

TDBQueryThread = class(TThread)

private

FQuery: TQuery;

FDataSource: TDataSource;

FQueryException: Exception;

procedure HookUpUI;

procedure QueryError;

protected

procedure Execute; override;

public

constructor Create(Q: TQuery; D: TDataSource); virtual;

end;

constructor TDBQueryThread.Create(Q: TQuery; D: TDataSource);

begin

inherited Create(True); // utwórz zawieszony wątek

FQuery := Q; // ustaw parametry

FDataSource := D;

FreeOnTerminate := True;

Resume; // uruchom wątek

end;

procedure TDBQueryThread.Execute;

begin

try

FQuery.Open; // otwórz zapytanie

Synchronize(HookUpUI); // uaktualnij interfejs użytkownika

// w kontekście wątku głównego

except

FQueryException := ExceptObject as Exception;

Synchronize(QueryError); // poinformuj o wyjątku, w ramach

// wątku głównego

end;

end;

procedure TDBQueryThread.HookUpUI;

begin

FDataSource.DataSet := FQuery;

end;

procedure TDBQueryThread.QueryError;

begin

Application.ShowException(FQueryException);

end;

procedure TQueryForm.FormClose(Sender: TObject; var Action: TCloseAction);

begin

Action := caFree;

end;

procedure NewQuery(QryNum: integer; Qry: TStrings; const Alias, UserName,

Password: string);

begin

{ Stwórz nowy formularz dla wyświetlenia wyników zapytania }

with TQueryForm.Create(Application) do

begin

{ Wygeneruj unikatową nazwę sesji }

QuerySession.SessionName := Format('Sess%d', [QryNum]);

with QueryDatabase do

begin

{ ustaw unikatową nazwę bazy danych }

DatabaseName := Format('DB%d', [QryNum]);

{ ustaw alias }

AliasName := Alias;

{ przyłącz TDatabase do TSession }

SessionName := QuerySession.SessionName;

{ nazwa użytkownika i hasło }

Params.Values['USER NAME'] := UserName;

Params.Values['PASSWORD'] := Password;

end;

with Query do

begin

{ przyłącz TQuery do TDatabase i TSession }

DatabaseName := QueryDatabase.DatabaseName;

SessionName := QuerySession.SessionName;

{ ustaw treść zapytania }

SQL.Assign(Qry);

end;

{ wyświetl treść zapytania w MEMO }

memSQL.Lines.Assign(Qry);

{ wyświetl formularz zapytania }

Show;

{ otwórz zapytanie w ramach odrębnego wątku }

TDBQueryThread.Create(Query, DataSource);

end;

end;

end.

Procedura NewQuery() tworzy nowy egzemplarz formularza TQueryForm, nadaje wy­magane wartości właściwościom jego komponentów, w szczególności — przypisuje unikatowe nazwy komponentom TDatabase i TSession. Właściwość SQL komponentu TQuery wy­pełniana jest treścią zapytania pobieraną z komponentu TMemo na formularzu głównym (w postaci listy łańcuchów przekazywanej jako parametr Qry). Ostatnia instrukcja procedury tworzy nowy wątek realizujący zapytanie.

Na kilka słów komentarza zasługuje też metoda Execute() wątku TDBQueryThread. W jej treści wywoływana jest metoda HookUpUI(), dokonująca kojarzenia komponentu TDataSource z komponentami TQuery i TDBGrid — zgodnie z tym, co napisaliśmy nieco wcześniej, przypisanie to musi się odbyć w kontekście wątku głównego, dlatego też „obudowa­ne” zostało metodą Synchronize(). To samo tyczy się metody QueryError(), wywoływanej w przypadku wystąpienia wy­jątku podczas realizacji metody Execute().

Wielowątkowe operacje graficzne

Wspominaliśmy już wcześniej, iż dostęp do formularza i jego komponentów zarezerwowany jest dla wątku głównego — stąd właśnie wynikła konieczność opracowania metody Syn­chronize() dla klasy TThread. Począwszy od Delphi 3, reguła ta została nieco złago­dzona, mianowicie: wątek poboczny ma prawo wykonywać operacje graficzne na płót­nie (Canvas) komponentu pod warunkiem, iż przed ich rozpoczęciem zapewni sobie wyłączność dostępu do tegoż płótna, wywołując jego metodę Lock(). Po zakoń­czeniu rysowania powinien on natomiast wywołać metodę UnLock(), zwalniając w ten spo­sób nałożoną na płótno blokadę dostępu dla innych wątków.

Działanie metod Lock() i UnLock() przypomina do złudzenia mechanizm sekcji kry­tycznych; istotnie, zostały one zrealizowane za pomocą tego właśnie mechanizmu:

procedure TCanvas.Lock;

begin

EnterCriticalSection(CounterLock);

Inc(FLockCount);

LeaveCriticalSection(CounterLock);

EnterCriticalSection(FLock);

end;

…

procedure TCanvas.UnLock;

begin

LeaveCriticalSection(FLock);

EnterCriticalSection(CounterLock);

Dec(FLockCount);

LeaveCriticalSection(CounterLock);

end;

Jak łatwo zauważyć, szeregowanie dostępu do płótna odbywa się za pomocą sekcji kry­tycznej FLock. Tajemniczy licznik FLockCount związany jest z jeszcze jedną metodą płótna dotyczącą jego rezerwacji, mianowicie — TryLock():

function TCanvas.TryLock: Boolean;

begin

EnterCriticalSection(CounterLock);

try

Result := FLockCount = 0;

if Result

then

Lock;

finally

LeaveCriticalSection(CounterLock);

end;

end;

Zgodnie ze swą nazwą, funkcja ta usiłuje dokonać rezerwacji płótna; sprawdza jed­nak wpierw, czy płótno nie jest aktualnie zarezerwowane, to znaczy, czy wartość licznika FLockCount równa jest zero. Jeżeli tak, dokonuje rzeczywistej rezerwacji (Lock) i zwraca wartość True. Niezerowa wartość licznika FLockCount oznacza, iż któryś z wątków znajduje się aktualnie w sekcji krytycznej i próba rezerwacji spowodowałaby oczekiwanie; w takiej sytuacji metoda rezygnuje z rezerwacji i zwraca wartość False.

Metoda TryLock() realizuje więc polecenie „zarezerwuj płótno pod warunkiem, że ak­tualnie jest ono wolne”. Zwróć uwagę, że testowanie i zmiana licznika FLockCount są chronione przez inną sekcję krytyczną — CounterLock.

Prezentacja wielowątkowego dostępu do płótna jest przedmiotem przykładowego projektu MTgraph.dpr, znajdującego się na załączonym krążku CD-ROM. Kod źródłowy jego modułu głównego przedstawiamy na wydruku 5.13.

Wydruk 5.13. Ilustracja wielowątkowych operacji graficznych na płótnie komponentu

unit Main;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,

Menus, Dialogs;

type

TMainForm = class(TForm)

MainMenu1: TMainMenu;

Options1: TMenuItem;

AddThread: TMenuItem;

RemoveThread: TMenuItem;

ColorDialog1: TColorDialog;

Add10: TMenuItem;

RemoveAll: TMenuItem;

procedure FormCreate(Sender: TObject);

procedure FormDestroy(Sender: TObject);

procedure AddThreadClick(Sender: TObject);

procedure RemoveThreadClick(Sender: TObject);

procedure Add10Click(Sender: TObject);

procedure RemoveAllClick(Sender: TObject);

private

ThreadList: TList;

public

{ Public declarations }

end;

TDrawThread = class(TThread)

private

FColor: TColor;

FForm: TForm;

public

constructor Create(AForm: TForm; AColor: TColor);

procedure Execute; override;

end;

var

MainForm: TMainForm;

implementation

{$R *.DFM}

{ TDrawThread }

constructor TDrawThread.Create(AForm: TForm; AColor: TColor);

begin

FColor := AColor;

FForm := AForm;

inherited Create(False);

end;

procedure TDrawThread.Execute;

var

P1, P2: TPoint;

procedure GetRandCoords;

var

MaxX, MaxY: Integer;

begin

// ulokuj punkty P1 i P2 w losowym położeniu w granicach formularza

MaxX := FForm.ClientWidth;

MaxY := FForm.ClientHeight;

P1.x := Random(MaxX);

P2.x := Random(MaxX);

P1.y := Random(MaxY);

P2.y := Random(MaxY);

end;

begin

FreeOnTerminate := True;

// wątek powinien skończyć się razem z zakończeniem aplikacji

while not (Terminated or Application.Terminated) do

begin

GetRandCoords; // ulokuj losowo punkty P1 i P2

with FForm.Canvas do

begin

Lock; // zablokuj płótno

// w danej chwili co najwyżej jeden wątek może realizować

// poniższy fragment:

Pen.Color := FColor; // ustaw kolor pióra

MoveTo(P1.X, P1.Y); // narysuj odcinek łaczący punkty P1 i P2

LineTo(P2.X, P2.Y); //

// koniec krytycznego fragmentu

UnLock; // odblokuj płótno

end;

end;

end;

{ TMainForm }

procedure TMainForm.FormCreate(Sender: TObject);

begin

ThreadList := TList.Create;

end;

procedure TMainForm.FormDestroy(Sender: TObject);

begin

RemoveAllClick(nil);

ThreadList.Free;

end;

procedure TMainForm.AddThreadClick(Sender: TObject);

begin

// dodaj nowy wątek do listy; pozwól użytkownikowi wybrać kolor pióra

if ColorDialog1.Execute

then

ThreadList.Add(TDrawThread.Create(Self, ColorDialog1.Color));

end;

procedure TMainForm.RemoveThreadClick(Sender: TObject);

begin

// zakończ ostatni wątek listy i usuń go z listy

TDrawThread(ThreadList[ThreadList.Count - 1]).Terminate;

ThreadList.Delete(ThreadList.Count - 1);

end;

procedure TMainForm.Add10Click(Sender: TObject);

var

i: Integer;

begin

// utwórz 10 wątków, przypisując im losowe kolory pióra

for i := 1 to 10 do

ThreadList.Add(TDrawThread.Create(Self, Random(MaxInt)));

end;

procedure TMainForm.RemoveAllClick(Sender: TObject);

var

i: Integer;

begin

Cursor := crHourGlass;

try

for i := ThreadList.Count - 1 downto 0 do

begin

TDrawThread(ThreadList[i]).Terminate; // zakończ wątek

TDrawThread(ThreadList[i]).WaitFor; // upewnij się, że wątek faktycznie

// się zakończył

end;

ThreadList.Clear;

finally

Cursor:= crDefault;

end;

end;

initialization

Randomize; // uruchom generator liczb pseudolosowych

end.

Formularz projektu jest przedstawiony na rysunku 5.10. Pierwsze polecenie z menu Opcje umożliwia uruchomienie nowego wątku (klasy TDrawThread) dokonującego kreślenia na płótnie formularza odcinków linii prostych w sposób losowy; użytkownik ma możliwość wybrania koloru kreślonych linii. Używając tej opcji wielokrotnie możemy uruchomić dowolną liczbę wątków. Drugie polecenie menu umożliwia usunięcie wątku ostatnio uruchomionego. Dwa pozostałe polecenia umożliwiają (odpowiednio) uruchomienie dziesięciu nowych wątków (posługujących się losowo wybranymi kolorami) i usunięcie wszystkich uruchomionych wątków pobocznych. Wygląd formularza na rysunku 5.10 to efekt równoczesnego działania dziesięciu wątków.

Rysunek 5.10. Efekt wielowątkowego kreślenia linii prostych na płótnie formularza

Tak więc dzięki prostym metodom TCanvas.Lock() oraz TCanvas.UnLock() wątki poboczne mogą wykonywać operacje na płótnach komponentów formularza, unikając przy tym kosztownej czasowo metody Synchronize(). Co więcej, wszystkie meto­dy Paint() komponentów VCL, a także obsługa wszystkich zdarzeń OnPaint, odby­wają się z udziałem metod Lock()/UnLock() — zatem bezpośrednie rysowanie po płótnie komponentu nie koliduje nawet ze standardowymi operacjami biblioteki VCL.

Zastanówmy się na koniec, co stałoby się, gdybyśmy zezwolili na „żywiołowe” rysowanie po płótnach komponentów bez żadnej synchronizacji. Rozpatrzmy w tym celu dwa wątki, z których pierwszy narysować chce linię w kolorze niebieskim, drugi zaś — okrąg w ko­lorze czerwonym. Przypuśćmy więc, iż pierwszy wątek ustawił już niebieski kolor pióra i zdążył narysować część linii, gdy został wywłaszczony na rzecz drugiego wątku; ten ustawił czerwony kolor pióra i narysował część okręgu, lecz sterowanie wróciło tymczasem do wątku pierwszego. Nietrudno skonstatować, iż pozostała część linii nary­sowana zostanie w kolorze czerwonym. To tylko jeden z możliwych scenariuszy — przy większej liczbie wątków (oczywiście — puszczonych „na żywioł”) i bardziej skompli­kowanych operacjach graficznych mogą dziać się rzeczy jeszcze ciekawsze.

Notabene w celu spowodowania opisanego wyżej chaosu wystarczy, by tylko jeden z wątków wyłamał się z przyjętego protokołu i nie „przejmował się” koniecznością blokowania i odblokowywania płótna.

Włókna

Włókna (fibers) są obiektami Win32 stanowiącymi (koncepcyjnie) coś na kształt miniatur wątków. Podobnie jak wątki, włókna dysponują własnym kontekstem wykonawczym, posiadając odrębne obszary stosu i chronioną zawartość rejestrów procesora. Jednak, w przeciwieństwie do wątków, nie są one wywłaszczane przez system operacyjny z czasu procesora — więc za przełączanie włókien odpowiedzialna jest sama aplikacja.

Z punktu widzenia projektanta aplikacji przypadki, w których włókna okazują się bardziej użyteczne od „rasowych” wątków, są raczej rzadkie; włókna mają nad wątkami tę przewagę, iż oferując oddzielny kontekst wykonawczy nie wymagają jednocześnie stosowania zaawansowanych mechanizmów synchronizacyjnych, bo przełączanie włókien odbywa się całkowicie pod kontrolą aplikacji.

Wskazówka

Włókna dostępne są w Windows NT 3.51 SP3 i wyższym, Windows NT 4.0, Windows 2000/XP oraz Windows 98/Me.

Nadzorowaniem pracy włókien zajmuje się sam wątek, należy jednak wpierw utworzyć równoważne mu włókno; czynność tę wykonuje następująca funkcja API:

function ConvertThreadToFiber(lpParameter: Pointer): BOOL; stdcall;

Jedynym jej parametrem jest wskaźnik do danych specyficznych dla włókna, przekazywanych do niego przez wątek wywołujący i nie mających znaczenia dla Win32 API. Powyższa deklaracja zaczerpnięta z modułu windows.pas jest jednak, niestety, niepoprawna: w rzeczywistości wynikiem funkcji jest bowiem wskaźnik do włókna (jako obiektu Win32), nie zaś wartość boolowska.

Kiedy wątek utworzy już równoważne mu włókno, może tworzyć i usuwać nowe włókna oraz oczywiście dokonywać przełączania pomiędzy nimi. Do utworzenia nowego włókna służy funkcja CreateFiber():

function CreateFiber(dwStackSize: DWORD;

lpStartAddress: TFNFiberStartRoutine;

lpParameter: Pointer): BOOL; stdcall;

Parametr dwStackSize oznacza początkowy rozmiar stosu przydzielanego dla włókna; podanie wartości zerowej spowoduje przydzielenie stosu o rozmiarze domyślnym, równym rozmiarowi stosu wątku nadrzędnego. Parametr lpStartAddress jest wskaźnikiem do bezparametrowej procedury realizującej treść włókna. Parametr lpParameter umożliwia przekazanie do tworzonego włókna dodatkowych danych. Podobnie jak w przypadku funkcji ConvertThreadToFiber(), deklaracja wyniku również jest niepoprawna, gdyż i tym razem wynik jest wskaźnikiem do obiektu reprezentującego utworzone włókno.

Przełączaniem pomiędzy działającymi włóknami zajmuje się następująca funkcja:

function SwitchToFiber(lpFiber: Pointer): BOOL; stdcall;

Również i ta deklaracja jest błędna, ponieważ w rzeczywistości jest to procedura nie zwracająca żadnego wyniku. Jedynym parametrem jej wywołania jest wskaźnik do obiektu włókna. Wywołanie procedury SwitchToFiber() powoduje automatyczne przełączenie kontekstu wykonawczego — czyli przełączenie stosu i rejestrów procesora.

Usuwaniem włókien zajmuje się funkcja DeleteFiber():

function DeleteFiber(lpFiber: Pointer): BOOL; stdcall;

W rzeczywistości jest ona — podobnie jak SwitchToFiber() — procedurą nie zwracającą wyniku, błędnie zadeklarowaną jako funkcja. Jej jedynym parametrem wywołania jest oczywiście wskaźnik do obiektu włókna.

Wskazówka

Wywołanie procedury DeleteFiber() z parametrem określającym włókno wywołujące — czyli swoiste „samobójstwo” włókna — powoduje automatyczne wywołanie funkcji ExitThread(), kończącej wykonywanie całego wątku.

Zarządzanie włóknami sprowadza się więc do operowania czterema opisanymi funkcjami. Pliki nagłówkowe Win32 deklarują ponadto kilka pomocniczych funkcji i typów, nie włączonych jednak do Delphi. Na użytek projektu ilustrującego wykorzystanie włókien stworzyliśmy więc mały moduł uzupełniający Fibers.pas, którego treść jest przedstawiona na wydruku 5.14.

Wydruk 5.14. Moduł Fibers.pas

unit Fibers;

interface

uses Windows;

// typ reprezentujący procedurę startową włókna (na podstawie winbase.h)

type

PFIBER_START_ROUTINE = procedure (lpFiberParameter: Pointer); stdcall;

LPFIBER_START_ROUTINE = PFIBER_START_ROUTINE;

TFiberFunc = PFIBER_START_ROUTINE;

function GetCurrentFiber: Pointer;

function GetFiberData: Pointer;

implementation

// specyficzne dla procesorów 80x86 funkcje pomocnicze (na podstawie winnt.h):

function GetCurrentFiber: Pointer;

asm

mov eax, fs:[$10]

end;

function GetFiberData: Pointer;

asm

mov eax, fs:[$10]

mov eax, [eax]

end;

end.

Wspomniany projekt znajduje się na załączonym krążku CD-ROM i nosi nazwę FibTest.dpr. Wygląd jego formularza jest przedstawiony na rysunku 5.11, natomiast treść jego modułu głównego prezentujemy na wydruku 5.15.

Rysunek 5.11. Formularz projektu ilustrującego działanie włókien

Wydruk 5.15. Moduł główny projektu Fibtest.dpr

unit FibMain;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls, AppEvnts;

type

TForm1 = class(TForm)

BtnWee: TButton;

BtnStop: TButton;

Label1: TLabel;

Label2: TLabel;

Label3: TLabel;

Label4: TLabel;

AppEvents: TApplicationEvents;

procedure BtnWeeClick(Sender: TObject);

procedure AppEventsMessage(var Msg: tagMSG;

var Handled: Boolean);

procedure BtnStopClick(Sender: TObject);

private

{ Private declarations }

FThreadID: LongWord;

FThreadHandle: Integer;

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

uses Fibers;

{$R *.dfm}

const

DDG_THREADMSG = WM_USER;

var

FFibers: array[0..3] of Pointer;

StopIt: Boolean;

procedure FiberFunc(Param: Pointer); stdcall;

var

J, FibNum, NextNum: Integer;

I: Cardinal;

Fiber: Pointer;

begin

try

I := 0;

FibNum := 1; // to tylko po to, by wyeliminować

// ostrzeżenia ze strony kompilatora

Fiber := GetCurrentFiber; // zachowaj wskaźnik do obiektu bieżącego włókna

// odszukanie numeru bieżącego włókna w tablicy

for J := Low(FFibers) to High(FFibers) do

if FFibers[J] = Fiber then

begin

FibNum := J;

Break;

end;

// odliczanie od zera w górę

while not StopIt do

begin

{A. Grażyński}

Application.ProcessMessages; // pozwól aplikacji na przetworzenie komunikatów

// po osiągnięciu kolejnej setki wyślij komunikat do wątku głównego

if I mod 100 = 0 then

PostMessage(Application.Handle, DDG_THREADMSG, Integer(GetFiberData), I);

// po osiągnięciu kolejnego tysiąca przełącz włókna

if I mod 1000 = 0 then

begin

if FibNum = High(FFibers)

then

NextNum := Low(FFibers)

else

NextNum := FibNum + 1;

SwitchToFiber(FFibers[NextNum]);

end;

Inc(I);

end;

except

// zignoruj nieobsłużone wyjątki

end;

end;

function ThreadFunc(Param: Pointer): Integer;

var

I: Integer;

begin

Result := 0;

// przekształć bieżący wątek we włókno

FFibers[0] := Pointer(ConvertThreadToFiber(Pointer(1)));

// otwórz pozostałe włókna

FFibers[1] := Pointer(CreateFiber(0, @FiberFunc, Pointer(2)));

FFibers[2] := Pointer(CreateFiber(0, @FiberFunc, Pointer(3)));

FFibers[3] := Pointer(CreateFiber(0, @FiberFunc, Pointer(4)));

// uruchom pierwsze włókno

FiberFunc(Pointer(1));

// zwolnij wszystkie włókna; zwolnienie bieżącego włókna spowoduje

// zakończenie wątku

for I := High(FFibers) downto Low(FFibers) do

DeleteFiber(FFibers[I]);

end;

procedure TForm1.BtnWeeClick(Sender: TObject);

begin

BtnWee.Enabled := False; // zapobiega wielokrotnemu naciśnięciu przycisku

FThreadHandle := BeginThread(nil, 0, @ThreadFunc, nil, 0, FThreadID);

end;

procedure TForm1.AppEventsMessage(var Msg: tagMSG;

var Handled: Boolean);

begin

if Msg.message = DDG_THREADMSG then

begin

// zależnie od tego, które włókno wysłało komunikat,

// zmieniona zostanie treść odpowiedniej etykiety

case Msg.wParam of

1: Label1.Caption := IntToStr(Msg.lParam);

2: Label2.Caption := IntToStr(Msg.lParam);

3: Label3.Caption := IntToStr(Msg.lParam);

4: Label4.Caption := IntToStr(Msg.lParam);

end;

Handled := True;

end;

end;

procedure TForm1.BtnStopClick(Sender: TObject);

begin

StopIt := True;

end;

end.

Najistotniejszym fragmentem powyższego wydruku jest funkcja ThreadFunc(), wykonywana w ramach wątku pobocznego w rezultacie kliknięcia przycisku Start. Tworzy ona włókno odpowiadające bieżącemu wątkowi oraz trzy dodatkowe włókna. Przedmiotem realizacji dla każdego z włókien jest funkcja FiberFunc(), dokonująca monotonnego odliczania, wysyłająca okresowo komunikat do wątku głównego i dokonująca okresowego przełączania włókien.

Wątek główny, otrzymawszy wspomniany komunikat, odczytuje z jego treści numer włókna-nadawcy i stosownie do niego uaktualnia wartość jednej z czterech etykiet na formularzu głównym — czego efekt ilustruje rysunek 5.12; zbliżone wartości wszystkich czterech etykiet są pośrednio świadectwem tego, iż każde włókno działa we własnym obszarze stosu.

Rysunek 5.12. Aplikacja FibTest w akcji

Podsumowanie

W niniejszym rozdziale opisaliśmy naturę wątków Win32 oraz związane z nimi mecha­nizmy Delphi. Przedstawiliśmy metody synchronizacji wątków oraz reguły przydzielania priorytetów wątkom i procesom. Praktyczną ilustracją tych mechanizmów były trzy przy­kładowe aplikacje: pierwsza z nich prowadziła proste wyszukiwanie w grupie plików tekstowych, druga realizowała równolegle zapytania SQL w odniesieniu do pojedynczej bazy danych, trzecia wreszcie wykonywała nieskomplikowane rysunki na płótnie formularza, ilustrując w ten sposób szeregowanie dostępu do płótna za pomocą jego metod Lock() i UnLock(). Na zakończenie przedstawiliśmy przykład zastosowania włókien (fibers), będących w Win32 miniaturami wątków, lecz w odróżnieniu od nich kontrolowanych całkowicie przez aplikację.

Należy jednak uważać, by nie ustawić wyrównywania pól rekordów (record field alignment) na wartość 8, gdyż wówczas pomiędzy polami rekordu TFileTime mogłyby pojawić się luki (przyp. tłum.).

W Delphi 1 jest jednak inaczej — zerowa wartość TDateTime reprezentuje początek naszej ery, czyli północ rozpoczynającą dzień 1 stycznia roku 1 (przyp. tłum.).

W tym przypadku wartości wszystkich etykiet są identyczne, choć nie zawsze tak musi być (przyp. tłum.).

2 Część I ♦ Podstawy obsługi systemu WhizBang (Nagłówek strony)

2 C:\HELION\DELPHI6VP\AGpojezykowej\05-04.doc[Author ID2: at Thu Feb 21 21:23:00 2002 ]C:\Moje dokumenty\Delphi 2\05-2.doc[Author ID3: at Thu Feb 14 09:53:00 2002 ][Author ID2: at Thu Feb 21 21:23:00 2002 ]C:\DOCUME~1\Lukosek\USTAWI~1\Temp\05-2.doc[Author ID3: at Wed Feb 13 16:37:00 2002 ]

---