Socket-Verbindung herstellen ohne zu blockieren

[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.