Wątki i Synapse wykrycie odłączenia klienta po stronie serwera.

0

Uczę się co to sa wątki, aplikacje wielowątkowe i jak je pisać. Dorzuciłem do tego pakiet synapse bo obydwie rzeczy są mi potrzebne w moim projekcie. Zacznę może od kodów:

Kod Serwera:

unit main

unit Main;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
  blckSock, SynSock, Servers;

type

  { TfMainForm }

  TfMainForm = class(TForm)
    bStart: TButton;
    bStop: TButton;
    bClose: TButton;
    eConsole: TEdit;
    eServerStatus: TEdit;
    lServerStatus: TLabel;
    mConsole: TMemo;
    procedure bStartClick(Sender: TObject);
    procedure bStopClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormResize(Sender: TObject);
  private

  public
    Server  : TServer;
    tmpSock : TSocket;
  end;

var
  fMainForm: TfMainForm;

implementation

{$R *.lfm}

{ TfMainForm }

procedure TfMainForm.FormResize(Sender: TObject);
begin
  bStart.Top := 10;
  bStart.Left := 10;

  bStop.Top := 15 + bStart.Height;
  bStop.Left := bStart.Left;

  bClose.Top := fMainForm.Height - bClose.Height - 10;
  bClose.Left := bStart.Left;

  lServerStatus.Top := 25 + bStart.Height + bStop.Height;
  lServerStatus.Left := bStart.Left;

  eServerStatus.Top := 30 + bStart.Height + bStop.Height + lServerStatus.Height;
  eServerStatus.Left := bStart.Left;
  eServerStatus.Width := fMainForm.Width div 2 - 20;

  mConsole.Top := 0;
  mConsole.Left := fMainForm.Width div 2;
  mConsole.Width := fMainForm.Width div 2;
  mConsole.Height := fMainForm.Height - eConsole.Height - 5;

  eConsole.Top := mConsole.Height + 5;
  eConsole.Left := mConsole.Left;
  eConsole.Width := mConsole.Width - 2;
end;

procedure TfMainForm.FormCreate(Sender: TObject);
begin
  eServerStatus.Text := 'STOPPED';
end;

procedure TfMainForm.bStartClick(Sender: TObject);
begin
  eServerStatus.Text := 'Starting server...';
  Server := TServer.Create(false);
  eServerStatus.Text := 'Server running';
end;

procedure TfMainForm.bStopClick(Sender: TObject);
begin
  eServerStatus.Text := 'Stopping server...';
  FreeAndNil(Server);
  eServerStatus.Text := 'STOPPED';
end;

end.

unit servers

unit Servers;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, blckSock, SynSock, Clients;

type
  TServer = class(TThread)
    private
      fSocket  : TTCPBlockSocket;
      fCheck   : Boolean;
      fMessage : String;

      procedure ShowStatus;
    protected
      procedure Execute; override;
    public
      Socket : TSocket;
      Ilosc  : Word;
      Client : Array of TClient;

      constructor Create(CreateSuspended : Boolean);
    end;

implementation

uses Main;

constructor TServer.Create(CreateSuspended : Boolean);
begin
  fSocket := TTCPBLockSocket.Create;
  fSocket.Bind('127.0.0.1','1234');
  fSocket.Listen;
  Ilosc := 0;
  SetLength(Client,Ilosc);
  fCheck := false;
  inherited Create(CreateSuspended);
end;

procedure TServer.ShowStatus;
begin
  fMainForm.mConsole.Lines.Add(fMessage);
end;

procedure TServer.Execute;
begin
  repeat
    if fSocket.CanRead(1) then
    begin
      Socket := fSocket.Accept;
      Inc(Ilosc);
      SetLength(Client,Ilosc);
      Client[Ilosc-1] := Tclient.Create(false,Socket);
    end;
  until (Terminated);
end;

end.

unit clients

unit Clients;

{$mode objfpc}{$H+}

interface

uses
  {$ifdef unix}
  cthreads,
  cmem,
  {$endif}
  Classes, SysUtils, BlckSock, SynSock;

type
  TClient = class(TThread)
    private
      Socket : TTCPBlockSocket;
      Data   : String;
      procedure AddDataToMemo;
    protected
      procedure Execute; override;
    public
      constructor Create(CreateSuspended : Boolean; sock : TSocket);
    end;

implementation

uses Main;

constructor TClient.Create(CreateSuspended : Boolean; sock : TSocket);
begin
  FreeOnTerminate := True;
  Socket := TTCPBlockSocket.Create;
  Socket.Socket := sock;
  inherited Create(CreateSuspended);
end;

procedure TClient.AddDataToMemo;
begin
  fMainForm.mConsole.Lines.Add(Data);
end;

procedure TClient.Execute;
begin
  repeat
    Data := Socket.RecvString(1);
    If Data <> '' Then Synchronize(@AddDataToMemo);
  until (Terminated) or (Data = 'disconnect');
end;

end.

Tak wygląda kod serwera który napisałem. Serwer ten służy do testów i nauki.

kod klienta który też służy do testowania:

program Test_Client;

{$mode objfpc}{$H+}

uses
  {$IFDEF UNIX}{$IFDEF UseCThreads}
  cthreads,
  {$ENDIF}{$ENDIF}
  Classes,
  Crt, blckSock, SysUtils;

var
  Socket   : TTCPBlockSocket;
  Buff     : String;
  Data     : String;

begin
  ClrScr;
  Write('Establishing connection...');
  Socket := TTCPBLockSocket.Create;
  Socket.Connect('127.0.0.1','1234');
  If Socket.LastError <> 0 Then
  Begin
    Write ('Error: ');
    WriteLn (Socket.LastErrorDesc);
    ReadKey;
    Halt (Socket.LastError);
  end;
  WriteLn('DONE!');
  WriteLn('Input:');
  Repeat
    ReadLn(Buff);
    Data := Buff + CRLF;
    Socket.SendString(Data);
  until Buff = 'disconnect';
  FreeAndNil(Socket);
end.

I teraz mam kilka pytań:

  1. Jak wykryć po stronie serwera (czyt. tego który napisałem), że klient się odłączył? Problem sprowadza się w sumie do tego jak wykryć, że dany wątek się zakończył. Potrzebne mi to jest do zmniejszania rozmiaru tablicy która jest zwiększana przy podłączaniu klienta.

Wpadłem na pomysł by klient podczas odłączenia wysyłał jakieś dane do serwera przez co serwer będzie wiedział, że klient się odłączył ale co wtedy gdy klientowi na przykład prąd wyłączą?
Opcja druga to by serwer sprawdzał czy klient jest cały czas podłączony na przykład poprzez wysyłanie do klienta zapytania. Klient odpowie znaczy jest, klient nie odpowie odłącz go.
Opcja trzecia to połączenie opcji powyżej.
Jednak dalej zostaje pytanie jak wykryć czy dany wątek się zakończył czy nie.
Myślałem o ustawieniu w wątku FreeOnTerminate na false i potem sprawdzaniu czy Terminated = true jeśli tak to zwolnij obiekt wątku zmniejsz tablicę i tak dalej.

  1. Jak widać mam oddzielny wątek który ma za zadanie sprawdzać czy coś chce się podłączyć do serwera (oraz sprawdzać czy się odłączyło). Ten wątek jest wywoływany z wątku głównego a wątki odpowiedzialne za poszczególnych klientów są wywoływane z wątku sprawdzającego. Czy takie odpalanie wątków jest prawidłowe?

  2. Mam tablicę dynamiczną klientów która zwiększa się jeśli klient się podłączy i ma się zmniejszać jeśli się odłączy. Zmniejszanie rozmiaru tablicy dynamicznej bez utraty danych ogólnie wygląda tak

var
  DynArray : array of Integer;
  wielkosc : Word;
  i : Word;

begin
  wielkosc := 10;
  SetLength(DynArray, wielkosc);
  for i := 0 to wielkosc - 1 do
    DynArray[i] := i;

  for i := 5 to wielkosc - 1 do
    DynArray[i-1] := DynArray[i];

  dec(wielkosc);
  SetLength(DynArray, wielkosc);
end.

// Tu mogłem coś popitolić bo niestety nie jestem pewien czy coś działa jeśli tego nie przetestuję (czyt. skompiluje i odpalę).
 

Czy tak samo to działa w przypadku dynamicznej tablicy obiektów (na przykładzie mojego serwera obiektów typu TTCPBlockSocket)?

  1. I ostatnie pytanie dotyczy wątków klienta. Jak wygląda to wydajnościowo. Czy oddzielny wątek dla każdego klienta jest sensowny, czy może podzielić to jakoś, na przykład 1 wątek na 1000 klientów? I jak taki podział by wyglądał pod względem czasu dłubania w kodzie. Mi się wydaje (tak wydaje mi się bo jeszcze nie ogarniam wątków do końca), że oddzielny wątek dla każdego jest szybciej napisać niż wykrywanie który klient jest właśnie tym przy którym powinno się odpalić kolejny wątek no i potem jak liczba podłączonych klientów spadnie to myśleć jak zaprogramować by wątki przełączały między sobą obsługę danego klienta/ów i które wątki zakończyć a które zostawić by pracowały dalej. Jednak nurtuje mnie jak zachowa się system gdy do serwera podłączy się 100000 klientów i program odpali 100000 wątków. Czy 100000 wątków będzie działać tak samo szybko jak 100 wątków? W końcu obsługują tą samą liczbę klientów.
0
  1. Jak wykryć po stronie serwera (czyt. tego który napisałem), że klient się odłączył? Problem sprowadza się w sumie do tego jak wykryć, że dany wątek się zakończył. Potrzebne mi to jest do zmniejszania rozmiaru tablicy która jest zwiększana przy podłączaniu klienta.

TClient.Terminated powinno być w porządku.

Myślałem o ustawieniu w wątku FreeOnTerminate na false i potem sprawdzaniu czy Terminated = true jeśli tak to zwolnij obiekt wątku zmniejsz tablicę i tak dalej.

Tak, to powinno pomóc.

Wpadłem na pomysł by klient podczas odłączenia wysyłał jakieś dane do serwera przez co serwer będzie wiedział, że klient się odłączył ale co wtedy gdy klientowi na przykład prąd wyłączą?

function TSockConn.IsConnected: boolean;
begin
  if ((tickin+max_ping<GetMsCount)) then
     begin
     result:=false;
     end else
     begin
     if not assigned(sock) then exit(false);
     result:=sock.CanWrite(0);
     end;
end;

Opcja druga to by serwer sprawdzał czy klient jest cały czas podłączony na przykład poprzez wysyłanie do klienta zapytania. Klient odpowie znaczy jest, klient nie odpowie odłącz go.

Tak, to też jest potrzebne, zresztą widać część tego na moim kodzie (tickin+max_ping<GetMsCount).

  1. Jak widać mam oddzielny wątek który ma za zadanie sprawdzać czy coś chce się podłączyć do serwera (oraz sprawdzać czy się odłączyło). Ten wątek jest wywoływany z wątku głównego a wątki odpowiedzialne za poszczególnych klientów są wywoływane z wątku sprawdzającego. Czy takie odpalanie wątków jest prawidłowe?

Z tego co widzę tak, ALE: twoje wątki są zaprojektowane w taki sposób aby maksymalnie obciążyć nawet najwydajniejszy serwer. Po drugie to taka ilość wątków wydaje się nieoptymalna.

Czy tak samo to działa w przypadku dynamicznej tablicy obiektów (na przykładzie mojego serwera obiektów typu TTCPBlockSocket)?

Tak. Tylko nie za bardzo rozumiem używanie dodatkowej zmiennej do pamiętania wielkości, jest length(tablica).

  1. I ostatnie pytanie dotyczy wątków klienta. Jak wygląda to wydajnościowo. Czy oddzielny wątek dla każdego klienta jest sensowny, czy może podzielić to jakoś, na przykład 1 wątek na 1000 klientów? I jak taki podział by wyglądał pod względem czasu dłubania w kodzie. Mi się wydaje (tak wydaje mi się bo jeszcze nie ogarniam wątków do końca), że oddzielny wątek dla każdego jest szybciej napisać niż wykrywanie który klient jest właśnie tym przy którym powinno się odpalić kolejny wątek no i potem jak liczba podłączonych klientów spadnie to myśleć jak zaprogramować by wątki przełączały między sobą obsługę danego klienta/ów i które wątki zakończyć a które zostawić by pracowały dalej. Jednak nurtuje mnie jak zachowa się system gdy do serwera podłączy się 100000 klientów i program odpali 100000 wątków. Czy 100000 wątków będzie działać tak samo szybko jak 100 wątków? W końcu obsługują tą samą liczbę klientów.

Przełączanie wątków dla systemu operacyjnego to zadanie dosyć długie. Ja bym zrobił ileś wątków 'pracowników' które by można było ustawić i każdy z nich miałby mniej więcej tyle samo klientów którymi by się zajmował. Generalnie to w twoim wypadku rozwiązanie bezwątkowe byłoby podobnej wydajności nawet na procesorze 2rdzeniowym. Dopiero gdy mamy więcej rdzeni to parę wątków będzie się opłacać. Więc x*100 wątków będzie działać wolniej niż x ponieważ system będzie przydzielać albo za mało albo za dużo mocy na każdy wątek i będzie tracić dużo czasu na samo przełączanie wątków.

0
  1. FreeAndNil(Server); - źle - powinno być Server.Terminate
  2. To
fSocket := TTCPBLockSocket.Create;
  fSocket.Bind('127.0.0.1','1234');
  fSocket.Listen;

powinno być w metodzie Execute ponieważ w osobnym wątku dzieje się dopiero to co w tej metodzie jest. O ile w tym wypadku samo tworzenie gniazda może być w konstruktorze o tyle reszta jak najbardziej w Execute
3. do wywołania czegoś w momencie zakończenia wątku służy właśnie zdarzenie TClient.Terminated

0

powinno być w metodzie Execute ponieważ w osobnym wątku dzieje się dopiero to co w tej metodzie jest. O ile w tym wypadku samo tworzenie gniazda może być w konstruktorze o tyle reszta jak najbardziej w Execute

Z jakiej racji? Przecież konstruktor odpowiada za inicjalizację. Nic złego się nie stanie z powodu tego że socket jest tworzony w innym kontekście. To samo tyczy się destruktora i deinicjalizacji tam.

  1. FreeAndNil(Server); - źle - powinno być Server.Terminate

Racja, wątków się nie ubija tak, ale wysyła się im sygnał i czeka aż się naprawdę ubiją.

0

z takiej, że to co się dzieje w Create dzieje się w wątku głównym a nie w wątku pobocznym. O ile tutaj nic się nie stanie to trzeba mieć tego świadomość bo można potem szukać błędu długo.

0
-321oho napisał(a):

Myślałem o ustawieniu w wątku FreeOnTerminate na false i potem sprawdzaniu czy Terminated = true jeśli tak to zwolnij obiekt wątku zmniejsz tablicę i tak dalej.

Tak, to powinno pomóc.

No właśnie nie pomaga :(

Zrobiłem coś takiego

procedure TServer.Execute;
var
  i,j : Word;
begin
  repeat
    if fSocket.CanRead(1) then
    begin
      Socket := fSocket.Accept;
      Inc(Ilosc);
      SetLength(Client,Ilosc);
      Client[Ilosc-1] := TClient.Create(false,Socket);
      fMessage := 'Client connected';
      Synchronize(@ShowMessage);
      fMessage := 'Connected clients: ' + IntToStr(Ilosc);
      Synchronize(@ShowMessage);
    end;
    for i := 0 to High(Client) - 1 do
    begin
      if Client[i].Terminated Then
      begin
        FreeAndNil(Client[i]);
        for j := i to High(Client)-1 do
          Client[j]:=Client[j+1];
        SetLength(Client,Length(Client)-1);
        dec(Ilosc);
        fMessage := 'Client disconnected';
        Synchronize(@ShowMessage);
        fMessage := 'Connected clients: ' + IntToStr(Ilosc);
        Synchronize(@ShowMessage);
      end;
    end;
  until (Terminated);
end;

Jednak Client[i].Terminated oznacza jako błąd

servers.pas(67,20) Error: identifier idents no member "Terminated"

Terminated jest w sekcji protected klasy TThread więc moja klasa TClient powinna to dziedziczyć a wygląda jakby nie dziedziczyła.
Ktoś z was wie jak to obejść ewentualnie jak dobrać się do tego Terminated? Bo jak chciałem dopisać w deklaracji klasy TClient opcje Terminated nie ważne czy w sekcji public czy w protected to wywalało błąd identifier duplicated.

0

a co to jest w ogóle ta druga pętla w Execut? Serwer ma mieć jeden wątek a każde połączenie osobny wątek. Wątek serwera działa przez cały czas działania programu i jego jedyne zadanie to nasłuchiwanie czy jest nowe połączenie i jak jest to "odebranie go" i uruchomienie nowego wątku klienta. Natomiast wątek klienta odpowiada za komunikacje z jednym konkretnym klientem i tam ma być zawarta cała jego (klienta) obsługa. Ty masz jakieś poplątanie z pomieszaniem. Na necie jest kupa przykładowych programów typu chat na gniazdach, synapse też ma swoje dema - może warto by zacząć naukę właśnie od nich

0

Terminated jest w sekcji protected klasy TThread więc moja klasa TClient powinna to dziedziczyć a wygląda jakby nie dziedziczyła.

Dziedziczy.

Ktoś z was wie jak to obejść ewentualnie jak dobrać się do tego Terminated?

Zrób publiczną procedurę która będzie czytać tą wartość?
Ale z Terminated jest inny problem: Jest on ustawiony na True kiedy 'ktoś' chce żeby ten wątek się zamknął. W takim wypadku wątek powinien zareagować wyjściem, ale twoja aplikacja może mieć problem z tym żeby się połapać czy już wyszedł czy dopiero wyjdzie. Można w takim wypadku dodać zmienną w wątku i ją sprawdzać albo łatwiej za pomocą WaitFor.
Poza tym, nie za bardzo rozumiem po co męczysz się z tyloma wątkami, jest to schemat zdecydowanie przedobrzony. Łatwiej jest mieć po prostu jeden wątek który odpowiada za całą logikę. Po prostu cała logika sieciowa zasługuje na jeden wątek.

Serwer ma mieć jeden wątek a każde połączenie osobny wątek. Wątek serwera działa przez cały czas działania programu i jego jedyne zadanie to nasłuchiwanie czy jest nowe połączenie i jak jest to "odebranie go" i uruchomienie nowego wątku klienta. Natomiast wątek klienta odpowiada za komunikacje z jednym konkretnym klientem i tam ma być zawarta cała jego (klienta) obsługa. Ty masz jakieś poplątanie z pomieszaniem.

Generalizujesz do połączenia HTTP gdzie rzeczywiście klient nie musi mieć wiedzy o innych klientach. Natomiast gry sieciowe IMO dużo lepiej programuje się robiąc 'wszystko' w klasie TSerwer gdzie można szybko dowiedzieć się wszystkiego o klientach a następnie rozdysponować im pakiety wychodzące. Tyczy się to również logiki rozłączania (np. kick, ban). Według mnie to TKlient to powinna być zwykła klasa zawierająca informacje o klientach a wszystko powinno być wykonywane z wątku TSerwer.

Na necie jest kupa przykładowych programów typu chat na gniazdach

Wątpię żeby było wiele w których każdy klient ma swój wątek (co samo w sobie jest głupie).

0

@-321oho

function IsTerminated : boolean;
begin
  result := Terminated;
end;

No tak, że też wcześniej na to nie wpadłem :P I ogólnie klasa serwera ma zarządzać wszystkimi klientami na jednym wątku ale każdy klient będzie miał osobny wątek (na razie dopóki nie ogarnę dokładnie programowania wielowątkowego) który będzie odpowiedzialny tylko za odebranie i wysłanie danych.

A czy jest możliwość wykrycia czy wątek się w ogóle zakończył? Czy to sam czy przez Terminate? bo jak patrzę na http://lazarus-ccr.sourceforge.net/docs/rtl/classes/tthread.html to Terminated wydaje się odpowiednie. Ewentualnie WaitFor ale skoro to ma "czekać" na zakończenie to czy watek nie zawiesi się na tej funkcji?

0

Ewentualnie WaitFor ale skoro to ma "czekać" na zakończenie to czy watek nie zawiesi się na tej funkcji?

Nie chodziło mi o to żeby wątek wykonał tą funkcję. Chodziło mi o to żeby zwalniacz to wykonał (ale patrząc w źródłach FPC Destroy samo wykonuje WaitFor jeżeli potrzeba).

A czy jest możliwość wykrycia czy wątek się w ogóle zakończył?

Terminate jest temu bliskie, ale nie wydaje mi się żeby można było to idealnie sprawdzić z poziomu użyszkodnika (wewnętrznie jest FFinished które i tak nie jest idealne). Generalnie to jeżeli Terminated i WaitFor to już na pewno jest zwolniony. Inne metody (nawet FFinished) są po prostu zrobione jako przypisanie zmiennej na koniec. Wygląda na to że nie ma OS-independent kodu. Jeżeli ktoś się lubi bawić to można używać Handle i jakiegoś Windowsowego kodu żeby sprawdzić czy wątek o danym uchwycie jest ubity.

każdy klient będzie miał osobny wątek (na razie dopóki nie ogarnę dokładnie programowania wielowątkowego)

Ja programowanie wielowątkowe ogarniam już któryś rok i nadal nie ogarniam tego całego. Po prostu nie mam potrzeby na aż taką wiedzę związaną z wątkami i wątpię żebyś ty potrzebował. No ale co kto tam lubi, ja jak teraz patrzę na swoją wiedzę o budowie plików PE EXE to też się zastanawiam na co mi to do normalnego programowania.

0
function TClient.IsTerminated : boolean;
begin
  result := Terminated;
end;

Dopisałem coś takiego i w pętli serwera zrobiłem

If Ilosc > 0 Then
    begin
      for i := 0 to High(Client) - 1 do
      begin
        if Client[i].IsTerminated Then
        begin
          FreeAndNil(Client[i]); // <- ponieważ w tworzeniu wątku FreeOnTerminate ustawiłem na false;
          for j := i to High(Client)-1 do
            Client[j]:=Client[j+1];
          SetLength(Client,Length(Client)-1);
          dec(Ilosc);
          fMessage := 'Connected clients: ' + IntToStr(Ilosc);
          Synchronize(@ShowMessage);
        end;
      end;
    end;

Jednak gdy sprawdza warunek if Client[i].IsTerminated Then to wywala mi błąd na linijce result := Terminated;

Project server raised exception class 'External SIGSEGV'

In file 'client.pas' at line 73:
result := Terminated;

Ten błąd do tej pory wyskakiwał mi jak zapomniałem zainicjować obiektu (Obiekt := TObiekt.Create;) jednak Wątek ten jest inicjowany bo dopóki nie wywołam funkcji IsTerminated to wszystko działa. I ogólnie zawsze się to dzieje gdy próbuję odczytać jakieś pole z obiektu wątku poza tym obiektem nie ważne czy przez funkcje czy bezpośrednio. Nie mam pojęcia tak to rozwiązać :S

EDIT:

Problem z błędem rozwiązałem :P Tylko i tak nie działa tak jak bym chciał :P ale myślę i kombinuję dalej :)

0

for i := 0 to High(Client) - 1 do

To się nie wykona dla wszystkich. Więc ciekawe jak w ogóle dostałeś się do IsTerminated zakładając że masz jednego klienta. I dlaczego wcześniej sprawdzasz ilosc potem już czytasz z tablicy, pomieszałeś.

I ogólnie zawsze się to dzieje gdy próbuję odczytać jakieś pole z obiektu wątku poza tym obiektem nie ważne czy przez funkcje czy bezpośrednio. Nie mam pojęcia tak to rozwiązać :S

Zepsułeś konstruktor? Sprawdź zawartość self gdy jesteś w IsTerminated. Wtedy możesz też zobaczyć self.FTerminated.

Problem z błędem rozwiązałem Tylko i tak nie działa tak jak bym chciał ale myślę i kombinuję dalej

To może opisz jak i co to będziemy coś wiedzieć.

A tak w ogóle to skoro masz tyle problemów, to może łatwiej po prostu warto zająć się czymś łatwiejszym (i bardziej praktycznym).

1

kod poglądowy, najpierw wątek

type
  TMojzajebistyWatekKtiregoBedeMial100SztukIChceJeTrzymacWLiscie = class(TThread)
  protected
    procedure Execute; override;
  public 
    Constructor Create; override;
  end;

implementation

procedure TMojzajebistyWatekKtiregoBedeMial100SztukIChceJeTrzymacWLiscie.Execute;
begin
  //coś
  while not Terminated do
  begin
    //inne coś
  end;
end;

constructor TMojzajebistyWatekKtiregoBedeMial100SztukIChceJeTrzymacWLiscie.Create;
begin
  FreeOnTerminate := true; //<--WAŻNE!!
  inherited Create(false);
end;

a teraz coś co będzie tworzyło nowe wątki, przechowywało do nich wskaźniki i usuwało je po zakończeniu wątku

type
  TMojaZajebistaForma = class(TForm)
  private
    FListaMoichZajebistychWatkow: TObjectList;

    procedure WatekSieZakonczyl(Sender: TObject);
    procedure StworzNowyZajebistyWatek;
  public
    constructor Create(AOwner: TComponent); override;
  end;

constructor TMojaZajebistaForma.Create(AOwner: TComponent);
begin
  inherited;
  FListaMoichZajebistychWatkow := TObjectList.Create(False); //<--WAŻNE!! inaczej będzie sypało błędami
end;

procedure TMojaZajebistaForma.WatekSieZakonczyl(Sender: TObject);
begin
  FListaMoichZajebistychWatkow.Delete(FListaMoichZajebistychWatkow.IndexOf(Sender));
end;

procedure TMojaZajebistaForma.StworzNowyZajebistyWatek;
var
  w: TMojzajebistyWatekKtiregoBedeMial100SztukIChceJeTrzymacWLiscie;
begin
  w := TMojzajebistyWatekKtiregoBedeMial100SztukIChceJeTrzymacWLiscie.Create;
  w.OnTerminate := WatekSieZakonczyl;
  FListaMoichZajebistychWatkow.Add(w);
end;

i w FListaMoichZajebistychWatkow masz aktualną listę działających wątków. Koniec wymyślania cudów na kiju. Oczywiście potem trzeba jeszcze zwolnić listę ale to już Twoja działka

0

@-321oho

Nie chce się zająć czymś prostszym tylko chce się nauczyć tworzyć dynamiczną listę wątków. A teraz od początku kod który mam:

Serwer:

unit Main;

{==============================================================================}

{$mode objfpc}{$H+}

{==============================================================================}

interface

{==============================================================================}

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
  blckSock, SynSock, Servers;

{==============================================================================}

type
  TfMainForm = class(TForm)
    bStart: TButton;
    bStop: TButton;
    bClose: TButton;
    eConsole: TEdit;
    eServerStatus: TEdit;
    lServerStatus: TLabel;
    mConsole: TMemo;
    procedure bCloseClick(Sender: TObject);
    procedure bStartClick(Sender: TObject);
    procedure bStopClick(Sender: TObject);
    procedure eConsoleKeyPress(Sender: TObject; var Key: char);
    procedure FormCreate(Sender: TObject);
    procedure FormResize(Sender: TObject);
  private

  public
    Server  : TServer;
    tmpSock : TSocket;
    Running : Boolean;
  end;

{==============================================================================}

var
  fMainForm: TfMainForm;

{==============================================================================}

implementation

{==============================================================================}

{$R *.lfm}

{==============================================================================}

procedure TfMainForm.FormResize(Sender: TObject);
begin
  bStart.Top := 10;
  bStart.Left := 10;

  bStop.Top := 15 + bStart.Height;
  bStop.Left := bStart.Left;

  bClose.Top := fMainForm.Height - bClose.Height - 10;
  bClose.Left := bStart.Left;

  lServerStatus.Top := 25 + bStart.Height + bStop.Height;
  lServerStatus.Left := bStart.Left;

  eServerStatus.Top := 30 + bStart.Height + bStop.Height + lServerStatus.Height;
  eServerStatus.Left := bStart.Left;
  eServerStatus.Width := fMainForm.Width div 2 - 20;

  mConsole.Top := 0;
  mConsole.Left := fMainForm.Width div 2;
  mConsole.Width := fMainForm.Width div 2;
  mConsole.Height := fMainForm.Height - eConsole.Height - 5;

  eConsole.Top := mConsole.Height + 5;
  eConsole.Left := mConsole.Left;
  eConsole.Width := mConsole.Width - 2;
end;

{------------------------------------------------------------------------------}

procedure TfMainForm.FormCreate(Sender: TObject);
begin
  eServerStatus.Text := 'STOPPED';
  Running := false;
end;

{------------------------------------------------------------------------------}

procedure TfMainForm.bStartClick(Sender: TObject);
begin
  eServerStatus.Text := 'Starting server...';
  Server := TServer.Create(false);
  Running := true;
  eServerStatus.Text := 'Server running';
end;

{------------------------------------------------------------------------------}

procedure TfMainForm.bCloseClick(Sender: TObject);
begin
  if running then bStopClick(self);
  fMainForm.Close;
end;

{------------------------------------------------------------------------------}

procedure TfMainForm.bStopClick(Sender: TObject);
begin
  eServerStatus.Text := 'Stopping server...';
  FreeAndNil(Server); // <- jak dawałem Server.Terminate to wariowało.
  Running := False;
  eServerStatus.Text := 'STOPPED';
end;

{------------------------------------------------------------------------------}

procedure TfMainForm.eConsoleKeyPress(Sender: TObject; var Key: char);
begin
  if Key = #13 then
  begin
    if (eConsole.Text = 'connected?') and (running) then mConsole.Lines.Add('Connected clients: ' + IntToStr(Server.Ilosc))
    else if (eConsole.Text = 'connected?') and (not running) then mConsole.Lines.Add('Server is stopped');
  end;
end;

{==============================================================================}

end.
unit Servers;

{==============================================================================}

{$mode objfpc}{$H+}

{==============================================================================}

interface

{==============================================================================}

uses
  Classes, SysUtils, blckSock, SynSock, Clients;

{==============================================================================}

type
  TServer = class(TThread)
    private
      fSocket  : TTCPBlockSocket;
      fCheck   : Boolean;
      fMessage : String;

      procedure ShowMessage;
    protected
      procedure Execute; override;
    public
      Socket : TSocket;
      Ilosc  : Word;
      Client : Array of TClient;

      constructor Create(CreateSuspended : Boolean);
    end;

{==============================================================================}

implementation

{==============================================================================}

uses Main;

{==============================================================================}

constructor TServer.Create(CreateSuspended : Boolean);
begin
  FreeOnTerminate := true;
  fSocket := TTCPBLockSocket.Create;
  fSocket.Bind('127.0.0.1','1234');
  fSocket.Listen;
  Ilosc := 0;
  SetLength(Client,Ilosc);
  fCheck := false;
  inherited Create(CreateSuspended);
end;

{------------------------------------------------------------------------------}

procedure TServer.ShowMessage;
begin
  fMainForm.mConsole.Lines.Add(fMessage);
end;

{------------------------------------------------------------------------------}

procedure TServer.Execute;
var
  i,j : Word;
begin
  repeat
    if fSocket.CanRead(1) then
    begin
      Socket := fSocket.Accept;
      Inc(Ilosc);
      SetLength(Client,Ilosc);
      Client[Ilosc-1] := TClient.Create(false,Socket);
      fMessage := 'Client connected';
      Synchronize(@ShowMessage);
      fMessage := 'Connected clients: ' + IntToStr(Ilosc);
      Synchronize(@ShowMessage);
    end;
    If Ilosc > 0 Then
    begin
      for i := 0 to Ilosc - 1 do
      begin
        if Client[i].IsTerminated Then
        begin
          FreeAndNil(Client[i]);
          for j := i to Ilosc - 1 do
            Client[j]:=Client[j+1];
          dec(Ilosc);
          SetLength(Client,Ilosc);
          fMessage := 'Connected clients: ' + IntToStr(Ilosc);
          Synchronize(@ShowMessage);
        end;
      end;
    end;
  until (Terminated);
end;

{==============================================================================}

end.
unit Clients;

{==============================================================================}

{$mode objfpc}{$H+}

{==============================================================================}

interface

{==============================================================================}

uses
  {$ifdef unix}
  cthreads,
  cmem,
  {$endif}
  Classes, SysUtils, BlckSock, SynSock;

{==============================================================================}

type
  TClient = class(TThread)
    private
      fSocket   : TTCPBlockSocket;
      fData     : String;
      fMessage  : String;
      Trm       : Boolean;
      procedure WriteMessage;
      procedure ShowMessage;
    protected
      procedure Execute; override;
    public
      function IsTerminated : Boolean;
      constructor Create(CreateSuspended : Boolean; sock : TSocket);
    end;

{==============================================================================}

implementation

{==============================================================================}

uses Main;

{==============================================================================}

constructor TClient.Create(CreateSuspended : Boolean; sock : TSocket);
begin
  FreeOnTerminate := false;
  Trm := false;
  fSocket := TTCPBlockSocket.Create;
  fSocket.Socket := sock;
  inherited Create(CreateSuspended);
end;

{------------------------------------------------------------------------------}

procedure TClient.WriteMessage;
begin
  fMainForm.mConsole.Lines.Add(fData);
end;

{------------------------------------------------------------------------------}

procedure TClient.ShowMessage;
begin
  fMainForm.mConsole.Lines.Add(fMessage);
end;

{------------------------------------------------------------------------------}

function TClient.IsTerminated : Boolean;
begin
  result := Trm;
end;

{------------------------------------------------------------------------------}

procedure TClient.Execute;
begin
  repeat
    fData := fSocket.RecvString(1);
    If (fData <> '') and (fData <> 'disconnect') then
      Synchronize(@WriteMessage);
  until (fData = 'disconnect');
  fMessage := 'Client disconnected';
  Synchronize(@ShowMessage);
  trm := true;
end;

{==============================================================================}

end.

Klient:

program Test_Client;

{$mode objfpc}{$H+}

uses
  {$IFDEF UNIX}{$IFDEF UseCThreads}
  cthreads,
  {$ENDIF}{$ENDIF}
  Classes,
  Crt, blckSock, SysUtils;

var
  Socket       : TTCPBlockSocket;
  Data         : String;
  Key          : Char;
  RandomNumber : Integer;

begin
  ClrScr;
  Write('Establishing connection...');
  Socket := TTCPBLockSocket.Create;
  Socket.Connect('127.0.0.1','1234');
  If Socket.LastError <> 0 Then
  Begin
    Write ('Error: ');
    WriteLn (Socket.LastErrorDesc);
    ReadKey;
    Halt (Socket.LastError);
  end;
  Randomize;
  WriteLn('DONE!');
  WriteLn('Sending some data');
  Repeat
    RandomNumber := Random(1000) + 1;
    Delay(RandomNumber);
    Data := 'Some data: ' + IntToStr(RandomNumber) + CRLF;
    Socket.SendString(Data);
    if KeyPressed then Key := ReadKey;
  until Key = 'q';
  Data := 'disconnect' + CRLF;
  Socket.SendString(Data);
  FreeAndNil(Socket);
end.

I chyba już wiem gdzie leży błąd. w pętli for od 0 do ilosc - 1 jeśli coś się zakończyło to zmieniam wartość ilosc zanim pętla się zakończy przez co wszystko zaczyna świrować :P Muszę znowu chwilkę pomyśleć.

@abrakadaber

Muszę poczytać o TObjectList. A z tego co napisałeś to wygląda ładnie ale jeśli wątek się zakończy to z Listy obiektów nie zostanie wywalony wskaźnik do niego albo źle zrozumiałem Twój kod lub to jest właśnie ta rzecz którą ja muszę się zająć. Aczkolwiek wygląda to wszystko ciekawie, krócej i bardziej przejrzyście od mojego kodu :)

0
babubabu napisał(a):

ale jeśli wątek się zakończy to z Listy obiektów nie zostanie wywalony wskaźnik do niego albo źle zrozumiałem Twój kod lub to jest właśnie ta rzecz którą ja muszę się zająć.
myślę, że kurs czytania ze zrozumieniem załatwi sprawę

procedure TMojaZajebistaForma.WatekSieZakonczyl(Sender: TObject);
begin
  FListaMoichZajebistychWatkow.Delete(FListaMoichZajebistychWatkow.IndexOf(Sender));
end;

i to jest właśnie to o czym pisał Ci ujemny - najpierw zajmij się podstawami a dopiero potem bierz się za trudne rzeczy (bo opanowanie wielowątkowości i wszystkich ograniczeń jakie ona nakłada to jest jedna z trudniejszych rzeczy)

0

No spoko poradziłem sobie bez TObjectList :D nic już nie świruje wszystko działa jak należy. Ale i tak o Tym poczytam. Mój kod rozwiązujący problem:

procedure TServer.CheckClients;
label
  Stop;
var
  i, j : Word;
begin
  If Ilosc > 0 then
  begin
    for i := 0 to Ilosc - 1 do
    begin
      If Client[i].IsTerminated then
      begin
        FreeAndNil(Client[i]);
        for j := i to Ilosc - 1 do
          Client[j] := Client[j+1];
        dec(Ilosc);
        SetLength(Client,Ilosc);
        goto Stop;
      end;
    end;
  end;
  Stop:
end;

Musze się tylko tego goto pozbyć bo mnie razi w oczy. Ale o tej porze już nie myślę.

0

dla mnie to jest porażka... Stworzyłeś coś, co na me usta przywołuje tylko jedno słowo i nie jest to "dobrze". Zamiast całe te dziwne konstrukcje zamknąć w dwóch, DWÓCH, DWÓCH linijkach kodu, porobiłeś jakieś dziwne metody. A i tak to nie zadziała jak się pomiędzy kolejnymi wywołaniami CheckClients zwolni więcej niż jeden wątek. No i jeszcze użycie magicznego GOTO 🤦. Jakby Brake alboExit nie było. Jeszcze raz - ZACZNIJ OD PODSTAW bo już widzę, że zamiast pisać zgodnie ze sztuką i zasadą KISS to tworzysz potworki a błędy projektowe zamiast naprawiać to łatasz kolejnymi potworkami.

0

Akurat zadziała bo watek nie jest zwalniany podczas jego zakończenia więc wskaźnik do wątku zostanie przepisany do indeksu niżej i zwolni się przy kolejnym wywołaniu checkclients :) Fakt faktem jest tu jakieś opóźnienie bo jak znowu między dwoma wywołaniami odłączy się więcej niż jeden klient to znowu drugi będzie czekał. Jednak nowi dodawani są na koniec a starzy odłączeni wywalani są od początku więc to spokojnie będzie działać. Fakt jest to koszmarne i zainteresuję się tym TObjectList ale już nie dzisiaj.

0

Całkowicie zgadzam się z opinią od @abrakadaber, jako demonstracje przerobie ten fragment na bardziej przyzwoitą konstrukcję. Ale to nie zmieni faktu że całość jest potworkiem z potwornymi łatami.

procedure TServer.CheckClients;
var i,p:Integer;
begin
  p:=0;
  for i:=0 to Length(Client)-1 do
  begin
    If Client[i].IsTerminated then FreeAndNil(Client[i])
    else
    begin
       Client[p]:=Client[i];
       Inc(p);
    end;
  end;
  SetLength(Client,p); // składową Ilość możesz wywalić bo jej nie potrzebujesz.
end;
0

jak wątek jest zwolniony (Terminated = true) to próba wywołania na nim IsTerminated musi się zakończyć AV - nie ma innej możliwości. A wy zamiast zrobić to po normalnemu to wymyślacie koło od nowa i to w dodatku kwadratowe

A co znaczy Terminated? Nie przypadkiem zakończony? Weź nie piernicz głupot, Terminated nie oznacza że klasa nie istnieje. Tak się stanie tylko jeżeli jest ustawione FreeOnTerminate.

A z tego co napisałeś to wygląda ładnie ale jeśli wątek się zakończy to z Listy obiektów nie zostanie wywalony wskaźnik

Zostanie, zobacz event OnTerminate (który swoją drogą w FPC przypisuje się OnTerminate:=@procedurka).

Koniec wymyślania cudów na kiju.

Masz monopol na dobre rozwiązania? Wersja bez FreeOnTerminate

program Project1;

{$mode objfpc}{$H+}

uses
  {$IFDEF UNIX}{$IFDEF UseCThreads}
  cthreads,
  {$ENDIF}{$ENDIF}
  Classes
  { you can add units after this },contnrs,windows,sysutils;

type

  { TMyThread }

  TMyThread=class(TThread)
    protected
      procedure Execute;override;
    public
      function IsTerminated:boolean;
      constructor Create();
      destructor Destroy;override;
  end;

{ TMyThread }

procedure TMyThread.Execute;
var
  i:integer;
begin
  i:=0;
  while (not Terminated)and(i<10) do
    begin
      sleep(10);
      inc(i);
    end;
end;

function TMyThread.IsTerminated: boolean;
begin
  result:=Terminated;
end;

constructor TMyThread.Create;
begin
  FreeOnTerminate:=false;
  inherited Create(false);
end;

destructor TMyThread.Destroy;
begin
  inherited Destroy;
end;

var
  list:TobjectList;
  i:integer;
  tmp:TMyThread;
begin
  randomize;
  list:=TObjectList.create(false);
  repeat
  writeln(list.Count);
   if random(14)=0 then   begin
        tmp:=TMyThread.Create();
        list.Add(tmp);
      end;
  for i:=0 to list.Count-1 do if TMyThread(list[i]).IsTerminated then
    begin
      TMyThread(list[i]).Free;
      list.Delete(i);
      break;
    end;
  sleep(10);
  until false;
end.

i to jest właśnie to o czym pisał Ci ujemny

Ahahah, mam nowy pseudonim.

No i jeszcze użycie magicznego GOTO 🤦. Jakby Brake alboExit nie było.

Ktoś użyje goto - zawsze będą hejty.

0

A po co tu tyle czasu procesora marnować na bezsensowne poszukiwanie "nieczynnych" obiektów wątku?

0
szopenfx napisał(a):

A po co tu tyle czasu procesora marnować na bezsensowne poszukiwanie "nieczynnych" obiektów wątku?
Właściwie tego się nie uniknie, IndexOf() też szuka i też w pętli i też w czasie O(n). @abrakadaber podał prawie idealne rozwiązanie, które ma tylko malutką wadę (łatwą do naprawy) ale pytacz "chce się nauczyć" (jak sam powiedział) tylko czego on chce się nauczyć? Nie przyjmować się dobrymi radami? Robić bajzel w kodzie? Nie rozumiem czego on chce, może ktoś mnie oświeci.

0

@up
No napisałem, że chce się nauczyć robić dynamiczną tablicę wątków... i napisałem też, że poczytam o tym TObjectList. Dokończyłem po prostu swoja wersje kodu tak jak umiałem a potem wziąłem się za przeróbki na listę obiektów. Dzięki za rady :)

0

A po co tu tyle czasu procesora marnować na bezsensowne poszukiwanie "nieczynnych" obiektów wątku?

"tyle czasu procesora" to jest zazwyczaj parę obrotów pętli. Od OnTerminate różni się tym że jest wykonywany w głównym wątku, nie w tym który jest ubijany (zazwyczaj mniej synców).

tylko, że lista jest przeszukiwana wtedy, kiedy coś się skończyło a nie co chwilę

Problem leży w tym że wtedy wykonujesz się z poziomu wątku który jest ubijany, nie z poziomu nadrzędnego wątku. Często to oznacza potrzebę syncowania.

Należy jeszcze zauważyć że w OnTerminate jest nonszalanckie odwołanie do zmiennej globalnej, natomiast u mnie zasada "X zarządza Y" jest zaimplementowana IMO dużo lepiej. Nie mieszam kodu zarządzania wątkiem z jego obsługą zewnętrzną.
Jak to mówią, coś za coś.

0

o jakiej zmiennej globalnej piszesz bo się już pogubiłem z tymi twoimi wywodami.

No i jak zwykle okazało że źle pamiętałem twoje rozwiązanie, gdzie dużo zrobiłeś inaczej niż pamiętałem z wczoraj. Dużo lepiej rozdzielasz warstwy "X zarządza Y" niż mi się wydawało. W takim wypadku pozostaje tylko brak syncowania.

jak ci się tak synchronizacja (tak to brzmi poprawnie po polsku a nie "syncowanie") nie podoba to sobie napisz własne zdarzenie OnMojeTerminate bez synchronizacji i po problemie...

Chodzi mi o to że zdarzenie OnTerminate jest wywoływane bez synchronizacji (z poziomu wątku który będzie ubity), a w moim przypadku wszystko z tym związane dzieje się w głównym wątku, więc raczej musiałbym właśnie zsyncować żeby było git (a to zabiera czas, jeżeli mam dziesiątki wątków podrzędnych to mogą się robić kolejki).
Syncowanie to bardziej zingliszowana nazwa, może i niepoprawna ale mi się podoba, więc bez hejtów. Język to nie coś co się zamyka w szkatułce a coś co ciągle się rozwija i przeistacza.

0

no właśnie, że zdarzenie OnTermiante jest wywoływane w wątku głównym a nie w wątku, który się właśnie kończy. Coś kręcisz kolego...

0
abrakadaber napisał(a):

no właśnie, że zdarzenie OnTermiante jest wywoływane w wątku głównym a nie w wątku, który się właśnie kończy. Coś kręcisz kolego...

procedure TThread.DoTerminate;
begin
  if Assigned(FOnTerminate) then
    Synchronize(@CallOnTerminate);
end;

Racja, tylko że synchronizowanie zabiera czas.

0

A sprawdzanie co chwila to czasu nie zabiera

Nie nie zabiera bo ty tak mówisz. Dziwne że ja tak nie mówiłem. No ale osoby które nie kodzą w assemblerze ( i wtórują RTTI) nagle strasznie przejmują się stratą parunastu taktów maszynowych. Dosyć dziwne podejście, zwłaszcza że w przypadkach logicznych pętla wykona co najwyżej paręnaście obrotów. Dodając do tego fakt że zazwyczaj i tak wysyłamy jakieś dane do wątków albo pobieramy je to nakłady spadają do blisko zera.

IMO oba rozwiązania są dobre i oba są dosyć podobne wydajnościowo. W OnTerminate trzeba pamiętać że jeżeli nie syncujemy do głównego wątku to trzeba swoją metodę napisać na to. Dzięki @abrakadaber za naprowadzenie mnie na informacje o OnTerminate.

0
-321oho napisał(a):

Racja, tylko że synchronizowanie zabiera czas.

_13th_Dragon napisał(a)

A sprawdzanie co chwila to czasu nie zabiera

-321oho napisał(a):

Nie nie zabiera bo ty tak mówisz. Dziwne że ja tak nie mówiłem.
Jasne, ty możesz "oskarżyć" nieswoje rozwiązanie o to że zabiera dużo czasu, ale jak okazuje się że twoje rozwiązanie zabiera jeszcze więcej czasu to nagle okazuje się że mowa o kilku taktach procesora to czyste lamierstwo. Wniosek - hipokryzja u ciebie sięga zenitu.

0

Jasne, ty możesz "oskarżyć" nieswoje rozwiązanie o to że zabiera dużo czasu, ale jak okazuje się że twoje rozwiązanie zabiera jeszcze więcej czasu

  1. Nikt nie powiedział że moje rozwiązanie zabiera jeszcze więcej czasu. Nawet ty takiej wypowiedzi nie udzieliłeś.
  2. Nie oskarżałem nikogo o to że jego rozwiązanie zabiera dużo czasu. Chciałem zauważyć że to wy zaczęliście temat, więc pokazałem że wasze rozwiązanie też zajmuje czas.
  3. Kto zaczął cały temat z czasem? Ja? A może to wy szukaliście dziury w całym i wam pokazuje że zarówno wasze rozwiązanie jest wolniejsze niż się wydaje jak i to że tak naprawdę parę taktów maszynowych nie ma znaczenia.

nagle okazuje się że mowa o kilku taktach procesora to czyste lamierstwo. Wniosek - hipokryzja u ciebie sięga zenitu.

Nadal tak uważam. Pokazuję po prostu że wasze rozwiązanie również zajmuje czas bo wy się wielce przyczepiliście do mojego rozwiązania jak to zajmuje dużo czasu. Nie jestem żadnym hipokrytą, nikomu nie zarzucam powolności rozwiązania, pokazuje jedynie wam (osobom strasznie skupionym na prędkości) że wasze rozwiązanie jest wolniejsze. Mnie osobiście to wielce nie obchodzi.

Polecam poćwiczyć czytanie ze zrozumieniem.

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