Socket-Verbindung herstellen ohne zu blockieren

[Medium]

Moin!

Ich muss gerade eine Legacy-Anwendung von uns etwas ändern. Diese kommuniziert via TClientSocket mit einem Server. Da es bei dem Kunden gelegentlich zu Verbindungsstörungen kommt, und sich auch nach längerer Suche für die Ursache keine "richtige" Abhilfe abzeichnet, man aber dennoch weiter arbeiten möchte bis das mal so weit ist, soll mein Programm nun immer mal wieder versuchen sich neu zu verbinden wenn die Verbindung abgebrochen ist.

Dafür habe ich mal spontan einen Timer genommen, der einfach alle 10s prüft ob .Connected = true, und wenn nicht dies setzen. Leider aber friert während des Verbindungsversuchs alles ein, so dass das Programm bei fortwährender Störung alle 10s für 2-3s nicht bedient werden kann. (Man kann sinnvolle Dinge auch ohne die Verbindung tun.)

Kann man den Socket dazu überreden, dies bitteschön im Hintergrund zu tun? Die Events sind alle versorgt, und anhand derer setze ich auch entsprechende Flags. Sodass mir der "Zwischenzustand" nichts ausmachen würde. Ich habe schon lose über einen Thread dafür nachgedacht, aber wenn ich mich nicht täusche kann man Sockets nur in dem jeweiligen Kontext nutzen, in dem sie erstellt bzw. verbunden werden. Und ich habe weder Lust noch Zeit das gesamte Programm so umzustellen, dass ALLE Socket-Zugriffe in einem Thread passieren (mit all dem Signaling usw. was da dran hängen würde).

Gibt's da einen Kniff?

[Delphi.Narium]

Nö, was sinnvolles weiß ich nicht, aber wenn der Fehler auftritt, dann in einem Thread alle 10s (oder so) prüfen, ob die Verbindung prinzipiell wiederhergestellt werden kann. Wenn ja, dann im eigentlichen Programmteil die Verbindung wieder aufbauen.

[mjustin]

Socketzugriffe auf die native Windows Socket API können durchaus auch aus mehreren Threads stattfinden (Beispiel: Indy's Telnet Client schreibt auf den Socket aus einem Thread während ein anderer daraus liest). Bei TClientSocket ist aber leider die gesamte Verarbeitung zusätzlich noch an die Windows Ereignis/Nachrichtenwarteschlange gekoppelt um so die "asynchrone" Verarbeitung zu ermöglichen (Relikt aus den frühen Windows-Zeiten), mit Windowhandles usw. und Dadurch wird das Thema "welcher Thread darf was?" dann doch wieder relevant.

Durch TClientSocket entsteht in der Regel komplexer ("Spaghetti-")Code, der bei einem blockierenden Zugriff auf Sockets wegfällt, was die Wartung langfristig wieder einfacher macht.

[KodeZwerg]

Hi, ich hab hier zwei Sources entdeckt die das Thema Socket+(multi)Thread aufgreifen, vielleicht ist etwas für Dich dabei?
connecting a server socket with several client sockets und TServerSocket in multithread mode

Mein Tipp wäre erstmal anpingen ob Server überhaupt existiert um Connected = true zu setzen.

edit
für alle dir nur source wollen, hier der aus link 1
Es kann gut möglich sein das in den Links noch Verbesserungen o.ä. erwähnt werden.

Delphi-Quellcode:

unit Server;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls, Sockets, ServerThread;

type

  { TForm1 }

  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  public
    procedure handle(ID, message: String);
  end;

var
  Form1: TForm1;
  threads: Array[1..4] of TServerThread;
  serverSocket: Longint;
  clientSocket: Longint;
  serverAddr: TInetSockAddr;
  opt: Integer = 1;
  addrSize: Longint;
  clientCount: Integer = 0;

implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.Button1Click(Sender: TObject);
begin
  repeat
    serverSocket:= fpSocket(AF_INET, SOCK_STREAM, 0);
    if fpSetSockOpt(serverSocket, SOL_SOCKET, SO_REUSEADDR, @opt, sizeOf(opt)) = SOCKET_ERROR then showMessage('Server : Multi : ' + intToStr(socketError));
    if serverSocket = SOCKET_ERROR then showMessage('Server : Socket : ' + intToStr(socketError));
    serverAddr.sin_family:= AF_INET;
    serverAddr.sin_port:= htons(50000);
    serverAddr.sin_addr.s_addr:= htonl($7F000001);
    if fpBind(serverSocket, @serverAddr, sizeOf(serverAddr)) = SOCKET_ERROR then showMessage('Server : Bind : ' + intToStr(socketError));
    if fpListen(serverSocket, 4) = SOCKET_ERROR then showMessage('Server : Listen : ' + intToStr(socketError));
    showMessage('Waiting for connect from Client...');
    addrSize:= sizeOf(serverAddr);
    clientSocket:= fpaccept(serverSocket, @serverAddr, @addrSize);
    if clientSocket = SOCKET_ERROR then showMessage('Server : Accept : ' + intToStr(socketError)) else clientCount:= clientCount + 1;
    threads[clientCount]:= TServerThread.create(true, clientSocket);
    threads[clientCount].start;
  until clientCount = 4;
end;

procedure TForm1.handle(ID, message: String);
var
  i, toTerminate: Integer;
  MyCriticalSection: TRTLCriticalSection;
begin
  InitCriticalSection(MyCriticalSection);
  EnterCriticalSection(MyCriticalSection);
  try
    for i:= 1 to clientCount do
    begin
      threads.send(ID + ': ' + message);
      if threads.getID = ID then toTerminate:= i;
    end;
    if message = 'ciao' then
    begin
      threads[toTerminate].send('ciao');
      threads[toTerminate].close;
      clientCount:= clientCount - 1;
      for i:= toTerminate to clientCount do threads:= threads[i + 1];
    end;
  finally
    LeaveCriticalSection(MyCriticalSection);
  end;
end;

end.



unit ServerThread;

{$mode objfpc}{$H+}

interface

uses Classes, Dialogs, Sockets, SysUtils;

type
  TServerThread = class(TThread)
  private
    ID: String;
    clientSocket: Longint;
  protected
    procedure execute; override;
  public
    constructor create(createSuspended: Boolean; client: Longint);
    procedure send(msg: String);
    function getID: String;
    procedure close;
  end;

var
  buffer: String[255];
  count: Longint;

implementation

uses Server;

constructor TServerThread.create(createSuspended: Boolean; client: Longint);
begin
  freeOnTerminate:= true;
  inherited create(createSuspended);
  clientSocket:= client;
end;

procedure TServerThread.execute;
begin
  count:= fprecv(clientSocket, @buffer[1], 255, 0);
  if (count <> SOCKET_ERROR) and (count > 0) then
  begin
    setLength(buffer, count);
    ID:= buffer;
  end;
  buffer:= 'Herzlich willkommen im Chat, ' + ID;
  count:= length(buffer);
  if fpsend(clientSocket, @buffer[1], count, 0) = count then
  begin
    repeat
      count:= fprecv(clientSocket, @buffer[1], 255, 0);
      if (count <> SOCKET_ERROR) and (count > 0) then
      begin
        setLength(buffer, count);
        Form1.handle(ID, buffer);
      end;
    until (count = SOCKET_ERROR) or (count = 0);
  end;
end;

procedure TServerThread.send(msg: String);
begin
  fpsend(clientSocket, @msg[1], length(msg), 0);
end;

function TServerThread.getID: String;
begin
  result:= ID;
end;

procedure TServerThread.close;
begin
  closeSocket(clientSocket);
end;

end.



unit Client;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls, Sockets, ClientThread;

type

  { TForm1 }

  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Edit1: TEdit;
    Edit2: TEdit;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Edit1Change(Sender: TObject);
    procedure handle(msg: String);
  private
    { private declarations }
  public
    { public declarations }
  end;

var
  Form1: TForm1;
  thread: TClientThread;
  serverAddr: TInetSockAddr;
  serverSocket: Longint;

implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.Button1Click(Sender: TObject);
begin
  serverSocket:= fpSocket(AF_INET, SOCK_STREAM, 0);
  if serverSocket = SOCKET_ERROR then showMessage('Client : Socket : ' + intToStr(socketError));
  serverAddr.sin_family:= AF_INET;
  serverAddr.sin_port:= htons(50000);
  serverAddr.sin_addr.s_addr:= htonl($7F000001);
  //funktioniert beim zweiten Client nicht, da kein Error, obwohl die Verbindung nicht zustande kommt (fpaccept reagiert nicht)
  if fpconnect(serverSocket, @serverAddr, sizeOf(serverAddr)) = SOCKET_ERROR then showMessage('Client : Connect : ' + intToStr(socketError));
  thread:= TClientThread.create(true, serverSocket);
  thread.start;
  buffer:= Edit1.Text;
  fpsend(serverSocket, @buffer[1], length(buffer), 0);
  Button2.Enabled:= true;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  buffer: String;
begin
  buffer:= Edit2.Text;
  fpsend(serverSocket, @buffer[1], length(buffer), 0);
end;

procedure TForm1.Edit1Change(Sender: TObject);
begin
  if length(Edit1.Text) > 0 then Button1.Enabled:= true else Button1.Enabled:= false;
end;

procedure TForm1.handle(msg: String);
begin
  if msg = 'ciao' then closeSocket(serverSocket)
  else Memo1.Lines.Add(msg);
end;

end.



unit ClientThread;

{$mode objfpc}{$H+}

interface

uses Classes, Dialogs, Sockets, SysUtils;

type
  TClientThread = class(TThread)
  private
    serverSocket: Longint;
  protected
    procedure execute; override;
  public
    constructor create(createSuspended: Boolean; server: Longint);
  end;

var
  buffer: String[255];
  count, i: Longint;

implementation

uses Client;

constructor TClientThread.create(createSuspended: Boolean; server: Longint);
begin
  freeOnTerminate:= true;
  inherited create(createSuspended);
  serverSocket:= server;
end;

procedure TClientThread.execute;
begin
  repeat
    count:= fprecv(serverSocket, @buffer[1], 255, 0);
    if count <> SOCKET_ERROR then
    begin
      setLength(buffer, count);
      Form1.handle(buffer);
    end;
  until buffer = 'ciao';
  closeSocket(serverSocket);
end;

end.

hier der aus link 2

Delphi-Quellcode:

program server;

uses
  Forms,
  main in 'main.pas' {Form1};

{$R *.RES}

begin
  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.


/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\
/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\
/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\


 Unit main;

Interface

Uses
  Windows, SysUtils, Messages, Classes, Forms, ScktComp, Controls, StdCtrls,
  Menus, Mask, Spin, ComCtrls, ExtCtrls;

Const
  CM_IncCount = WM_USER + 1;

Type
  TForm1 = Class(TForm)
    ServerSocket: TServerSocket;
    MainMenu: TMainMenu;
    File1: TMenuItem;
    ActiveItem: TMenuItem;
    N1: TMenuItem;
    Exit1: TMenuItem;
    Panel1: TPanel;
    Label1: TLabel;
    CacheEdit: TSpinEdit;
    Label2: TLabel;
    PortEdit: TSpinEdit;
    Label3: TLabel;
    ThreadCount: TEdit;
    Panel2: TPanel;
    ListBox1: TListBox;
    Panel3: TPanel;
    StatusBar1: TStatusBar;
    CharCount: TLabel;
    Procedure ServerSocketGetThread(Sender: TObject;
      ClientSocket: TServerClientWinSocket;
      Var SocketThread: TServerClientThread);
    Procedure FormCreate(Sender: TObject);
    Procedure FormClose(Sender: TObject; Var Action: TCloseAction);
    Procedure Exit1Click(Sender: TObject);
    Procedure PortEditChange(Sender: TObject);
    Procedure ActiveItemClick(Sender: TObject);
    Procedure ServerSocketThreadEnd(Sender: TObject;
      Thread: TServerClientThread);
    Procedure ServerSocketThreadStart(Sender: TObject;
      Thread: TServerClientThread);
    Procedure CacheEditChange(Sender: TObject);
  protected
    Procedure CMIncCount(Var Msg: TMessage); message CM_IncCount;
  public
  End;

{ TFileServerThread }

  TFileServerThread = Class(TServerClientThread)
  public
    Procedure ClientExecute; override;
  End;

Var
  Form1: TForm1;

Implementation

{$R *.DFM}

{ TFileServerThread }

Procedure TFileServerThread.ClientExecute;
Var
  Data: Array[0..1023] Of char;
  RecText: String;
  SocketStream: TWinSocketStream;
Begin
  While Not Terminated And ClientSocket.Connected Do
  Try
    SocketStream := TWinSocketStream.Create(ClientSocket, 30000);
    Try
      FillChar(Data, SizeOf(Data), 0);
      If SocketStream.Read(Data, SizeOf(Data)) = 0 Then
      Begin
        // If we didn't get any data after xx seconds then close the connection
        ClientSocket.SendText('Timeout on Server'+#13#10);
        //Wait a little time to allow sending of text before disconnect
        sleep(1);
        ClientSocket.Close;
        Terminate;
      End;
      RecText := Data;
      If Length(RecText) > 2 Then
        Delete(RecText, Pos(#13#10, RecText), 2); // Delete 10
      If ClientSocket.Connected Then
      Begin
        ClientSocket.SendText(RecText);
        SendMessage(Form1.Listbox1.Handle, LB_ADDSTRING, 0, Integer(PChar(RecText)));
        PostMessage(Form1.Handle, CM_INCCOUNT, 0, 0);
      End;
    Finally
      SocketStream.Free;
    End;
  Except
    HandleException;
  End;
End;

Procedure TForm1.ServerSocketGetThread(Sender: TObject;
  ClientSocket: TServerClientWinSocket;
  Var SocketThread: TServerClientThread);
Begin
  // Create a new thread for connection
  SocketThread := TFileServerThread.Create(False, ClientSocket);
  ClientSocket.SendText('Welcome to Server'+#13#10);
End;

Procedure TForm1.FormCreate(Sender: TObject);
Begin
  CacheEdit.Value := ServerSocket.ThreadCacheSize;
  PortEdit.Value := ServerSocket.Port;
  CharCount.Caption := '0';
  ActiveItemClick(Nil);
End;

Procedure TForm1.FormClose(Sender: TObject; Var Action: TCloseAction);
Begin
  ServerSocket.Close;
End;

Procedure TForm1.CMIncCount(Var Msg: TMessage);
Begin
  CharCount.Caption := IntToStr(StrToInt(CharCount.Caption) + 1);
End;

Procedure TForm1.Exit1Click(Sender: TObject);
Begin
  Close;
End;

Procedure TForm1.PortEditChange(Sender: TObject);
Begin
  ServerSocket.Port := StrToInt(PortEdit.Text);
End;

Procedure TForm1.ActiveItemClick(Sender: TObject);
Begin
  ServerSocket.Active := Not ServerSocket.Active;
  ActiveItem.Checked := ServerSocket.Active;
  If ServerSocket.Active Then
    StatusBar1.SimpleText := 'Active'
  Else
    StatusBar1.SimpleText := 'InActive';
End;

Procedure TForm1.ServerSocketThreadEnd(Sender: TObject;
  Thread: TServerClientThread);
Begin
  ThreadCount.Text := IntToStr(StrToInt(ThreadCount.Text) - 1);
End;

Procedure TForm1.ServerSocketThreadStart(Sender: TObject;
  Thread: TServerClientThread);
Begin
  ThreadCount.Text := IntToStr(StrToInt(ThreadCount.Text) + 1);
End;

Procedure TForm1.CacheEditChange(Sender: TObject);
Begin
  ServerSocket.ThreadCacheSize := CacheEdit.Value;
End;

End.

[Medium]

Die Idee die Verbindung im Thread erstmal anzutesten gefällt mir! Zwar nicht das schönste von der Welt, aber ich brauche in diesem Falle leider das mit dem geringsten Aufwand. (Das Programm ist eh heillos verloren was Wartbarkeit angeht - da muss ich beizeiten mal eine Renovierung anbieten...) Das probiere ich mal!

Ich hatte zwischenzeitlich einfach mal probiert bloß das ".Active := true" in einem Thread zu machen, und dabei ist mir das komplette Programm mit den wildestens Meldungen und manchmal auch gar keinen auf etliche Weisen um die Ohren geflogen :D. Es hilft vermutlich auch nicht, dass ich in den Event-Handlern reichlich Dinge im UI mache. (Ich vermute mal, dass die dann nämlich auch auf einmal im Thread-Kontext landen.)

[stahli]

[OT?]
Verwendet der Kunde Power-Line oder ähnliches?
Bei mir führt das auch immer mal zu Verbindungsunterbrechungen.
[/OT?]

[ensaron]

Mit der Verlagerung des Sockets in einen Thread bei einer gewachsenen Anwendung hatte ich das Problem der hängenden Programmoberfläche auch mal erfolgreich gelöst. Du musst dann natürlich alle Zugriffe auf den Socket im Thread abhandeln und den Zugriff von außen via TMonitor, CriticalSection oder etwas in der Art absichern.

Die endgültige Lösung war bei mir dann übrigens der Umstieg auf die Overbyte ICS Komponenten, die funktionieren asynchron (und daher ohne Hänger beim Verbindgen etc.). Wenn das für dich eine Option wäre, kann ich ja hier mal ein Beispiel für die Ansteuerung anhängen.

[Sherlock]

Die ICS kann ich auch nur wärmstens empfehlen. Falls Threading angedacht ist, auf jeden Fall dies hier lesen: http://wiki.overbyte.eu/wiki/index.p...MultiThreading

Sherlock

[Medium]

@stahli: Ich muss zugeben mich mit den Interna des Kundennetzes nicht eingehend beschäftigt zu haben. Ich bin quasi Netzwerklegastheniker, und die haben eine IT-Abteilung, die gerne möglichst wenig kommuniziert. Ich komme quasi mit meinen Kabeln daher und stöpsel mich an, und wenn nicht geht was gehen sollte sage ich: Hier, kaputt. Hilf. (Und das ist gewünscht so, die lassen keinen anderen an ihr Heiligtum. Was ich auch ein wenig verstehen kann.)

Bzgl. ICS: Danke für den Tipp! Für dieses Projekt im speziellen würde ich solch einen großen Umbau gern tunlichst vermeiden, aber für die Zukunft schau ich mir das definitiv mal an. Kurze Nachfrage: Wo liegt der Vorteil zu den Indys (mit denen ich für neue Projekte auch schon geliebäugelt hatte)?

[TiGü]

Ohne allzu fit in dem Thema zu sein, aber kannst du nicht in einen Thread parallel zu der alten TClientSocket-Komponente mit der WinApi einfach nur prüfen, ob der Ziel-Socket da/offen/erreichbar ist und das Ergebnis in den Mainthread synchronisieren und entsprechend reagieren?
https://www.delphi-treff.de/tutorial...ts-mit-winapi/

[Medium]

Genau das ist der Plan. Siehe weiter oben ;)

[TiGü]

Zitat:

Zitat von Medium (Beitrag 1401667)

Genau das ist der Plan. Siehe weiter oben ;)

Do it! :thumb:

[ensaron]

Zitat:

Zitat von Medium (Beitrag 1401660)

Bzgl. ICS: Danke für den Tipp! Für dieses Projekt im speziellen würde ich solch einen großen Umbau gern tunlichst vermeiden, aber für die Zukunft schau ich mir das definitiv mal an. Kurze Nachfrage: Wo liegt der Vorteil zu den Indys (mit denen ich für neue Projekte auch schon geliebäugelt hatte)?

In den Projekten, wo ich die ICS Komponenten einsetze, liegt der Vorteil für mich vor allem in der asynchronen Ausführung. Man kommt einfach zu jedem Zeitpunkt an die Komponente heran und kann auch mal bei Bedarf einen Verbindungsaufbau oder -trennung oder eine Abfrage von Daten einfach abbrechen ohne auf einen Timeout in der Komponente warten zu müssen.

[Medium]

Danke für die Infos!

Ich habe hier jetzt leider ein großes Problem: Mein Socket im Thread will sich nicht verbinden, aber ein TClientSocket, der als Komponente auf meinem Formular liegt und exakt dieselben Settings hat kann dies ohne Probleme. Hier mal mein Thread:

Delphi-Quellcode:

constructor TSocketProbeThread.Create(aSocket: TClientSocket; aPauseTime: Integer);
begin
  inherited Create(false);
  FIP := aSocket.Host;
  FPort := aSocket.Port;
  FPauseTime := aPauseTime;
  FCS := TCriticalSection.Create;
end;

procedure TSocketProbeThread.Execute;
begin
  inherited;
  repeat
    FCS.Enter;
    try
      if not Assigned(FSocket) then
      begin
        FSocket := TClientSocket.Create(nil);
        FSocket.OnError := SocketError;
        FSocket.Host := FIP;
        FSocket.Port := FPort;
        FSocket.ClientType := ctNonBlocking;
      end;
      if (not FSocket.Active) then
      begin
        try
          FSocket.Active := true;
        except;
          Sleep(100);
        end;
      end;
    finally
      FCS.Leave;
    end;
    Sleep(FPauseTime);
  until Terminated;
end;

(Das Sleep(100) im except-Zweig ist nur für mich zum Haltepunkt setzen.)

Das Programm läuft ohne jeden Fehler zu generieren "FSocket.Active := true;" durch, aber .Active ist danach weiterhin false. Es wird weder der Except-Zweig betreten, noch wird OnError ausgelöst, und der Thread wird auch nicht weggeschossen. Er läuft brav weiter und versucht im gesetzten Intervall (10s im Moment) Active zu setzen, aber es bleibt einfach immer false. Ohne Fehler ohne alles.

Nehme ich den Socket, den ich im Create als Datenspender übergebe, welcher auf meinem Formular liegt, verbindet dieser sich sofort und ohne Probleme. Was mache ich hier falsch jetzt?

[TiGü]

Landet der Debugger bis in TCustomWinSocket.Open und darin in procedure TCustomWinSocket.DoOpen bzw. TCustomWinSocket.AsyncInitSocket? Oder kommst du da schon gar nicht hin?

[Medium]

Leider springt der Debugger erst gar nicht in die Zuweisung (F7), und Breakpoints in der Unit ScktComp werden mir deaktiviert. Das schmälert meine Möglichkeiten schon recht arg ein :(

[Medium]

Ich habe jetzt mal versucht, wie hier und da empfohlen, die scktcomp.dcu zu löschen (bzw. umzubenennen, ich bin ja vorsichtig). Leider meldet mir dann der Compiler, dass ihm diese Datei dann fehlt. Diese selbst mal zu kompilieren, auf die Idee kommt er nicht, obwohl der Pfad sowohl im Such- als auch Bibliothekspfad eingestellt ist.

Dann habe ich mal versucht dclusr neu zu kompilieren, alle 3 Projektdateien die es in dem lib-Ordner mit diesem Namen gibt. Alle 3 zeigen unter "Enthält" nichts. Kompilieren bringt auch nichts. Dann habe ich ein eigenes Package erstellt und die scktcomp.pas hinzugefügt, und da sagte man mir dann, dass diese bereits in "rtl" vorhanden sei. Ich finde aber kein zugehöriges Package, das ich mal kompilieren könnte. Die .pas alleine kompiliert auch nicht.

Wie zum Henker erstelle ich denn nun mal neue DCUs!? (In der Hoffnung, dass es "nur" daran lag.)

[Medium]

Ein letzter Eintrag: Gelöst!!

ich habe einfach mal die scktcomp.pas in mein Projektverzeichnis kopiert, und siehe da: SO kann ich darin auch debuggen. Und was habe ich herausgefunden? Im Thread muss der Socket blocking sein! Ich weiß nicht warum, weil mein VCL-Thread ist ja am Ende auch nur ein Thread und da geht's nonBlocking, aber egal. Ich bin einfach nur froh, langsam mal über Mittagessen nachdenken zu können!

Cheers!

[blawen]

Zitat:

Zitat von ensaron (Beitrag 1401630)

Die endgültige Lösung war bei mir dann übrigens der Umstieg auf die Overbyte ICS Komponenten, die funktionieren asynchron (und daher ohne Hänger beim Verbindgen etc.). Wenn das für dich eine Option wäre, kann ich ja hier mal ein Beispiel für die Ansteuerung anhängen.

Das Problem ist zwar gelöst, aber da ich die ICS bisher nicht kenne, würde mich Dein Beispiel interessieren.

[Mavarik]

Zitat:

Zitat von KodeZwerg (Beitrag 1401564)

Hi, ich hab hier zwei Sources entdeckt die das Thema Socket+(multi)Thread aufgreifen, vielleicht ist etwas für Dich dabei?

[OT]
Nicht das ich einen guten Source-Code nicht zu schätzen wüsste, aber :

Du kannst den Source auch als File ins Posting bringen und vielleicht dann einzelne rauskopieren, falls Du dazu einen Kommentar anbringen möchtest.

Auf jeden Fall vorher mal einen DelphiSource-Formatter drüber laufen lassen, besonders wenn es so gruselige One-Liner sind.
[/OT]

Zum Thema... Eine UPD/TCP Socket inkl. asynchroner Verarbeitung kann man über die Windows API. in unter 400 LOC implementieren...

Hierzu würde diesen Link empfehlen. (Auch wenn der Sourcelink in diesem Artikel nicht richtig funktioniert - man kann es so runter tippen).

Mavarik :coder:

[Michael II]

Zitat:

Zitat von blawen (Beitrag 1401751)

Zitat:

Zitat von ensaron (Beitrag 1401630)

Die endgültige Lösung war bei mir dann übrigens der Umstieg auf die Overbyte ICS Komponenten, die funktionieren asynchron (und daher ohne Hänger beim Verbindgen etc.). Wenn das für dich eine Option wäre, kann ich ja hier mal ein Beispiel für die Ansteuerung anhängen.

Das Problem ist zwar gelöst, aber da ich die ICS bisher nicht kenne, würde mich Dein Beispiel interessieren.

Tipp: "ICS Overbyte" kannst du in neueren Delphis direkt über dein Delphi, dort über "Tools > GetItPackageManager, ICS Overbyte" installieren.

Mit Overbyte ist alles Ereignis gesteuert. Du kannst zum Beispiel direkt auf OnChangeState des Sockets reagieren: Wenn dir via das Ereignis TWSocket.OnChangeState signalisiert wird, dass dein Socket neu geschlossen ist (wsClosed), kannst du den Wiederaufbau einleiten.


Beispiel (Code unten).
Drei Sockets: ListenSocket, SocketB und SocketA. Ziel: Aufbau einer Verbindung SocketA <-> SocketB.

Beim Starten der App geht der ListenSocket auf wsListening. (FormCreate)

Drück den Button „Verbinde“. SocketA leitet den Verbindungsaufbau zu ListenSocket ein (Verbinde).

ListenSocket: Das Ereignis OnSessionAvailable wird ausgelöst (ListenSocketSessionAvailable). ListenSocket akzeptiert die Verbindung (Accept) und SocketB übernimmt diese (Dup). SocketA und SocketB sind nun miteinander verbunden.

Zweites Ziel: Wiederaufbau der Leitung, falls SocketA.SocketState = wsClosed:
Drück den Button „Schliessen“. SocketA oder SocketB werden geschlossen.

Via das Ereignis OnChangeState (SocketAChangeState) werden Änderungen des SocketStates signalisiert. Sollte der SocketState von SocketA neu wsClosed sein, leiten wir den Wiederaufbau der Verbindung SocketA -> (ListenSocket ->) Socket B ein.

Im Memo werden alle Änderungen der SocketStates angezeigt.


Drittes Ziel: Sende einen String von A nach B.
Mittels SocketA.SendStr( s ) versendest du einen String s.

Im Ereignis OnDataAvailable von SocketB wird der Empfang von Daten angezeigt. Die Daten können zum Beispiel mit SocketB.ReceiveStr ausgelesen werden.


[ In der Praxis kann es hilfreich sein, periodisch ein „Ping-Paket“ über die aufgebaute Leitung zu senden und die Verbindung neu aufzubauen, wenn das Paket „zu lange“ nicht quittiert wird.
Wahrscheinlich würdest du zu sendende Daten in einen Buffer schreiben und erst dann löschen, wenn die Gegenstelle den Empfang der Daten bestätigt hat.]

Delphi-Quellcode:

unit Unit38;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, OverbyteIcsWndControl,
  OverbyteIcsWSocket, Vcl.StdCtrls;


const WM_MEINEMELDUNG = WM_APP + 1;

type
  TForm38 = class(TForm)
    SocketA: TWSocket;
    ListenSocket: TWSocket;
    SocketB: TWSocket;
    VerbindeButton: TButton;
    SchliessenButton: TButton;
    Memo1: TMemo;
    SendeString: TButton;
    procedure FormCreate(Sender: TObject);
    procedure VerbindeButtonClick(Sender: TObject);
    procedure ListenSocketSessionAvailable(Sender: TObject; ErrCode: Word);
    procedure SocketAChangeState(Sender: TObject; OldState,
      NewState: TSocketState);
    procedure SchliessenButtonClick(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure SendeStringClick(Sender: TObject);
    procedure SocketBDataAvailable(Sender: TObject; ErrCode: Word);
  private
    { Private-Deklarationen }
    procedure Machetwas(var Message: TMessage); message WM_MEINEMELDUNG;
  public
    { Public-Deklarationen }
    procedure Verbinde;
  end;

var
  Form38: TForm38;

implementation

{$R *.dfm}

uses System.TypInfo;

var appschliesst : boolean = false;

function socketstr( hss : TSocketState ) : string;
begin
  { Wert von hss in String umwandeln }
  Result := GetEnumName(typeinfo(TSocketState),ord(hss));
end;


procedure TForm38.Machetwas(var Message: TMessage);
begin
  case Message.WParam of
  0 : begin
        { Störung simulieren: SocketA oder Gegenstelle SocketB schliessen }
        Memo1.Lines.Add('Entweder SocketA oder SocketB schliessen');
        case random(2) of
        0: SocketA.Close;
        1: SocketB.Close;
        end;
      end;
      { SocketA verbindet neu mit der Gegenstelle }
  1 : Verbinde;
  end;
end;


procedure TForm38.SchliessenButtonClick(Sender: TObject);
begin
   PostMessage( Handle, WM_MEINEMELDUNG, 0, 0 );
end;


procedure TForm38.VerbindeButtonClick(Sender: TObject);
begin
  Verbinde;
end;

{ ListenSocket geht in den SocketState wsListening über: }

procedure TForm38.FormCreate(Sender: TObject);
begin
  ListenSocket.Addr := '0.0.0.0';
  ListenSocket.Port := '7001';
  ListenSocket.Proto := 'tcp';
  ListenSocket.Listen;

  ListenSocket.OnChangeState := SocketAChangeState;
  SocketA.OnChangeState := SocketAChangeState;
  SocketB.OnChangeState := SocketAChangeState;

  ListenSocket.OnSessionAvailable := ListenSocketSessionAvailable;

  SocketB.OnDataAvailable := SocketBDataAvailable;
end;


{ SocketA soll mit ListenSocket verbinden: }

procedure TForm38.Verbinde;
begin
  Memo1.Lines.Add('SocketA Verbindungsaufbau');
  SocketA.Close;
  SocketA.Addr := '127.0.0.1';
  SocketA.proto := 'tcp';
  SocketA.Port := '7001';
  SocketA.Connect;
end;


{ OnSessionAvailable:
  ListenSocket akzeptiert die Verbindung, SocketB übernimmt (Dup) - SocketA und SocketB sind miteinander verbunden }

procedure TForm38.ListenSocketSessionAvailable(Sender: TObject; ErrCode: Word);
var h : THandle;
begin
    h := ListenSocket.Accept;
    SocketB.Dup( h );
end;


{ ChangeState:
  Änderung SocketState }

procedure TForm38.SocketAChangeState(Sender: TObject; OldState,
  NewState: TSocketState);
begin
    if appschliesst then
    begin
      if ( SocketA.State = wsclosed ) and ( SocketB.State = wsClosed ) then close;
    end
    else
    begin
      Memo1.Lines.Add( (Sender as TWSocket).Name + ' ' + socketstr(OldState) + '->' + socketstr(NewState) );

      if ( Sender = SocketA ) then
      if ( OldState = wsConnected ) and ( NewState = wsClosed ) then
      PostMessage( Handle, WM_MEINEMELDUNG, 1, 0 );
    end;
end;


{ Beispiel: SocketA sendet einen String an SocketB }

procedure TForm38.SendeStringClick(Sender: TObject);
begin
  if SocketA.State = wsConnected then
  SocketA.SendStr( Memo1.Text );
end;

{ SockezB empfängt den String}

procedure TForm38.SocketBDataAvailable(Sender: TObject; ErrCode: Word);
var empfangen : string;
begin
  empfangen := SocketB.ReceiveStr;
  if empfangen <> '' then
  ShowMessage( empfangen );
end;


{ Die App soll geschlossen werden...
  Wenn SocketA oder SocketB nicht geschlossen sind => canclose:= false =>
  Im SocketAChangeState wird Close aufgerufen, sobald SocketA und SocketB geschlossen sind }

procedure TForm38.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  {.....}
  if canclose then
  begin
      appschliesst := true;
      ListenSocket.Close;
      SocketA.CloseDelayed;
      SocketB.CloseDelayed;
      canclose := ( SocketA.State = wsclosed ) and ( SocketB.State = wsClosed );
  end;
end;

end.