unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, IdBaseComponent, IdComponent, IdTCPConnection,
IdTCPClient, IdIntercept, IdIOHandler, IdIOHandlerStream, xmldom,
XMLIntf, msxmldom, XMLDoc, xercesxmldom, oxmldom, IdIOHandlerSocket,
IdIOHandlerStack, ComCtrls, ExtCtrls,
XPMan, Sockets, IdContext,
IdCustomTCPServer, IdTCPServer, Menus,
IdScheduler, IdSchedulerOfThread,
IdSchedulerOfThreadDefault, JvComponentBase, JvTrayIcon,
AdvOfficeStatusBar, AdvOfficeStatusBarStylers, AdvToolBar,
AdvToolBarStylers, AdvOfficeHint, AdvMemo, Advmxml;
type
TConState = (csNone, csInitialized, csLogged);
type TUserInfo = record
Nick: String[255];
end;
type TGameInfo = record
Partida: String[255];
Puntuacion: Integer;
end;
type TClient = record
Host: String[255]; Hora_Login: String[255]; InfoUsuario: TUserInfo; idContext: Pointer; conState: TConState; end;
type PClient = ^TClient;
type
TfrmMain = class(TForm)
Panel2: TPanel;
Panel3: TPanel;
TCPServer: TIdTCPServer;
PruebasXMLDoc: TXMLDocument;
Button4: TButton;
Memo2: TMemo;
userList: TListBox;
Shape1: TShape;
Label1: TLabel;
Shape2: TShape;
TrayIcon: TJvTrayIcon;
AdvOfficeStatusBar1: TAdvOfficeStatusBar;
AdvOfficeStatusBarOfficeStyler1: TAdvOfficeStatusBarOfficeStyler;
AdvDockPanel1: TAdvDockPanel;
AdvToolBarOfficeStyler1: TAdvToolBarOfficeStyler;
AdvToolBar1: TAdvToolBar;
AdvToolBarButton1: TAdvToolBarButton;
AdvToolBarSeparator1: TAdvToolBarSeparator;
AdvToolBarButton2: TAdvToolBarButton;
AdvToolBarSeparator2: TAdvToolBarSeparator;
AdvToolBarButton3: TAdvToolBarButton;
AdvToolBarSeparator3: TAdvToolBarSeparator;
AdvToolBarButton4: TAdvToolBarButton;
OfficeHint: TAdvOfficeHint;
AdvToolBarSeparator4: TAdvToolBarSeparator;
AdvToolBarButton5: TAdvToolBarButton;
Memo1: TAdvMemo;
AdvXMLMemoStyler1: TAdvXMLMemoStyler;
procedure TCPServerConnect(AContext: TIdContext);
procedure TCPServerExecute(AContext: TIdContext);
procedure TCPServerDisconnect(AContext: TIdContext);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure Button4Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure AdvToolBarButton1Click(Sender: TObject);
procedure AdvToolBarButton2Click(Sender: TObject);
procedure AdvToolBarButton3Click(Sender: TObject);
procedure AdvToolBarButton4Click(Sender: TObject);
procedure AdvToolBarButton5Click(Sender: TObject);
private
public
end;
var
frmMain :TfrmMain;
vg_Clients :TThreadList;
vg_ListaNicks: TStringList;
implementation
{$R *.dfm}
uses StrUtils, IdBuffer, unConfigCon, IdTask, gml_const, GlobalUnit, GlobalCmds, ActiveX, ComObj;
procedure SendNickList();
var
vList: TList;
vIndex: Integer;
vAux: WideString;
begin
try
vList := vg_Clients.LockList;
vAux := '';
for vIndex := 0 to vList.Count -1 do
begin
vAux := vAux + Format(' ', [vg_ListaNicks.Strings[vIndex]]);
end;
vAux := vAux + '';
for vIndex := 0 to vList.Count -1 do
begin
TIdContext(PClient(vList.Items[vIndex]).idContext).Connection.Socket.WriteLn(vAux);
end;
finally
vg_Clients.UnlockList;
end;
end;
procedure TfrmMain.TCPServerConnect(AContext: TIdContext);
var
vNewClient: PClient;
begin
GetMem(vNewClient, SizeOf(TClient));
vNewClient.Host := AContext.Connection.Socket.Binding.PeerIP;
vNewClient.Hora_Login := FormatDateTime('hh:mm:ss - dd/mm/yyyy', Now);
vNewClient.InfoUsuario.Nick := '';
vNewClient.idContext := AContext;
vNewClient.conState := csNone;
AContext.Data := TObject(vNewClient);
try
vg_Clients.LockList.Add(vNewClient);
finally
vg_Clients.UnlockList;
end;
TrayIcon.BalloonHint('Cliente conectado', 'Se ha conectado un cliente desde la siguiente dirección: ' + #13 + vNewClient.Host, btInfo, 10000);
end;
procedure TfrmMain.TCPServerExecute(AContext: TIdContext);
var
vEntrada: WideString;
cXmlDoc: TXMLDocument;
begin
vEntrada := AContext.Connection.Socket.ReadLn();
Memo1.Lines.Add(vEntrada);
Memo1.Lines.Add('---------------------------------------------');
CoInitialize(nil);
cXmlDoc := TXMLDocument.Create(Self);
cXmlDoc.XML.Text := vEntrada;
try try
cXmlDoc.Active := True;
if cXMLDoc.DocumentElement.LocalName <> gml_local_name then
begin
TIdContext(PClient(AContext.Data).idContext).Connection.Socket.WriteLn(Format('', [cmd_msg_error, gml_msg_no_local_name]));
Exit;
end;
if LowerCase(cXMLDoc.DocumentElement.Attributes['cmd']) = 'join' then
begin
PClient(AContext.Data).InfoUsuario.Nick := cXMLDoc.DocumentElement.Attributes['nick'];
vg_ListaNicks.Add(cXMLDoc.DocumentElement.Attributes['nick']);
PClient(AContext.Data).conState := csLogged;
userList.Items.Add(cXMLDoc.DocumentElement.Attributes['nick']);
SendNickList();
end;
if LowerCase(cXMLDoc.DocumentElement.Attributes['cmd']) = 'get_nick_list' then
begin
PClient(AContext.Data).InfoUsuario.Nick := cXMLDoc.DocumentElement.Attributes['nick'];
PClient(AContext.Data).conState := csLogged;
userList.Items.Add(cXMLDoc.DocumentElement.Attributes['nick']);
end;
except on E: Exception do
begin
TIdContext(PClient(AContext.Data).idContext).Connection.Socket.WriteLn(Format('', [cmd_msg_error, gml_except_error]));
end;
end;
finally
cXmlDoc.Free;
end;
end;
procedure TfrmMain.TCPServerDisconnect(AContext: TIdContext);
var
vNickDesc: string;
begin
try
vNickDesc := PClient(AContext.Data).InfoUsuario.Nick;
vg_ListaNicks.Delete(vg_ListaNicks.IndexOf(vNickDesc));
userList.Items.Delete(userList.Items.IndexOf(vNickDesc));
vg_Clients.LockList.Remove(PClient(AContext.Data));
AContext.Data := nil;
finally
vg_Clients.UnlockList;
end;
SendNickList();
end;
procedure TfrmMain.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
TCPServer.Active := False;
end;
procedure TfrmMain.Button4Click(Sender: TObject);
begin
PruebasXMLDoc.Active := False;
PruebasXMLDoc.XML.Text := Memo2.Lines.Text;
PruebasXMLDoc.Active := True;
ShowMessage(PruebasXMLDoc.DocumentElement.LocalName);
end;
procedure TfrmMain.FormCreate(Sender: TObject);
begin
vg_ListaNicks := TStringList.Create;
vg_Clients := TThreadList.Create;
TrayIcon.Icon := Application.Icon;
TrayIcon.Active := True;
end;
procedure TfrmMain.FormDestroy(Sender: TObject);
begin
vg_Clients.Free;
vg_ListaNicks.Free;
end;
procedure TfrmMain.AdvToolBarButton1Click(Sender: TObject);
begin
TCPServer.Active := False;
TCPServer.Active := True;
end;
procedure TfrmMain.AdvToolBarButton2Click(Sender: TObject);
var
vList: TList;
vCount: Integer;
vDatos: PClient;
begin
try
vList := vg_Clients.LockList;
for vCount := 0 to vList.Count -1 do
begin
vDatos := PClient(vList.Items[vCount]);
Memo1.Lines.Add('Hora Login: ' + vDatos.Hora_Login);
Memo1.Lines.Add('IP LOGIN: ' + vDatos.Host);
Memo1.Lines.Add('Nick: ' + vDatos.InfoUsuario.Nick);
end;
finally
vg_Clients.UnlockList;
end;
end;
procedure TfrmMain.AdvToolBarButton3Click(Sender: TObject);
var
vIndex: Integer;
begin
vIndex := vg_Clients.LockList.Count;
Caption := 'Actualmente hay "' + IntToStr(vIndex) + '" clientes conectados';
vg_Clients.UnlockList;
end;
procedure TfrmMain.AdvToolBarButton4Click(Sender: TObject);
var
vList: TList;
vCount: Integer;
begin
try
vList := vg_Clients.LockList;
for vCount := 0 to vList.Count -1 do
begin
TIdContext(PClient(vList.Items[vCount]).idContext).Connection.Disconnect;
end;
finally
vg_Clients.UnlockList;
end;
end;
procedure TfrmMain.AdvToolBarButton5Click(Sender: TObject);
begin
Memo1.Clear;
end;
end.