Accept blockt nicht?

[Pseudo]

Hallo,

Ich hab ein Problem mit WinSock:

Ich würde gerne einen Multithreaded-Server mit den Windows Sockets aufbauen, hier meine Versuche:

Code: Alles auswählen

unit userver;
 
{$mode objfpc}{$H+}
 
interface
 
uses
  Classes, SysUtils, winsock, Windows ;
 
type
 
  TClient = class;
  TConnectEvent = procedure(C: TClient) of Object;
  TDisconnectEvent = procedure(C: TClient) of object;
  TReceiveEvent = procedure(Text: String; C: TClient) of object;
 
  TClient = class(TThread)
  private
     FOnReceive: TReceiveEvent;
 
  public
     FSocket: TSocket;
    // procedure Send(Text: String);
     property OnReceive: TReceiveEvent read FOnReceive write FOnReceive;
 
  end;
 
 
 
 
 
 
  TServer = class(TThread)
  private
 
    procedure Accept1;
    procedure Receive(Text: String; C: TClient);
  private
    FOnServerReceive: TReceiveEvent;
    FOnConnect: TConnectEvent;
    FOnDisconnect: TDisconnectEvent;
  public
    FSocket: TSocket;
    procedure Execute; override;
 
  public
    Liste: TStringList;
    property OnServerReceive: TReceiveEvent read FOnServerReceive write FOnServerReceive;
    property OnConnect: TConnectEvent read FonConnect write FonConnect;
    property OnDisconnect: TDisconnectEvent read Fondisconnect write FOnDisconnect;
 
 
 
  end;
 
 
implementation
 
procedure TServer.Execute;
var Data: WSAData;
    SockAddr:TSockAddrIn;
    AddrLen:Integer;
      AddrLen2:Integer;
  SocketAddr:PSockAddr;
  ConnectSocket:Tsocket;
begin
  WSAStartup( MakeWord(1,1), Data);
  FSocket := socket(AF_INET,
                   SOCK_STREAM,
                   IPProto_TCP);
 
  AddrLen := sizeof(SockAddr);
 
  SockAddr.sin_family := AF_Inet;
  SockAddr.sin_port := htons(6000);
  SockAddr.sin_addr.S_addr := inet_addr('0');
 
  Bind( FSocket, SockAddr, AddrLen);
  Listen( FSocket, 0);
  //Accept1();
  while (true) do begin
   AddrLen := SizeOf(SocketAddr);
   ConnectSocket := Accept(FSocket, SocketAddr, Addrlen2);
   Windows.MessageBox(0, 'ASD', 'ASD', MB_OK);
   end;
 
end;
 
procedure TServer.Accept1;
var
  Client: TClient;
  AddrLen:Integer;
  SocketAddr:PSockAddr;
  ConnectSocket:Tsocket;
 
begin
 
 
 
 
   //Send(ConnectSocket,'ASD', 3, 0);
   //Client := TClient.Create(True);
   //Client.FSocket := ConnectSocket;
   //Client.Start;
   end;
 
 
 
procedure TServer.Receive(Text: String; C: TClient);
begin
 
end;
 
 
 
end.

Jedoch wird die Messagebox (die eigentlich nur bei einem Accept (solange sollte der Thread bölockieren) auftauchen soll) tausendmal angezeigt!

Wo liegt der Fehler?

Danke an alle!

Pseudo

[MAC]

Ich kenn mich zwar nicht mit den Windows Sockets direkt aus, ich verwende meistens einen Layer, bevorzugt LNet...
Aber ich würde sagen die Showmessage in eine while-true schleife zu legen ist der grund das die ganze zeit Messages angezeigt werden...

Zudem denke ich mal, kann es durchaus sein das Accept das programm blockt, für ca 3 Millisekunden. Das würde dann nur noch 333 Messages pro sekunde anzeigen lassen Wäre ein einzelner Accept block nicht angebrachter ? Mal ganz davon abgesehen das man bei der Bibliothek LNet (oder alternative Synapse) ziemlich gut aufgehoben ist