unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, IdTCPServer, IdBaseComponent, IdComponent, IdTCPConnection,
IdTCPClient, StdCtrls, IdThreadMgr, IdThreadMgrDefault;
type
TNachricht =
record
Benutzer,Msg:
string[100];
end;
type
ZClient = ^Client;
Client =
record
Name :
String[20];
Verbunden,Aktion : TDateTime;
Thread : Pointer;
end;
type
TForm1 =
class(TForm)
IdTCPClient1: TIdTCPClient;
IdTCPServer1: TIdTCPServer;
ListBox1: TListBox;
Button1: TButton;
Edit1: TEdit;
Button2: TButton;
ListBox2: TListBox;
IdThreadMgrDefault1: TIdThreadMgrDefault;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure IdTCPServer1Connect(AThread: TIdPeerThread);
procedure IdTCPServer1Execute(AThread: TIdPeerThread);
procedure IdTCPServer1Disconnect(AThread: TIdPeerThread);
procedure IdTCPClient1Connected(Sender: TObject);
procedure FormClose(Sender: TObject;
var Action: TCloseAction);
private
{ Private declarations }
public
{ Public declarations }
end;
type
Leser =
class(TThread)
private
Nachricht:TNachricht;
protected
procedure execute;
override;
end;
var
Form1: TForm1;
Clienten : TThreadlist;
implementation
{$R *.dfm}
procedure Leser.execute;
begin
while not Terminated
do
begin
if not Form1.IdTCPClient1.Connected
then Terminate
else
try
Form1.IdTCPClient1.ReadBuffer(Nachricht,sizeof(Nachricht));
Form1.ListBox1.Items.Add(Nachricht.Benutzer+'
: '+Nachricht.Msg);
except
end;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
IDTCPServer1.Active:=True;
IDTCPClient1.Connect(5000);
end;
procedure TForm1.Button2Click(Sender: TObject);
var NeueNachricht : TNachricht;
begin
NeueNachricht.Benutzer:=IDTCPClient1.Localname;
NeueNachricht.Msg:=Edit1.Text;
IDTCPCLient1.WriteBuffer(NeueNachricht,Sizeof(NeueNachricht),True);
end;
procedure TForm1.IdTCPServer1Connect(AThread: TIdPeerThread);
var NeuerClient : ZClient;
begin
Getmem(NeuerClient,sizeof(Client));
NeuerClient.
Name:=Athread.Connection.LocalName;
NeuerClient.Verbunden:=Now;
NeuerClient.Aktion:=NeuerClient.Verbunden;
NeuerClient.Thread:=Athread;
Athread.Data:=TObject(NeuerClient);
try
Clienten.LockList.Add(NeuerClient);
finally
Clienten.UnlockList;
end;
ListBox2.Items.Add(timetostr(Time)+'
'+(NeuerClient.
Name)+'
hat sich verbunden.');
end;
procedure TForm1.IdTCPServer1Execute(AThread: TIdPeerThread);
var AktClient, Empfaenger:ZClient;
Nachricht:TNachricht;
ZielThread:TIdPeerThread;
i:integer;
begin
If not aThread.Terminated
and AThread.Connection.Connected
then
begin
Athread.Connection.ReadBuffer(Nachricht,sizeof(Nachricht));
AktClient:= Zclient(athread.Data);
AktClient.Aktion:=Now;
with Clienten.LockList
do
try
for i:=0
to count-1
do
begin
Empfaenger:=Items[i];
Zielthread:=Empfaenger.Thread;
Zielthread.Connection.WriteBuffer(Nachricht,sizeof(Nachricht),True);
end;
finally
clienten.UnlockList;
end;
end;
end;
procedure TForm1.IdTCPServer1Disconnect(AThread: TIdPeerThread);
var aktClient: ZClient;
begin
AktClient:=ZClient(AThread.Data);
try
Clienten.LockList.Remove(AktClient);
finally
Clienten.UnlockList;
end;
FreeMem(aktClient);
Athread.Data:=nil;
end;
procedure TForm1.IdTCPClient1Connected(Sender: TObject);
begin
Leser.Create(True);
Button2.Enabled:=True;
end;
procedure TForm1.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
IDTCPClient1.Disconnect;
end;
end.