program ClientSocketTest;
uses
Windows, ScktComp, SysUtils, Classes;
type
TTCPThread =
class(TThread)
private
procedure DoConnect;
public
Client: TClientSocket;
procedure Execute;
override;
end;
TTCPObject =
class(TObject)
private
public
Client: TClientSocket;
procedure OnConnect(Sender: TObject; Socket: TCustomWinSocket);
procedure OnDisconnect(Sender: TObject; Socket: TCustomWinSocket);
procedure OnRead(Sender: TObject; Socket: TCustomWinSocket);
procedure OnError(Sender: TObject; Socket: TCustomWinSocket;
ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
constructor Create;
destructor Destroy;
override;
procedure StartConnecting;
end;
constructor TTCPObject.Create;
begin
inherited;
Client := TClientSocket.Create(
nil);
Client.OnConnect := OnConnect;
Client.OnDisconnect := OnDisconnect;
Client.OnRead := OnRead;
Client.OnError := OnError;
Client.Host := '
localhost';
Client.Port := 6000;
end;
destructor TTCPObject.Destroy;
begin
Client.Free;
inherited;
end;
procedure TTCPObject.OnConnect(Sender: TObject; Socket: TCustomWinSocket);
begin
end;
procedure TTCPObject.OnDisconnect(Sender: TObject; Socket: TCustomWinSocket);
begin
end;
procedure TTCPObject.OnError(Sender: TObject; Socket: TCustomWinSocket;
ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
begin
end;
procedure TTCPObject.OnRead(Sender: TObject; Socket: TCustomWinSocket);
begin
end;
procedure TTCPObject.StartConnecting;
var
TCPThread: TTCPThread;
begin
TCPThread := TTCPThread.Create(true);
TCPThread.FreeOnTerminate := true;
TCPThread.Client := Client;
TCPThread.Resume;
end;
procedure TTCPThread.DoConnect;
begin
Client.Active := true;
// wird niemals aufgerufen
end;
procedure TTCPThread.Execute;
begin
inherited;
repeat
Synchronize(DoConnect);
// Bis hierhin und nicht weiter ..
Sleep(1000);
until (Terminated)
or (Client.Active);
end;
var
Msg: TMsg;
TCP: TTCPObject;
begin
TCP := TTCPObject.Create;
TCP.StartConnecting;
while GetMessage(Msg, 0, 0, 0)
do
begin
TranslateMessage(Msg);
DispatchMessage(Msg);
end;
end.