Anfängerfrage: Non Blocking TCP Client in einem Thread

[sirius]

Du kannst den Client recht einfach in einen Thread legen, musst halt nur eine MEssageloop dort reinlegen. Z.Bsp: funktioniert folgendes:

Delphi-Quellcode:

uses windows, messages, classes, scktcomp, sysutils,
     syncobjs;


type
  TDataReceivedEvent=procedure(Sender:TObject; const Data:String) of object;

  TClient=class(TThread)
    Constructor Create(CreateSuspended: Boolean); reintroduce;
    Destructor Destroy; override;
   private
    FOnDataReceived: TDataReceivedEvent;
    FCLientSocket:TClientSocket;
    FEvent:TEvent;
    FThreadList:TThreadList;
    FRecvData:String;
    FErrorCode:Integer;
    procedure SetOnDataReceived(const Value: TDataReceivedEvent);
    procedure SocketConnected(Sender:TObject; Socket:TCustomWinSocket);
    procedure SocketError(Sender:TObject; Socket:TCustomWinSocket;
      ErrorEvent: TErrorEvent; var ErrorCode: Integer);
    procedure ReadDataFromSocket(Sender:TObject; Socket:TCustomWinSocket);
   protected
    procedure Execute; override;
    procedure DoOnDatareceived; virtual;
   public
    Procedure SendData(Const Data : String);
    Property OnDataReceived :TDataReceivedEvent read FOnDataReceived write SetOnDataReceived;
    procedure Terminate; reintroduce;
   end;

  TSendData=class
   private
    FData: String;
    procedure SetData(const Value: String);
   public
    property Data:String read FData write SetData;
  end;

implementation

{ TClient }

constructor TClient.Create(CreateSuspended: Boolean);
begin
  inherited;
  FEvent:=TEvent.Create(nil,false,false,'');
  FThreadList:=TThreadList.Create;
end;

destructor TClient.Destroy;
begin
  FEvent.Free;
  FThreadList.Free;
  inherited;
end;

procedure TClient.DoOnDatareceived;
begin
  if assigned(FOnDatareceived) then
    FOnDataReceived(self,FRecvData);
end;

procedure TClient.Execute;
var msg:Tmsg;
    eventhandle:THAndle;
begin
  FClientsocket:=TClientSocket.Create(nil);
  try
    FClientsocket.ClientType:=ctNonBlocking;
    FClientSocket.OnConnect:= SocketConnected;
    FClientSocket.OnRead := ReadDataFromSocket;
    FClientSocket.OnError := SocketError;
    //...
    FClientSocket.Address:='127.0.0.1';
    FClientSocket.Port:=21000;
    FClientSocket.Open;
    eventHandle:=FEvent.Handle;
    repeat
      case MsgWaitForMultipleObjects(1,eventhandle,false,infinite,QS_PostMessage) of
        WAIT_OBJECT_0: //Event fired
          if not terminated then
          begin
            with FThreadList.LockList do
            try
              if Count>0 then
              begin
                FClientSocket.Socket.SendText(
                 (TObject(Extract(First)) as TSendData).Data);
                if Count>0 then FEvent.SetEvent;
              end;
            finally
              FThreadList.UnlockList;
            end;
          end;
        WAIT_OBJECT_0+1: //Message
          while PeekMessage(msg,0,0,0,pm_Remove) do
           Dispatchmessage(msg);
        $FFFFFFFF: //Error
          raise Exception.Create(syserrormessage(getlasterror));
      end;
      if FErrorCode<>0 then  //asynchroner Error (aus Methode SocketError)
        raise Exception.Create(syserrormessage(FErrorCode));
    until terminated;
  finally
    FClientSocket.Free;
  end;
end;

procedure TClient.ReadDataFromSocket(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  FRecvData:=Socket.ReceiveText;
  synchronize(DoOnDataReceived);
end;

procedure TClient.SendData(const Data: String);
var SendData:TSendData;
begin
  SendData:=TSendData.Create;
  SendData.Data:=Data;
  with FThreadList.LockList do
  try
    Add(SendData);
  finally
    FThreadList.UnlockList;
  end;
  FEvent.SetEvent;
end;

procedure TClient.SetOnDataReceived(const Value: TDataReceivedEvent);
begin
  FOnDataReceived := Value;
end;

procedure TClient.SocketConnected(Sender: TObject;
  Socket: TCustomWinSocket);
begin

end;

procedure TClient.SocketError(Sender: TObject; Socket: TCustomWinSocket;
  ErrorEvent: TErrorEvent; var ErrorCode: Integer);
begin
  FErrorCode:=ErrorCode;  //selber behandlen;
  ErrorCode:=0;
end;

procedure TClient.Terminate;
begin
  inherited;
  FEvent.SetEvent;
end;

{ TSendData }

procedure TSendData.SetData(const Value: String);
begin
  FData := Value;
end;

Bei mir allerdings nur mit dem MAinthread als Sender und Empfänger, aber senden kann hier auch jeder andere Thread:

Delphi-Quellcode:

type
  TForm1 = class(TForm)
    Button1: TButton;
    Edit1: TEdit;
    Memo1: TMemo;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private-Deklarationen }
    FClient:TClient;
    procedure ClientData(Sender:TObject; const Data:String);
    procedure ClientTerminate(Sender:TObject);
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  FClient:=TClient.Create(true);
  FClient.OnDataReceived:=ClientData;
  FClient.OnTerminate:=ClientTerminate;
  FClient.Resume;
end;

procedure TForm1.ClientData(Sender: TObject; const Data: String);
begin
  memo1.lines.add(Data);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  FClient.SendData(edit1.text);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  FClient.Terminate;
  FClient.WaitFor;
  FClient.Free;
end;

procedure TForm1.ClientTerminate(Sender: TObject);
begin
  if assigned((Sender as TThread).FatalException) then
  begin
    application.ShowException(
      TThread(Sender).FatalException as Exception);
    close;
  end;
end;