unit Chat;
interface
uses
Controls, Forms, Classes,
IdBaseComponent, IdComponent, IdTCPServer, IdContext,
SysUtils, IdCustomTCPServer, StdCtrls,IdGlobal, ExtCtrls;
type
TForm1 =
class(TForm)
TCPServ: TIdTCPServer;
Button1: TButton;
ListBox1: TListBox;
Button2: TButton;
procedure OnExecute(AContext: TIdContext);
procedure AnAlleSenden (LLine:
string);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Connect(AContext: TIdContext);
procedure Disconnect(AContext: TIdContext);
private
{ Private-Deklarationen }
public
{ Public-Deklarationen }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.AnAlleSenden (LLine:
string);
var i:integer;
begin
//for i:=0 to TCPServ.Contexts.LockList.Count -1 do
//TIdContext(TCPServ.Contexts.LockList.Items[i]).Connection.IOHandler.writeln('>>'+LLine);
with TCPServ.contexts.LockList
do
try
for i := 0
to Count-1
do
begin
TIdContext(TCPServ.Contexts.LockList.Items[i]).Connection.IOHandler.writeln('
>>'+LLine);
end;
finally
TCPserv.Contexts.UnlockList;
end;
end;
procedure TForm1.OnExecute(AContext: TIdContext);
var Operation,i:integer;
var LLine,lcmd:
string;
begin
with AContext.Connection.IOHandler
do
LLine := ReadLn;
LCmd := Fetch(LLine);
Operation := strtoint(LCmd[1]);
Case Operation
of
0: AnAlleSenden('
<Server>:ClientConnected!');
1: AnAlleSenden(copy(LCmd,2,length(LCmd)));
2:
begin AContext.Connection.Disconnect;listbox1.items.add('
Client disconnected');
end;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
TCPServ.Active:=true;
listbox1.Items.add('
Server gestartet!');
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
TCPServ.Active:=false;
listbox1.Items.add('
Server gestoppt!');
end;
procedure TForm1.Connect(AContext: TIdContext);
begin
AContext.Connection.IOHandler.writeln ('
Willkommen!');
end;
procedure TForm1.Disconnect(AContext: TIdContext);
begin
AContext.Connection.
end;
end.