AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Programmierung allgemein Netzwerke Anfängerfrage: Non Blocking TCP Client in einem Thread
Thema durchsuchen
Ansicht
Themen-Optionen

Anfängerfrage: Non Blocking TCP Client in einem Thread

Ein Thema von alzaimar · begonnen am 4. Dez 2009 · letzter Beitrag vom 7. Dez 2009
 
Benutzerbild von sirius
sirius

Registriert seit: 3. Jan 2007
Ort: Dresden
3.443 Beiträge
 
Delphi 7 Enterprise
 
#8

Re: Anfängerfrage: Non Blocking TCP Client in einem Thread

  Alt 5. Dez 2009, 16:17
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;
Dieser Beitrag ist für Jugendliche unter 18 Jahren nicht geeignet.
  Mit Zitat antworten Zitat
 


Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 15:29 Uhr.
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz