unit ustart;
interface
uses
Windows, Messages, ..., mmsystem, Menus, ShellAPI,
uicmessage, jpeg;
type
TFicyou =
class(TForm)
ips: TMemo;
lrechner: TLabel;
...
bbenutzer: TImage;
procedure FormCreate(Sender: TObject);
procedure TCPServerExecute(AThread: TIdPeerThread);
procedure FormClose(Sender: TObject;
var Action: TCloseAction);
procedure BenutzerlisteDblClick(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure closeClick(Sender: TObject);
private
{ Private-Deklarationen }
public
procedure serverstarten;
procedure serverstoppen;
procedure formsvorladen;
{ Public-Deklarationen }
end;
type FormList=record
MsgBox:TFicMessageBox;
end;
var
Ficyou: TFicyou;
form:
array [1..255]
of FormList;
implementation
{$R *.dfm}
procedure pause(zeit:LongInt);
VAR anfang:LongInt;
begin
anfang:=GetTickCount;
while GetTickCount<anfang+zeit
do
Application.ProcessMessages;
end;
procedure TFicyou.FormCreate(Sender: TObject);
begin
self.BorderIcons:=[biSystemMenu,biMinimize];
TCPServer.Active:=True;
end;
procedure TFicyou.FormActivate(Sender: TObject);
VAR i:integer;
begin
serverstarten;
for i:=0
to 50
do begin
form[i].MsgBox:=TFicMessageBox.Create(self);
form[i].MsgBox.
Name:='
icY'+IntToStr(i);
form[i].MsgBox.mhistory.
Name:='
mhistory'+IntToStr(i);
formsvorladen;
SndPlaySound('
Sounds/Startup.wav', SND_ASYNC );
end;
procedure TFicyou.TCPServerExecute(AThread: TIdPeerThread);
VAR Eintrag,msg:integer;
MsgBySvr:
String;
begin
try
MsgBySvr:=AThread.Connection.ReadLn(#$A,5500);
// Clientnachricht lesen
eabsenderip.Text:=AThread.Connection.Socket.Binding.PeerIP;
Eintrag:=lbips.Items.IndexOf(eabsenderip.Text);
if Eintrag>=0
then begin
Benutzerliste.ItemIndex:=Eintrag;
MsgBySvr:=Benutzerliste.Items.Strings[Eintrag]+'
: '+MsgBySvr;
end
else begin
SndPlaySound('
Sounds/Auth.wav', SND_ASYNC);
msg:=MessageDlg('
Sie wurden von einem Benutzer (IP: '+eabsenderip.Text+'
) angeschrieben. Wollen sie diesen Benutzer zu ihrer Kontaktliste hinzufügen? (Achtung!: Erst nach dem Hinzufügen ist es möglich Nachrichten von Usern zu bekommen d.h. Sie müßten in jetzt anschreiben!)',mtinformation,[mbyes,mbno],0);
if msg=mryes
then begin
FicUser.leip.Text:=eabsenderip.Text;
FicUser.Show; eabsenderip.Text:='
';
end;
if msg=mrno
then eabsenderip.Text:='
';
end;
except
AThread.Connection.Disconnect;
end;
evstext.Text:=MsgBySvr;
if (form[Eintrag].MsgBox.Visible=false)
then
begin
SndPlaySound('
Sounds/Message.wav', SND_ASYNC);
form[Eintrag].MsgBox.Visible:=true;
end;
pause(221);
eabsenderip.Text:='
';
evstext.Text:='
';
end;
procedure TFicyou.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
serverstoppen;
end;
procedure TFicyou.BenutzerlisteDblClick(Sender: TObject);
begin
form[Benutzerliste.ItemIndex].MsgBox.Visible:=true;
form[Benutzerliste.ItemIndex].MsgBox.Show;
end;
procedure TFicyou.serverstarten;
begin
TcpServer.Active:=false;
TcpServer.Bindings.Clear;
TcpServer.DefaultPort:=StrToIntDef('
4466',4466);
try
TcpServer.Active:=true;
except
raise;
end;
if TcpServer.Active
then begin
lstatus.caption:='
Verbindung hergestellt';
lstatus.Font.Color:=clGreen;
end;
end;
procedure TFicyou.serverstoppen;
begin
try
TcpServer.Active:=false;
except
raise;
end;
if not TcpServer.Active
then begin
lstatus.caption:='
Verbindung unterbrochen';
lstatus.Font.Color:=clMaroon;
end;
end;
procedure TFicYou.formsvorladen;
VAR i:integer;
begin
for i:=0
to Benutzerliste.Items.Count-1
do begin
form[i].MsgBox.Show;
form[i].MsgBox.Visible:=false;
pause(20);
end;
end;
end.