unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, OleCtrls, WMPLib_TLB, AppEvnts, IdBaseComponent,
IdComponent, IdIPWatch, ScktComp, XPMan, Menus, ExtCtrls, ComCtrls,
ShellAPI, IniFiles, XPStyle, VIDEOCAPLib_TLB, JvComponent, JvAnimTitle;
const WM_TASKBAREVENT = WM_USER+1;
type
TForm1 =
class(TForm)
EditServer: TEdit;
Label3: TLabel;
EditPortNo: TEdit;
Button1: TButton;
PopupMenu1: TPopupMenu;
XPManifest1: TXPManifest;
ClientSocket1: TClientSocket;
IdIPWatch1: TIdIPWatch;
ApplicationEvents1: TApplicationEvents;
Timer1: TTimer;
Memo1: TMemo;
Edit1: TEdit;
Edit2: TEdit;
Edit3: TEdit;
Button2: TButton;
Button3: TButton;
Label4: TLabel;
Label5: TLabel;
ClientBeenden1: TMenuItem;
XPStyle1: TXPStyle;
Button5: TButton;
Panel1: TPanel;
WindowsMediaPlayer1: TWindowsMediaPlayer;
ServerSocket1: TServerSocket;
IdIPWatch2: TIdIPWatch;
Timer2: TTimer;
Label1: TLabel;
Panel2: TPanel;
Memo2: TMemo;
Button6: TButton;
Panel3: TPanel;
Panel4: TPanel;
WindowsMediaPlayer3: TWindowsMediaPlayer;
Button7: TButton;
VideoCap1: TVideoCap;
SaveDialog1: TSaveDialog;
OpenDialog1: TOpenDialog;
txtPortNo: TEdit;
txtMaxClient: TEdit;
cbodevice: TComboBox;
cboVideoinput: TComboBox;
cbowmv: TComboBox;
chkbroadcast: TCheckBox;
ffnen1: TMenuItem;
Edit4: TEdit;
Edit5: TEdit;
Button4: TButton;
JvAnimTitle1: TJvAnimTitle;
function GetToken(aString, SepChar:
string; TokenNum: Byte):
string;
procedure Button1Click(Sender: TObject);
procedure Delay(time: word);
procedure Button3Click(Sender: TObject);
procedure ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket);
procedure FormCreate(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Edit2Click(Sender: TObject);
procedure Edit1Click(Sender: TObject);
procedure ApplicationEvents1Exception(Sender: TObject; E:
Exception);
procedure Timer1Timer(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure ClientBeenden1Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
procedure ServerSocket1ClientRead(Sender: TObject;
Socket: TCustomWinSocket);
procedure Timer2Timer(Sender: TObject);
procedure FormClose(Sender: TObject;
var Action: TCloseAction);
procedure Button6Click(Sender: TObject);
procedure Button7Click(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure ffnen1Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
private
IconData: TNotifyIconData;
{ Private declarations }
public
procedure WndProc(
var Msg: TMessage);
override;
procedure WMSysCommand(
var Message: TWMSysCommand);
message WM_SYSCOMMAND;
{ Public declarations }
end;
var
Form1: TForm1;
Nickname:
string;
implementation
uses registry;
{$R *.dfm}
var regist : TRegistry;
function TForm1.GetToken(aString, SepChar:
string; TokenNum: Byte):
string;
var
Token:
string;
StrLen: Byte;
Num: Byte;
EndofToken: Byte;
begin
StrLen := Length(aString);
Num := 1;
EndofToken := StrLen;
while ((Num <= TokenNum)
and (EndofToken <> 0))
do
begin
EndofToken := Pos(SepChar, aString);
if EndofToken <> 0
then
begin
Token := Copy(aString, 1, EndofToken - 1);
Delete(aString, 1, EndofToken);
Inc(Num);
end
else
Token := aString;
end;
if Num >= TokenNum
then
Result := Token
else
Result := '
';
end;
procedure TForm1.Delay(time: word);
var Start: Integer;
begin
Start:=GetTickCount;
while (GetTickCount)-(Start) <= time
do
Application.ProcessMessages;
end;
///////////////////////////////////////
///////////////////////////////////////
procedure TForm1.WndProc(
var Msg: TMessage);
var
Point: TPoint;
begin
if Msg.Msg = WM_USER + 20
then
begin
case Msg.lParam
of
WM_RBUTTONDOWN:
begin
SetForegroundWindow(
Handle);
GetCursorPos(Point);
PopupMenu1.PopUp(Point.X, Point.Y);
end;
WM_LBUTTONDOWN:
begin
Form1.Show;
end;
end;
end;
inherited;
end;
////////////////////////////////////////
////////////////////////////////////////
procedure TForm1.WMSysCommand(
var Message: TWMSysCommand);
begin
if Message.CmdType
and $FFF0 = SC_MINIMIZE
then
begin
Hide;
// Icon nur anzeigen wenn Fenster minimiert
Shell_NotifyIcon(NIM_ADD, @IconData);
end
else
inherited;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
WindowsMediaPlayer1.URL :='
mms://' + EditServer.Text + '
:' + EditPortNo.Text;
windowsMediaPlayer1.controls.play;
end;
procedure TForm1.Button3Click(Sender: TObject);
var Nachricht:
string;
begin
Nickname:=Edit3.Text;
ClientSocket1.Host:=Edit2.Text;
ClientSocket1.Active:=true;
Button3.Enabled:=false;
Edit2.Enabled:=false;
Button2.Enabled:=true;
Nachricht:=Edit3.Text+'
hat den Raum betreten';
delay(500);
ClientSocket1.Socket.SendText(Nachricht);
//"betreten" senden
end;
procedure TForm1.ClientSocket1Read(Sender: TObject;
Socket: TCustomWinSocket);
begin
Form1.Show;
Memo1.Lines.Add(Socket.ReceiveText);
end;
procedure TForm1.FormCreate(Sender: TObject);
var Ini:TIniFile;
begin
Ini := TIniFile.Create( ChangeFileExt( Application.ExeName, '
.ini' ) );
Edit3.Text:=Ini.ReadString('
Config', '
Benutzername', '
');
regist := TRegistry.Create;
regist.RootKey :=HKEY_LOCAL_MACHINE;
regist.OpenKey('
\SOFTWARE\Server',True);
Edit3.Text := regist.ReadString('
Programm-ID');
IconData.cbSize := SizeOf(IconData);
IconData.Wnd :=
Handle;
IconData.uID := 100;
IconData.uFlags := NIF_MESSAGE + NIF_ICON + NIF_TIP;
IconData.uCallBackMessage := WM_USER + 20;
IconData.hIcon := Application.Icon.Handle;
IconData.szTip := '
Client-Server';
Shell_NotifyIcon(NIM_ADD, @IconData);
Label5.Caption:=IdIPWatch1.LocalIP;
Button2.Enabled:=false;
Button3.Enabled:=True;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
if (ClientSocket1.Active=true)
and (Edit1.Text<>'
')
then
ClientSocket1.Socket.SendText(NickName+'
#'+Edit1.Text);
Edit1.Text:='
';
end;
procedure TForm1.Edit2Click(Sender: TObject);
begin
Button3.
Default:=true;
end;
procedure TForm1.Edit1Click(Sender: TObject);
begin
Button3.
Default:=false;
Button2.
Default:=true;
end;
procedure TForm1.ApplicationEvents1Exception(Sender: TObject;
E:
Exception);
begin
ShowMessage('
Zu dieser IP/zu diesem Namen konnte kein Server gefunden werden!');
Button3.Enabled:=true;
Edit2.Enabled:=true;
Edit2.Text:='
';
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
Label5.Caption:=IdIPWatch1.LocalIP;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
Shell_NotifyIcon(NIM_DELETE, @IconData);
end;
procedure TForm1.ClientBeenden1Click(Sender: TObject);
begin
Application.Terminate;
end;
procedure TForm1.Button5Click(Sender: TObject);
var Ini:TIniFile;
begin
Button5.Enabled:=False;
Label1.Caption:='
Client wird beendet!';
ClientSocket1.Socket.SendText(Edit3.Text +'
hat den Chat verlassen.');
delay(500);
ClientSocket1.Close;
try
Ini:=TIniFile.Create( ChangeFileExt( Application.ExeName, '
.ini' ) );
Ini.WriteString('
Config','
Benutzername', Edit3.Text);
Ini.WriteString('
Config','
IP', Edit2.Text);
finally
Ini.Free;
Timer2.Enabled:=True;
end;
end;
procedure TForm1.ServerSocket1ClientRead(Sender: TObject;
Socket: TCustomWinSocket);
var i :integer;
Text:
string;
Nickname:
string;
Nachricht:
string;
begin
Text:=Socket.ReceiveText;
Nickname:=(Trim(GetToken(Text,'
#',1)));
Nachricht:=(Trim(GetToken(Text,'
#',2)));
begin
Memo2.Lines.add(Timetostr(now)+'
: '+Nickname+'
: '+Nachricht);
Form1.Show;
Form1.WindowState:=wsNormal;
//ShowMessage('Chat wurde gestartet');
For I := 0
to ServerSocket1.Socket.ActiveConnections - 1
do
begin // Anzahl der Teilnehmer
with ServerSocket1.Socket.Connections [I]
do
if (Connected)
then SendText(Nickname+'
: '+Nachricht);
end;
end;
end;
procedure TForm1.Timer2Timer(Sender: TObject);
begin
Timer2.Enabled:=False;
Button6.Enabled := True;
Button7.Enabled := False;
VideoCap1.BroadCast := False;
videocap1.stop;
ServerSocket1.Close;
Memo2.Lines.SaveToFile('
Chat-Log.txt');
close;
end;
procedure TForm1.FormClose(Sender: TObject;
var Action: TCloseAction);
var Ini:TIniFile;
begin
Button5.Enabled:=False;
Button6.Enabled := True;
Button7.Enabled := False;
VideoCap1.BroadCast := False;
videocap1.stop;
Label1.Caption:='
Client wird beendet!';
ClientSocket1.Socket.SendText(Edit3.Text +'
hat den Chat verlassen.');
delay(500);
ClientSocket1.Close;
ServerSocket1.Close;
Memo2.Lines.SaveToFile('
Chat-Log.txt');
try
Ini:=TIniFile.Create( ChangeFileExt( Application.ExeName, '
.ini' ) );
Ini.WriteString('
Config','
Benutzername', Edit3.Text);
Ini.WriteString('
Config','
IP', Edit2.Text);
finally
Ini.Free;
end;
end;
procedure TForm1.Button6Click(Sender: TObject);
begin
Form1.Width:=760;
Button6.Enabled:=False;
Button7.Enabled:=True;
VideoCap1.WMVProfile := cbowmv.ItemIndex;
VideoCap1.VideoInput :=cboVideoInput.ItemIndex;
If chkbroadcast.Checked
Then
VideoCap1.BroadCast := True
Else
VideoCap1.BroadCast := False;
VideoCap1.CaptureMode := False;
VideoCap1.MaxClients := strtoint(txtMaxClient.Text);
VideoCap1.BroadCastPortNo := strtoint(txtPortNo.Text);
VideoCap1.CaptureAudio := True ;
VideoCap1.Start;
end;
procedure TForm1.Button7Click(Sender: TObject);
begin
Form1.Width:=389;
Button7.Enabled:=False;
Button6.Enabled:=True;
Button4.Enabled:=True;
VideoCap1.BroadCast := False;
videocap1.stop;
end;
procedure TForm1.FormShow(Sender: TObject);
var i:integer;
begin
For i:= 0
to VideoCap1.VideoInputs.Count-1
do
cboVideoInput.Items.add(VideoCap1.VideoInputs.FindVideoInputName(i));
cboVideoInput.ItemIndex :=0;
For i:= 0
to VideoCap1.Devices.Count-1
do
cbodevice.Items.add(VideoCap1.Devices.FindDeviceName(i));
cbodevice.ItemIndex :=0;
For i:= 0
to VideoCap1.WMVProfiles.Count-1
do
cbowmv.Items.add(VideoCap1.WMVProfiles.FindWMVProfileName(i));
cbowmv.ItemIndex :=6;
end;
procedure TForm1.ffnen1Click(Sender: TObject);
begin
Form1.Show;
end;
procedure TForm1.Button4Click(Sender: TObject);
begin
WindowsMediaPlayer3.URL :='
http://' + Edit4.Text + '
:' + Edit5.Text;
windowsMediaPlayer3.controls.play;
Button4.Enabled:=False;
end;
end.