unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls,
ScktComp;
//-- wegen TServerSocket
type
TForm1 =
class(TForm)
Button1: TButton;
Memo1: TMemo;
Button2: TButton;
ClientSocket1: TClientSocket;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure ClientSocket1Connect(Sender: TObject;
Socket: TCustomWinSocket);
procedure Button2Click(Sender: TObject);
private
FNextPort: Word;
FServerArray :
array of TServerSocket;
procedure ServerSocketClientConnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure ServerSocketClientDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure ServerSocketClientError(Sender: TObject;
Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
procedure ServerSocketClientRead(Sender: TObject;
Socket: TCustomWinSocket);
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
FNextPort := 15000;
end;
procedure TForm1.ServerSocketClientConnect(Sender: TObject;
Socket: TCustomWinSocket);
begin
Memo1.Lines.Add(
'
Ein Client hat sich mit folgendem eindeutigen Socket verbunden. Socket: ' +
inttostr(Socket.SocketHandle)
);
end;
procedure TForm1.ServerSocketClientDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
begin
Memo1.Lines.Add(
'
Ein Client hat sich mit folgendem eindeutigen Socket abgemeldet. Socket: '+
inttostr(Socket.SocketHandle)
);
end;
procedure TForm1.ServerSocketClientError(Sender: TObject;
Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
begin
Memo1.Lines.Add(
'
Ein Clientverbindung mit folgendem eindeutigen Socket: ' +
inttostr(Socket.SocketHandle) +
'
hat einen Fehler verursacht, der socket Fehlercode:' +
inttostr(ErrorCode)
);
end;
procedure TForm1.ServerSocketClientRead(Sender: TObject;
Socket: TCustomWinSocket);
var
cbRcv: integer;
RcvBuf:
array [0..32767]
of Byte;
s:
string;
begin
cbRcv := Socket.ReceiveBuf(RcvBuf[0], Length(RcvBuf));
if (cbRcv > 0)
and (Socket.SocketHandle > 0)
then begin
SetLength(s, cbRcv);
move(RcvBuf[0], s[1], cbRcv);
Memo1.Lines.Add('
Für Client mit folgendem eindeutigen Socket: ' +
inttostr(Socket.SocketHandle) + '
wurden ' + IntToStr(cbRcv) + '
Bytes ' +
'
mit folgenden Daten [ ' + s + '
] empfangen'
);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
inc(FNextPort);
SetLength(FServerArray, Length(FServerArray) + 1);
FServerArray[Length(FServerArray) -1] := TServerSocket.create(
nil);
with FServerArray[Length(FServerArray) -1]
do begin
Name := '
A' + IntToStr(FNextPort);
ServerType := stNonBlocking;
Port := FNextPort;
Service := '
';
OnClientConnect := ServerSocketClientConnect;
OnClientDisconnect := ServerSocketClientDisconnect;
OnClientError := ServerSocketClientError;
OnClientRead := ServerSocketClientRead;
Active := true;
end;
end;
procedure TForm1.ClientSocket1Connect(Sender: TObject;
Socket: TCustomWinSocket);
var
s:
string;
begin
s := '
Hello world!';
if Socket.SendBuf(s[1], Length(s)) <> Length(s)
then
raise exception.Create('
Fehler beim Senden');
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
ClientSocket1.Active := true;
end;
end.