unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, XPMan, ScktComp;
type TChatNachricht =
Record
nick:
string[255];
chat:
string[255];
state:
string[255];
hand:
string[255];
table:
string[255]
end;
type
TForm1 =
class(TForm)
Label1: TLabel;
Memo1: TMemo;
chat: TEdit;
send: TButton;
XPManifest1: TXPManifest;
GroupBox1: TGroupBox;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
Label7: TLabel;
Label8: TLabel;
Label9: TLabel;
Label10: TLabel;
Edit2: TEdit;
kick: TButton;
GroupBox2: TGroupBox;
Label11: TLabel;
Label12: TLabel;
Label13: TLabel;
Label14: TLabel;
Label15: TLabel;
Label16: TLabel;
Label17: TLabel;
Label18: TLabel;
Label19: TLabel;
Label20: TLabel;
Label21: TLabel;
Label22: TLabel;
Label23: TLabel;
Label24: TLabel;
Label25: TLabel;
GroupBox3: TGroupBox;
Edit3: TEdit;
Label26: TLabel;
Label27: TLabel;
port: TEdit;
startserver: TButton;
kickall: TButton;
exit: TButton;
Label28: TLabel;
CheckBox1: TCheckBox;
CheckBox2: TCheckBox;
ServerSocket1: TServerSocket;
procedure sendClick(Sender: TObject);
procedure startserverClick(Sender: TObject);
procedure exitClick(Sender: TObject);
procedure ServerSocket1ClientConnect(Sender: TObject; Socket: TCustomWinSocket);
procedure ServerSocket1ClientRead (Sender: TObject; Socket: TCustomWinSocket);
private
{ Private-Deklarationen }
public
{ Public-Deklarationen }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
{******************* ON CLIEN CONNET************************************** ****************************}
procedure TForm1.ServerSocket1ClientConnect (Sender: TObject; Socket: TCustomWinSocket);
var Nachricht: TChatNachricht;
var I: Integer;
begin
Memo1.Lines.Add ('
Status: Neuer user verbunden');
Nachricht.nick := '
Server';
Nachricht.state :='
msg';
Nachricht.chat := '
Willkommen am Chat-Server';
Socket.SendBuf (Nachricht, SizeOf(Nachricht));
with ServerSocket1.Socket
do begin
Nachricht.nick := '
Server';
Nachricht.state :='
msg';
Nachricht.chat := '
Jetzt ' + IntToStr(ActiveConnections) + '
Teilnehmer';
for I := 0
to ActiveConnections-2
do
Connections[I].SendBuf (Nachricht, SizeOf(Nachricht))
end;
{with}
Memo1.Lines.add ('
New user connected');
end;
{******************* ************************************** ****************************}
procedure TForm1.exitClick(Sender: TObject);
begin
serversocket1.close;
close;
end;
//------------- SERVER ON READ -----------------------------------------------------------------
procedure TForm1.ServerSocket1ClientRead (Sender: TObject; Socket: TCustomWinSocket);
var
Nachricht : TChatNachricht;
begin
socket.receiveBuf(Nachricht, SizeOf (Nachricht));
if Nachricht.state = '
msg'
then begin
Memo1.Lines.add (Nachricht.nick+ '
: '+ Nachricht.chat);
end;
if Nachricht.state <> '
msg'
then begin
Memo1.Lines.add ('
Error');
end;
end;
procedure TForm1.startserverClick(Sender: TObject);
begin
if serversocket1.active = false
then begin
serversocket1.Port := strtoint (port.text);
port.enabled := false;
startserver.caption := '
Stop Server';
serversocket1.open;
end
else
if serversocket1.active = true
then begin
serversocket1.close;
port.Enabled := true;
startserver.caption := '
Start Server';
end;
end;
//------------- CHAT SENDEN -----------------------------------------------------------------
procedure TForm1.sendClick(Sender: TObject);
var
Nachricht : TChatNachricht;
i: Integer;
begin
if serversocket1.Active
then begin
Nachricht.chat :=
chat.text;
chat.text := '
';
Nachricht.state := '
msg';
Nachricht.nick := '
Server';
with ServerSocket1.Socket
do begin
for I := 0
to ActiveConnections-1
do
Connections[I].SendBuf (Nachricht, SizeOf(Nachricht))
end;
{with}
Memo1.Lines.add ('
Server: '+ Nachricht.chat);
end
else begin
Memo1.lines.add ('
Error: Server not online!');
chat.text := '
';
end;
end;
end.