Játék a szálakkal I. rész

Ennek a cikknek az apropója az volt, hogyan tudnék "fájdalom mentesen" szálat létrehozni, feladatot végeztetni vele majd felszabadítani és egyszerű legyen használni. (a fájdalom mentes itt azt jelenti, hogy ne leakel-jen a program) Mindezt Delphi környezetben.
Az alábbi szál tipikusan olyan használatra alkalmas, amikor valamilyen műveletet kell végrehajtani a háttérben és ha az befejeződött, akkor felszabadítja a szálat.

A szál kódja az alábbi:

unit UTestThread;

interface

uses
  Classes;

type
  TProgressChanged = procedure (Sender : TObject; AProgress : Integer) of object;

  TestThread = class(TThread)
  private
    { Private declarations }
    FProgress           : Integer;
    FOnProgressChanged  : TProgressChanged;
  protected
    procedure SyncDoOnProgressChanged;
    procedure DoOnProgressChanged; virtual;
    procedure Execute; override;
  public
    constructor Create(AOnProgressChangeCallBack : TProgressChanged; AOnTerminateCallBack : TNotifyEvent);
    destructor Destroy; override;

    property OnProgressChanged : TProgressChanged read FOnProgressChanged write FOnProgressChanged;
  end;

implementation

uses
  SysUtils;

{ TestThread }

constructor TestThread.Create(AOnProgressChangeCallBack: TProgressChanged;
  AOnTerminateCallBack: TNotifyEvent);
begin
  inherited Create(True);
  FreeOnTerminate := False;
  Priority := tpNormal;
  FOnProgressChanged := AOnProgressChangeCallBack;
  Self.OnTerminate := AOnTerminateCallBack;
  Resume;
end;

destructor TestThread.Destroy;
begin

  inherited Destroy;
end;

procedure TestThread.DoOnProgressChanged;
begin
  if Assigned(OnProgressChanged) then
    FOnProgressChanged(Self, FProgress);
end;

procedure TestThread.Execute;
begin
  if Terminated then
    Exit;

  FProgress := 0;
  while (FProgress < 1000) and
        (not Terminated)
  do
    begin
      Inc(FProgress);
      SyncDoOnProgressChanged;
      Sleep(100);
    end;
end;

procedure TestThread.SyncDoOnProgressChanged;
begin
  Synchronize(DoOnProgressChanged);
end;

end.

A szál létrehozásakor a szál konstruktorában két callback függvényt kell megadni. Az egyik ami a folyamat állapotát aktualizálja, a másik pedig a szál befejeződésekor hívódik meg.

A szálat vezérlő modul kódja pedig így néz ki:

...
const
  WM_FREE_THREAD  = WM_USER + 1;

type
  TfrmMainTest = class(TForm)
    btnStart: TButton;
    ed1: TEdit;
    btnStop: TButton;
    procedure btnStartClick(Sender: TObject);
    procedure btnLeakClick(Sender: TObject);
    procedure btnStopClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
    FThread : TestThread;

    procedure OnThreadFinished(Sender : TObject);
    procedure OnProgressChanged(Sender : TObject; AProgress : Integer);
    procedure StopWorkerThread;
  public
    { Public declarations }
    procedure WndProc(var Message: TMessage); override;

    destructor Destroy; override;
  end;

var
  frmMainTest: TfrmMainTest;

implementation

uses Math;

{$R *.dfm}

procedure TfrmMainTest.btnStartClick(Sender: TObject);
begin
  btnStart.Enabled := False;
  if not Assigned(FThread) then
    begin
      FThread := TestThread.Create(OnProgressChanged, OnThreadFinished);
    end;
end;

procedure TfrmMainTest.OnProgressChanged(Sender: TObject;
  AProgress: Integer);
begin
  ed1.Text := IntToStr(AProgress);
end;

procedure TfrmMainTest.OnThreadFinished(Sender: TObject);
begin
  PostMessage(Handle, WM_FREE_THREAD, 0, 0);
end;

procedure TfrmMainTest.StopWorkerThread;
begin
  if (FThread <> nil) then
    begin
      FThread.Terminate;
      FThread.WaitFor;
      FreeAndNil(FThread);
      btnStart.Enabled := True;
    end;
end;

procedure TfrmMainTest.WndProc(var Message: TMessage);
begin
  if (Message.Msg = WM_FREE_THREAD) then
    StopWorkerThread
  else
    inherited WndProc(Message);
end;

procedure TfrmMainTest.btnStopClick(Sender: TObject);
begin
  if Assigned(FThread) then
    begin
      FThread.Terminate;
    end;
end;

destructor TfrmMainTest.Destroy;
begin

  inherited Destroy;
end;

procedure TfrmMainTest.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  StopWorkerThread;
end;
...

Az elindított szál minden esetben felszabadul és a szál futása is megszakítható.

File méretének lekérdezés WinAPI használatával

Az alábbi függvénnyel egy állomány méretét lehet lekérdezni. A lekérdezéshez a GetFileAttributesEx WinAPI függvényt használom fel.
A függvény a 2GiB -nál nagyobb méretű állományok méretét is helyesen adja vissza (nincs túlcsordulás), mert a visszatérési érték Int64-ben van.

function GetFileSize(AFileName : String) : Int64;
var
  rData : WIN32_FILE_ATTRIBUTE_DATA;
  iSize : Int64;
begin
  Result := 0;
  if GetFileAttributesEx(PChar(AFileName), GetFileExInfoStandard, @rData) then
    begin
      iSize := rData.nFileSizeHigh;
      iSize := iSize shl 32;
      iSize := iSize + rData.nFileSizeLow;
      Result := iSize;
    end;
end;

Thread-safe TCounter osztály

interface

type
  TCounter = class
  public
     constructor Create;
     function GetCounter : Integer;
  end;

var
  Counter : Integer;
  CriticalSection : TRtlCriticalSection;

implementation

constructor TCounter.Create;
begin

  inherited;
  EnterCriticalSection(CriticalSection);
  try
    Counter := Counter + 1;
  finally
    LeaveCriticalSection(CriticalSection);
  end;
end;

function TCounter.GetCounter : Integer;
begin
  // nem kell kritikus tartomány, mert az Integer
  // elemi változó
  Result := Counter;
end;

initialization
  InitializeCriticalSection(CriticalSection);
finalization
  DeleteCriticalSection(CriticalSection);
end.

Debug konzol ablakkal

Win32 alkalmazásban nyomkövetési funkcióra használhatunk konzol ablakot. Ehhez a főprogramban az AllocConsole WinApi hívást kell betenni. Ezután a programban a Write, WriteLn metódusok használhatók nyomkövetési célra.

program test_application;

uses
  ..
  Windows,
  ..;

{$R *.res}

begin
  AllocConsole;
  Application.Initialize;
  ...
  Application.Run;
  FreeConsole;
end.

Form TopMost tulajdonságának beállítása

Néha szükség lehet arra, hogy egyes ablakok mindig legfelül "topmost" módon jelenjenek meg. Ezt egy egyszerű WinAPI trükkel lehet megoldani (persze létezik erre más módszer is).

procedure TfrmDlgCommonSyncProgress.FormShow(Sender: TObject);
begin
  SetWindowPos(
    Self.Handle,
    HWND_TOPMOST,
    0,
    0,
    0,
    0,
    SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOSIZE);
end;

Persze ugyanezt a hatást lehet elérni, ha az adott form CreateParams metódusának felülírásával is.

Flyweight minta alkalmazása

A Flyweight (pehelysúlyú) szerkezeti objektum minta megvalósítása Delphi alatt. Ezt a mintát valósítja meg a TCollection és TCollectionItem osztály. Ezt a gyakorlatban olyan esetekben szoktam használni, amikor dinamikusan összetett adatokat kell kezelni és a hagyományos tömb szerkezet ehhez nem nyújt kellő rugalmasságot.

A TCollection és TCollectionItem osztályokból származtatott saját konténer osztályok alkalmazásával ki lehet aknázni az OOP által nyújtott előnyöket mint például a kollekcióba szervezett adatok belső integritásának védelme, vagy az adatok állapot változásának esemény kezelése saját eseménykezelők használatával (pl. ha a kollekcióban egy elem állapota megváltozik, akkor egy eseménykezelőben kezelni lehessen a bekövetkezett változásokat).

A Flyweight minta megvalósítása örökléssel a TCollection és TCollectionItem osztályokból (ez csak egy kód csontváz, amit igazából az adott célnak megfelelően kell elkészíteni, kiegészíteni a feladathoz leginkább illeszkedő mezőkkel, metódusokkal) Kollekció elem csontváz osztály interface része:

interface

uses
  Classes, ...;

type
  TMyCustomDataItem = class(TCollectionItem)
  private
    // itt kell definiálni azokat a mezők tároló változóit,
    // amit majd a külvilág felé publikálni szeretnénk tulajdonságokon
    // keresztül
    FMyIntField    : Integer;
    FMyStringField : String;
    ...
  public
    constructor Create(Collection: TCollection); override;
    ...
    property MyIntField : Integer read FMyIntField write FMyIntField;
    property MyStringField : String read FMyStringField write FMyStringField;
    ...
  end;

A kollekció elem publikált mezőihez lehet getter/setter metódusokat definiálni, ezt a konkrét feladat dönti el, hogy mire van szükségünk. Ha például eseményt szeretnénk kiváltani, ha egy elemnek (TCollectionItem) megváltozik a belső állapota, akkor a figyelni kívánt tulajdonság setter metódusát kell "felokosítani" erre a feladatra, hogy az állapot változásról értesítse ki a kollekciót kezelő objektumot (TCollection). Kollekció csontváz osztály interface része:

  ...
  TMyCustomDataCollection = class(TCollection)
  private
    function GetMyCustomDataItem(Index : Integer) : TMyCustomDataItem;
    procedure SetMyCustomDataItem(Index : Integer; 
      const Value : TMyCustomDataItem);
  public
    destructor Destroy; override;

    function Add : TMyCustomDataItem; overload;
    function Add(AMyInt : Integer; AMyString : String) : TMyCustomDataItem; overload;

    procedure DeleteAll;
    procedure OrderByMyIntField;
    property Items[Index : Integer] : TMyCustomDataItem read GetMyCustomDataItem
      write SetMyCustomDataItem;
  end;

A fenti példában a TMyCustomDataCollection osztályt felruházom rendezés funkcióval, ami a MyIntField mező szerint fogja a kollekcióban az elemeket sorba rendezni, az összes elem törlése funkció, egyedi adatokkal történő a adat inicializálás Add(1, 'MyString'). TMyCustomDataItem osztály implementációs csontváza:

...
implementation
{ TMyCustomDataItem }

constructor TMyCustomDataItem.Create(Collection: TCollection);
begin
  inherited Create(Collection);
  FMyIntField := $F0F0;
  FMyStringField := '';
  ..
  // további inicializáló utasítások
end;

TMyCustomDataCollection kollekció implementációs csontváza:

{ TMyCustomDataCollection }

destructor TMyCustomDataCollection.Destroy;
begin
  DeleteAll;
  inherited Destroy;
end;

function TMyCustomDataCollection.Add: TMyCustomDataItem;
begin
  Result := inherited Add as TMyCustomDataItem;
end;

function TMyCustomDataCollection.Add(AMyInt : Integer; AMyString : String): TMyCustomDataItem;
begin
  Result := inherited Add as TMyCustomDataItem;
  Result.MyIntField := AMyInt;
  Result.MyStringField := AMyString;
  ..
  // további értékadó utasítások
end;

procedure TMyCustomDataCollection.DeleteAll;
begin
  while (Self.Count > 0) do
    Self.Delete(0);
end;

function TMyCustomDataCollection.GetMyCustomDataItem(Index: Integer): TMyCustomDataItem;
begin
  Result := inherited Items[Index] as TMyCustomDataItem;
end;

procedure TMyCustomDataCollection.SetMyCustomDataItem(Index: Integer;
  const Value: TMyCustomDataItem);
begin
  inherited Items[Index] := Value;
end;

procedure TMyCustomDataCollection.OrderBySessionNum;
var
  iIndex        : Integer;
  iIndex2       : Integer;
  pMinItem      : TMyCustomDataItem;
  pCurrItem     : TMyCustomDataItem;
begin
  // elemek rendezése FMyInt szám szerint növekvő sorrendben
  // a min sort algoritmusnál van gyorsabb rendezés is ;)
  for iIndex := 0 to Self.Count - 1 do
    begin
      pMinItem := Self.Items[iIndex];

      for iIndex2 := iIndex to Self.Count - 1 do
        begin
          pCurrItem := Self.Items[iIndex2];
          if pCurrItem.SessionNum < pMinItem.SessionNum then
            begin
              pCurrItem.Index := pMinItem.Index;
              pMinItem := pCurrItem;
            end;
        end;
    end;
end;

A fenti csontvázak alapján a saját igényeknek megfelelően kell tovább bővíteni a kollekció és kollekció elem osztályokat.

String írása/olvasása TMemoryStream-el

Az alábbi snipet egy String tartalmának írását olvasását szemlélteti egy TMemoryStream-ben. Ez nagyon hasznos tud lenni, ha nem akarunk tömbökkel bűvészkedni. Az alábbi kód töredéket gyakran szoktam használni.

procedure TForm1.btnStreamRWTestClick(Sender: TObject);
var
  msStream  : TMemoryStream;
  sData     : String;
begin
  sData := 'Ez egy tesz szöveg';
  msStream := TMemoryStream.Create;
  try
    msStream.Clear;
    // sData tartalmának kiírása az msStream MemoryStream-be
    msStream.WriteBuffer(Pointer(sData)^, Length(sData));

    sData := 'alma';

    // msStream tartalmának visszaolvasása a sData String-be
    // sData méret beállítása !!!
    SetLength(sData, msStream.Size);
    // SData tartalmának "nullázása"
    FillChar(sData[1], msStream.Size, 0);
    // pozicionálás a MemoryStream elejére olvasás előtt
    msStream.Position := 0;               
    msStream.ReadBuffer(Pointer(sData)^, msStream.Size);

  finally
    if Assigned(msStream) then
      begin
        msStream.Clear;
        msStream.Free;
      end;
  end;
end;

próba delphi

próba delphi