LNet in separaten Thread

Für Fragen von Einsteigern und Programmieranfängern...
Antworten
NoCee
Beiträge: 174
Registriert: Do 3. Mär 2011, 21:34
OS, Lazarus, FPC: WinXp/7/10 Opensuse13.2/Leap15.3 (L 2.2.0 FPC 3.2.2 )
CPU-Target: Intel 32/64Bit, ARM9
Wohnort: Ulm

LNet in separaten Thread

Beitrag von NoCee »

Hallo zusammen,

ich versuch mich gerade mit den Grundlagen von Threadprogrammen.
Wenn ich das mal soweit hinkriege, möchte ich ein kleines Konsolenprogramm schreiben,
das jeweils in einem eigenen Thread serielle Schnittstellen (mittels Synaser) und TCP/IP Verbindungen (über LNet)
bearbeitet. Zum Schluß, deshalb Konsole, soll das auf Linux laufen.
Ich hab mir jetzt folgenden Code aus Beispielen zusammengestupft:

Code: Alles auswählen

 
program Threadtest_001;
 
{$mode objfpc}{$H+}
 
uses
  {$IFDEF UNIX}{$IFDEF UseCThreads}
  cthreads,
  {$ENDIF}{$ENDIF}
  Classes, SysUtils, CustApp, Synaser, Lnet
  { you can add units after this };
 
type
 
  { TLTCPThreadA }
 
 TLTCPThreadA = class(TThread)
  private
    FConA: TLTCP; // THE server connection
    procedure OnErA(const msg: string; aSocket: TLSocket);
    procedure OnAcA(aSocket: TLSocket);
    procedure OnReA(aSocket: TLSocket);
    procedure OnDsA(aSocket: TLSocket);
  protected
  procedure Execute; override; // main loop with CallAction
 public
  constructor Create(CreateSuspended: boolean);
  destructor Destroy; override;
 end;
 
 
  { TMyApplication }
 
  TMyApplication = class(TCustomApplication)
  protected
    procedure DoRun; override;
  public
    TCPThreadA : TLTCPThreadA;
    constructor Create(TheOwner: TComponent); override;
    destructor Destroy; override;
    procedure WriteHelp; virtual;
  end;
 
 
  const
  PortA : word = 3001; // Port zum KSP
 
 
 
   { TLTCPThreadA }
 
procedure TLTCPThreadA.OnAcA(aSocket: TLSocket);
begin
  writeln('OnAcA');
 
end;
 
 
procedure TLTCPThreadA.OnErA(const msg: string; aSocket: TLSocket);
begin
  writeln('OnErA');
 
end;
 
procedure TLTCPThreadA.OnReA(aSocket: TLSocket);
var
  s: string;
  n: Integer;
begin
  writeln('OnReA');
  if aSocket.GetMessage(s) > 0 then begin
    writeln(s);
    end;
end;
 
 
procedure TLTCPThreadA.OnDsA(aSocket: TLSocket);
begin
  writeln('OnDsA');
 
end;
 
 
constructor TLTCPThreadA.Create(Createsuspended:boolean);
begin
  inherited Create(true);
  FreeOnTerminate := True;
  FConA := TLTCP.Create(nil); // create new TCP connection
  FConA.OnError := @OnErA;     // assign all callbacks
  FConA.OnReceive := @OnReA;
  FConA.OnDisconnect := @OnDsA;
  FConA.OnAccept := @OnAcA;
  FConA.Timeout := 100; // responsive enough, but won't hog cpu
  FConA.ReuseAddress := True;
end;
 
 
destructor TLTCPThreadA.Destroy;
begin
  FConA.Free;
  inherited Destroy;
end;
 
procedure TLTCPThreadA.Execute;
 
begin
  writeln('Listen');
  if FConA.Listen(PortA) then writeln('Listen 2');
  repeat
    try
      FConA.CallAction;
    except
      // this is not supposed to happen. No exception should
      // propagate up to this point. This must be a bug!
      //LogException('BUG: during CallAction()');
    end;
 
  until Terminated;
end;
 
 
 
 
{ TMyApplication }
 
procedure TMyApplication.DoRun;
var
  ErrorMsg: String;
begin
  // quick check parameters
  ErrorMsg:=CheckOptions('h','help');
  if ErrorMsg<>'' then begin
    ShowException(Exception.Create(ErrorMsg));
    Terminate;
    Exit;
  end;
 
  // parse parameters
  if HasOption('h','help') then begin
    WriteHelp;
    Terminate;
    Exit;
  end;
 
  { add your program here }
 
  writeln('Hallo Welt');
  readln;
 
  // stop program loop
  Terminate;
end;
 
constructor TMyApplication.Create(TheOwner: TComponent);
begin
  inherited Create(TheOwner);
  StopOnException:=True;
  TCPThreadA := TLTCPThreadA.Create(false);
end;
 
destructor TMyApplication.Destroy;
begin
  inherited Destroy;
end;
 
procedure TMyApplication.WriteHelp;
begin
  { add your help code here }
  writeln('Usage: ',ExeName,' -h');
end;
 
var
  Application: TMyApplication;
begin
  Application:=TMyApplication.Create(nil);
  Application.Run;
  Application.Free;
end.
 
Das soll ein Grundgerüst für einen Thread eines TCP/IP Server darstellen
Im Hauptprogramm passiert eigendlich bis auf ein readln gar nichts.
Wenn das Programm läuft, soll es einen Listenerport (3001) öffnen und warten bis was empfangen wurde.
Wenn was kommt, einfach mit writeln darstellen.
Kompilieren kann ich das jetzt, allerdings tut es nicht.
Wäre nett wenn da mal einer einen Blick drauf werfen würde.
Ich geh davon aus, daß da noch ganz grobe Schnitzer drin sind. Ich hab mich da in den letzten Tagen
echt wundgegoogled und vermische da vielleicht Win-Api und Konsole.
Das Prinzip von Threads (auch mit Synchronisation von Variablenzugriffen usw.) hab ich grundsätzlich ja mal verstanden
aber wie ich das Lazarus beibringe halt noch nicht so ganz.

Ich bin für jeden Hinweis dankbar was da falsch ist.
Danke schon mal für eure Mühe
Gruß NoCee
Zuletzt geändert von Lori am Di 5. Feb 2013, 11:01, insgesamt 1-mal geändert.
Grund: richtiger Highlighter

Socke
Lazarusforum e. V.
Beiträge: 3178
Registriert: Di 22. Jul 2008, 19:27
OS, Lazarus, FPC: Lazarus: SVN; FPC: svn; Win 10/Linux/Raspbian/openSUSE
CPU-Target: 32bit x86 armhf
Wohnort: Köln
Kontaktdaten:

Re: LNet in separaten Thread

Beitrag von Socke »

NoCee hat geschrieben:das jeweils in einem eigenen Thread serielle Schnittstellen (mittels Synaser) und TCP/IP Verbindungen (über LNet)
Warum verwendest du Synapse nicht auch für die Netzwerk-Seite? Blocking-Sockets sind in Threads evtl. ein wenig einfacher zu handhaben. Außerdem hast du dann nur eine Netzwerk-Bibliothek am Start.
NoCee hat geschrieben:Ich geh davon aus, daß da noch ganz grobe Schnitzer drin sind. Ich hab mich da in den letzten Tagen
echt wundgegoogled und vermische da vielleicht Win-Api und Konsole.
Das Prinzip von Threads (auch mit Synchronisation von Variablenzugriffen usw.) hab ich grundsätzlich ja mal verstanden
aber wie ich das Lazarus beibringe halt noch nicht so ganz.
Zwei grobe Schnitzer sind mir aufgefallen: Ein Minimalbeispiel ist kürzer. Die Klasse TMyApplication ist für die Fehlersuche eher irritierend.

Der zweite Schnitzer ist, dass du noch überhaupt keine Synchronisierung zwischen Netzwerk-Thread und Mainthread durchführst. Auch für die Ausgabe auf die Konsole muss eine Synchronisierung durchgeführt werden.
Im Prinzip ist das ganz einfach: Im Thread die Methode Synchronize() aufrufen (als Parameter die Methode, die im Haupt-Thread ausgeführt werden soll). Im Haupt-Thread muss die Funktion CheckSynchronize() aufgerufen werden (nach Synchronize() oder mit einem entsprechend großen Timeout).

Hier noch ein kurzes Beispiel, wie man mit lNet einen String in einem Thread empfängt und auf der Konsole ausgibt (getestet unter Windows 7)

Code: Alles auswählen

program Project1;
 
{$mode objfpc}{$H+}
 
uses {$IFDEF UNIX} cthreads, {$ENDIF}
  Classes,
  lnetbase,
  lnet,
  SysUtils;
 
type
  TMyThread = class(TThread)
  protected
    procedure OnRec(aSocket: TLSocket);
    procedure Execute; override;
    procedure MTWrite;
  public
    s: string;
  end;
 
  procedure TMyThread.OnRec(aSocket: TLSocket);
  begin
    aSocket.GetMessage(s);
    Synchronize(@MTWrite);  // Erhaltenen String an Mainthread übergeben
  end;
 
  procedure TMyThread.Execute;
  var
    t: TLTcp;
  begin
    t := TLTcp.Create(nil);
    try
      t.Listen(10000);
      t.Timeout := 100;
      t.OnReceive := @OnRec;
      repeat
        t.CallAction;
      until Terminated;
    except
    end;
    t.Destroy;
  end;
 
  procedure TMyThread.MTWrite;
  begin
    // diese Methode wird nur im Mainthread ausgeführt; falls
    Self.Terminate;
    writeln(Self.s);
  end;
 
var
  t: TMyThread;
begin
  t := TMyThread.Create(False);
  t.FreeOnTerminate := True;
  CheckSynchronize(60 * 60 * 1000); // 1 Stunde auf TThread.Synchronize warten
  readln;
end.
MfG Socke
Ein Gedicht braucht keinen Reim//Ich pack’ hier trotzdem einen rein

MAC
Beiträge: 770
Registriert: Sa 21. Feb 2009, 13:46
OS, Lazarus, FPC: Windows 7 (L 1.3 Built 43666 FPC 2.6.2)
CPU-Target: 32Bit

Re: LNet in separaten Thread

Beitrag von MAC »

ich hab nur mal grob drübergeschaut ( du solltest den Lazarus Highlighter verwenden ;) ) und frag mich ob du beim erstellen deines Threads auch ThreadInstanz.Resume; aufrufst damit der Thread anfängt zu arbeiten.
Außerdem gibt es beim Create von deinem Thread eine variable createsuspended. die wird bei dir ignoriert weil immer inherited Create(true); aufgerufen wird...

Code: Alles auswählen

Signatur := nil;

Socke
Lazarusforum e. V.
Beiträge: 3178
Registriert: Di 22. Jul 2008, 19:27
OS, Lazarus, FPC: Lazarus: SVN; FPC: svn; Win 10/Linux/Raspbian/openSUSE
CPU-Target: 32bit x86 armhf
Wohnort: Köln
Kontaktdaten:

Re: LNet in separaten Thread

Beitrag von Socke »

MAC hat geschrieben:ich hab nur mal grob drübergeschaut ( du solltest den Lazarus Highlighter verwenden ;) ) und frag mich ob du beim erstellen deines Threads auch ThreadInstanz.Resume; aufrufst damit der Thread anfängt zu arbeiten.
Außerdem gibt es beim Create von deinem Thread eine variable createsuspended. die wird bei dir ignoriert weil immer inherited Create(true); aufgerufen wird...
... und ich schreib mir den ganzen Kram nochmal selbst :roll:. Du hast Recht. Der Thread fängt nie an zu arbeiten.
MfG Socke
Ein Gedicht braucht keinen Reim//Ich pack’ hier trotzdem einen rein

NoCee
Beiträge: 174
Registriert: Do 3. Mär 2011, 21:34
OS, Lazarus, FPC: WinXp/7/10 Opensuse13.2/Leap15.3 (L 2.2.0 FPC 3.2.2 )
CPU-Target: Intel 32/64Bit, ARM9
Wohnort: Ulm

Re: LNet in separaten Thread

Beitrag von NoCee »

Danke für die Antworten und das Beispiel,
ich hab mir das Create des Thread noch mal angeschaut. Da war der Fehler das der Thread nicht lief. Hab ich jetzt geändert.
Das Synchronisieren wollte ich später allerdings mit CriticalSection einbauen. Wie das geht hab ich, glaube ich zumindest, kapiert.
Der TCP/IP Server funktioniert jetzt. Alles was ich in einem Terminalfenster eingebe wird an der Konsole ausgegeben.
(Auch ohne saubere Synchronisierung da das Hauptprogramm ja komplett steht wegen readln)

Das laufende Programm tut jetzt das was es soll und ich könnte jetzt ein altes Projekt da reinbauen. Ich möchte an diesem
Projekt weiter machen weil das einen sehr ähnlichen Aufbau hat wie die alte Version.
Allerdings hab ich beim Beenden des Programms jezt ein Problem mit einer Exception. Wenn ich das Fenster mit dem X rechts oben schließe
sehe ich keinen Fehler. Wenn ich das Hauptprogramm beende in dem ich mit Return drücken das Terminate ausführe,
erhalte ich eine Fehlermeldung: .. hat Exception-Klasse ausgelöst "external SIGSEGV"
in der Konsole steht noch:
Error on accept [10093]: Die Anwendung hat die Funktion WSAStartup nicht aufgerufen,
oder bei dieser Funktion ist ein Fehler aufgetreten.

Das Problem kommt aus der LNet Unit. Ich hab nach der Fehlermeldung gegoogled kann aber mit den Infos dort nicht viel anfangen.
Vielleicht beende ich den Serverthread nur falsch.
Hat jemand vielleicht einen Tipp an was das liegen könnte?

Danke schon mal für die Antworten
Gruß
NoCee

(Ich hab da versuchshalber mal die Konstuktion mit TMyApplication rausbebaut, hab aber den gleichen Fehler bekommen)

Code: Alles auswählen

program Threadtest_001;
 
{$mode objfpc}{$H+}
 
uses
  {$IFDEF UNIX}{$IFDEF UseCThreads}
  cthreads,
  {$ENDIF}{$ENDIF}
  Classes, SysUtils, SyncObjs, CustApp, Synaser, Lnet
 
  { you can add units after this };
 
type
 
  { TLTCPThreadC }
 
 TLTCPThreadC = class(TThread)
  private
    FConC: TLTCP; // THE server connection
    procedure OnErC(const msg: string; aSocket: TLSocket);
    procedure OnAcC(aSocket: TLSocket);
    procedure OnReC(aSocket: TLSocket);
    procedure OnDsC(aSocket: TLSocket);
  protected
  procedure Execute; override; // main loop with CallAction
 public
  constructor Create;
  destructor Destroy; override;
 end;
 
 
  { TMyApplication }
 
  TMyApplication = class(TCustomApplication)
  protected
    procedure DoRun; override;
  public
    TCPThreadC : TLTCPThreadC;
    constructor Create(TheOwner: TComponent); override;
    destructor Destroy; override;
  end;
 
  var
    Servicestring:string;
 
  const
    PortC : word = 3003; // Port zum Service
 
   { TLTCPThreadA }
 
procedure TLTCPThreadC.OnAcC(aSocket: TLSocket);
begin
  writeln('OnAcC');
end;
 
 
procedure TLTCPThreadC.OnErC(const msg: string; aSocket: TLSocket);
begin
  writeln('OnErC');
  writeln(msg);
end;
 
procedure TLTCPThreadC.OnReC(aSocket: TLSocket);
var
  s: string;
begin
  writeln('OnRec');
  if aSocket.GetMessage(s) > 0 then begin
    writeln(s);
    end;
end;
 
 
procedure TLTCPThreadC.OnDsC(aSocket: TLSocket);
begin
  writeln('OnDsC');
end;
 
 
 
constructor TLTCPThreadC.Create;
begin
  inherited Create(false);
  FreeOnTerminate := True;
  FConC := TLTCP.Create(nil); // create new TCP connection
  FConC.OnError := @OnErC;     // assign all callbacks
  FConC.OnReceive := @OnReC;
  FConC.OnDisconnect := @OnDsC;
  FConC.OnAccept := @OnAcC;
  FConC.Timeout := 100; // responsive enough, but won't hog cpu
  FConC.ReuseAddress := True;
end;
 
 
destructor TLTCPThreadC.Destroy;
begin
  FConC.Free;
  inherited Destroy;
end;
 
procedure TLTCPThreadC.Execute;
 
begin
  if FConC.Listen(PortC) then writeln('Listen');
  repeat
    try
      FConC.CallAction;
    except
      // this is not supposed to happen. No exception should
      // propagate up to this point. This must be a bug!
      //LogException('BUG: during CallAction()');
    end;
  until Terminated;
end;
 
 
{ TMyApplication }
 
procedure TMyApplication.DoRun;
 
begin
  // start main programm
 
  writeln('Hallo Welt');
  readln;
 
  // stop program loop
  Terminate;
end;
 
constructor TMyApplication.Create(TheOwner: TComponent);
begin
  inherited Create(TheOwner);
  StopOnException:=True;
  TCPThreadC := TLTCPThreadC.Create;
end;
 
destructor TMyApplication.Destroy;
begin
  inherited Destroy;
end;
 
var
  Application: TMyApplication;
begin
  Application:=TMyApplication.Create(nil);
  Application.Run;
  Application.Free;
end.
 
 
{ Fehlermeldung: .. hat Exception-Klasse ausgelöst "external SIGSEGV"
Ausgabe im Fenster:
 
Hallo Welt
Listen
 
OnErC
Error on accept [10093]: Die Anwendung hat die Funktion WSAStartup nicht aufgeru
fen, oder bei dieser Funktion ist ein Fehler aufgetreten.
}

MAC
Beiträge: 770
Registriert: Sa 21. Feb 2009, 13:46
OS, Lazarus, FPC: Windows 7 (L 1.3 Built 43666 FPC 2.6.2)
CPU-Target: 32Bit

Re: LNet in separaten Thread

Beitrag von MAC »

Wahrscheinlich weil dein MainThread beendet wurde, dein 2. Thread aber noch weiter läuft (bzw. noch weiter laufen will, auch wenns nur ne halbe sekunde ist,bevor auch dieser geschlossen wird.).
Wenn dein Main Thread geschlossen wird, dann werden auch jede Menge Objekte und Daten und Speicher freigegeben (achtung, ob das stimmt kann ich nicht genau sagen, ich hab mir das selber so erschlossen). Und dein 2. Thread will noch weiterarbeiten. Und zwar wahrscheinlich mit Daten, die schon nicht mehr existieren, ka evt. die Lnet- Klasse, was auf jeden fall wahrscheinlicher wäre das bei der Ausgabe ja auf das hauptfenster, spricht Mainthread zugegriffen wird. Und das gibt diesen Fehler.

Ich habe das so gelöst, das ich ein CloseQuery Event wir djetzt MeinThread.Terminate; aufgerufen. Dann wartet der hauptthread 2 sek (sleep(2)) und dann schließt der erst...
Im Thread musst du jetzt in einer Endlosschleife nachfragen ob MeinThread.Terminated = true ist und dann die Endlosschleife abbrechen...

Code: Alles auswählen

Signatur := nil;

NoCee
Beiträge: 174
Registriert: Do 3. Mär 2011, 21:34
OS, Lazarus, FPC: WinXp/7/10 Opensuse13.2/Leap15.3 (L 2.2.0 FPC 3.2.2 )
CPU-Target: Intel 32/64Bit, ARM9
Wohnort: Ulm

Re: LNet in separaten Thread

Beitrag von NoCee »

Hallo zusammen,

ich habs jetzt hinbekommen.

Code: Alles auswählen

destructor TLTCPThreadC.Destroy;
begin
  //FConC.Free;   hab ich hier rausgenommen
  inherited Destroy;
end;
und im mainprogramm nach dem Terminate noch ein ...waitfor eingebaut.
Seit dem tuts.
Das ...waitfor hab ich geschnallt, aber wo das FCon.Free gemacht wird, ist mir noch nicht klar.

Code: Alles auswählen

constructor TLTCPThreadC.Create;
begin
  inherited Create(false);
  FreeOnTerminate := true;
  FConC := TLTCP.Create(nil); // create new TCP connection
  FConC.OnError := @OnErC;     // assign all callbacks
  FConC.OnReceive := @OnReC;
  FConC.OnDisconnect := @OnDsC;
  FConC.OnAccept := @OnAcC;
  FConC.Timeout := 100; // responsive enough, but won't hog cpu
  FConC.ReuseAddress := True;
end; 
Haut das "FreeOnTerminate" auch das FConC mit weg, oder bleibt mir da jetzt was übrig?

Gruß
NoCee

Benutzeravatar
af0815
Lazarusforum e. V.
Beiträge: 6858
Registriert: So 7. Jan 2007, 10:20
OS, Lazarus, FPC: FPC fixes Lazarus fixes per fpcupdeluxe (win,linux,raspi)
CPU-Target: 32Bit (64Bit)
Wohnort: Burgenland
Kontaktdaten:

Re: LNet in separaten Thread

Beitrag von af0815 »

NoCee hat geschrieben:Haut das "FreeOnTerminate" auch das FConC mit weg, oder bleibt mir da jetzt was übrig?
** Klugscheissen on **
FreeOnTerminate macht ein Free On Terminate.
** Klugscheissen off **

Wenn du am Ende des Threads zB. noch Daten auslesen willst, so setze es auf false und zerstöre das Objekt selbst mit free. Bei True räumt es sich selbst weg, aber pass auf, da du es nicht mehr verwendest. Ev. noch existierende Referenzen sind dann ungültig und verweisen auf irgendwas.
Blöd kann man ruhig sein, nur zu Helfen muss man sich wissen (oder nachsehen in LazInfos/LazSnippets).

Antworten