[fide_uci]

Hola mis amigos. Ya he terminado con la primera fase que es que el cliente inicie una conexion, se conecte y obtenga una lista de nicks conectados. Aca les pongo un poco de codigo para que vallan teniendo una idea de lo que estoy haciendo. Cualquier duda me preguntan.

Código Delphi [-]
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;

(****************************************************************
  Declaracion del tipo TCliente y otros registros para registrar
  otros datos en cada una de las conexiones.
****************************************************************)
type

  {
    Estados que puede tomar una conexión
      csNone: El cliente se ha conectado pero no ha iniciado el envío de datos.
      csInitialized: El cliente ha enviado los datos pero no se ha logueado.
      csLogged: El cliente se ha logueado y ya se puede trabajar con él.
  } 

  TConState = (csNone, csInitialized, csLogged);

type TUserInfo = record
  Nick: String[255];
{  Nombre: String[255];
  Apellidos: String[255]; }
end;

type TGameInfo = record
  Partida: String[255];
  Puntuacion: Integer;
end;

type TClient = record
  Host: String[255];        // Guarda el IP de cada cliente
  Hora_Login: String[255];  // Guarda la hora en la que se logueo el cliente
  InfoUsuario: TUserInfo;   // Información del usuario
  idContext: Pointer;       // Se guarda el acceso al idContext de cada cliente
  conState: TConState;      // Estado de la conexión
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
    { Public declarations }
  end;


{ TODO
 *******************************************************************
 1. Asignado a: Fidel Hernández Salazar
    Categoria: Sockets
   
  Trabajar con un TreathList independiente a la del TCPServer para
  evitar errores a la hora de lockear la lista de conexiones
 *******************************************************************
}

var
  frmMain     :TfrmMain;
  vg_Clients  :TThreadList;
  //Ver de que manera esta variable desaparece
  vg_ListaNicks: TStringList;

implementation

{$R *.dfm}

uses StrUtils, IdBuffer, unConfigCon, IdTask, gml_const, GlobalUnit, GlobalCmds, ActiveX, ComObj;

{******************************************************
  Procedimientos implementados por mi
******************************************************}

//* Enviar la lista de nicks a todos los clientes conectados *//
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;


{** Fin de los procedimientos  implementados por mi **}

procedure TfrmMain.TCPServerConnect(AContext: TIdContext);
var
  vNewClient: PClient;
begin

  //Memo1.Lines.Add('Alguien se ha conectado');

  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;
//  vList: TList;
//  vCount: Integer;
  cXmlDoc: TXMLDocument;
  //cTable: TZTable;
begin

  (*************************************************************************
    OJO: Antes de todo lo de abajo implementar lo del estado de conexion
         para evitar que el cliente envíe comandos cuando aún no pueda
         hacerlo
  *************************************************************************)

  vEntrada := AContext.Connection.Socket.ReadLn();
  //Memo1.Lines.Add('Enviado: ' + vEntrada);
  Memo1.Lines.Add(vEntrada);
  Memo1.Lines.Add('---------------------------------------------');

  CoInitialize(nil);
  cXmlDoc := TXMLDocument.Create(Self);
  //cTable := TZTable.Create(Self);

  //TODO: Aqui mirar si hay que codificar la entrada en UTF-8 para
  //evitar complicaciones con los caracteres
  cXmlDoc.XML.Text := vEntrada;


  //inicializando la conexion a la BD
  //cTable.Connection := DbConnection;
  //cTable.TableName := 'flash_game.tbd_users';

try //Finally
  try //Except

      cXmlDoc.Active := True;
      //cTable.Active := True;

      //Verificar si No se está utilizando gml como etiqueta padre del documento XML
      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;

      //* IMPLEMENTACION DE LOS COMANDOS  *//


      //COMANDO join: Se utiliza para el cliente enviar su nick y notificar su entrada
      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;

          //TODO: Esta linea no va aqui es solo para probar
          userList.Items.Add(cXMLDoc.DocumentElement.Attributes['nick']);

          //Enviamos la lista de nicks actualizada a todos los clientes conectados
          SendNickList();
        end;

      //COMANDO get_nick_list: El cliente me esta pidiendo la lista de usuarios conectados
      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;

      //create_account
      {if ( LowerCase(cXMLDoc.DocumentElement.AttributeNodes.Nodes['cmd'].Text) = cmd_account_create ) then
        begin
          if ( cXmlDoc.DocumentElement.HasAttribute('user') and cXMLDoc.DocumentElement.HasAttribute('password') )  then
            begin
              if (cXMLDoc.DocumentElement.AttributeNodes.Nodes['user'].Text <> '') and
                 (cXMLDoc.DocumentElement.AttributeNodes.Nodes['password'].Text <> '')  then
                begin
                  //Validar el nombre de usuario en busca de caracteres no permitidos
                  if IsValidUserName(cXMLDoc.DocumentElement.AttributeNodes.Nodes['user'].Text) then
                    begin
                      //cTable.Insert;
                      //cTable.FieldByName('user_name').AsString := cXMLDoc.DocumentElement.AttributeNodes.Nodes['user'].Text;
                      //cTable.FieldByName('password').AsString := cXMLDoc.DocumentElement.AttributeNodes.Nodes['password'].Text;
                      //cTable.Post;
                      Memo1.Lines.Add('Todo correcto: ' + vEntrada);
                    end  
                  else
                    TIdContext(PClient(AContext.Data).idContext).Connection.Socket.WriteLn(Format('', [cmd_msg_error, gml_msg_invalid_user_name]));
                end
              else
                begin
                  //Uno o mas atributos son nulos
                  TIdContext(PClient(AContext.Data).idContext).Connection.Socket.WriteLn(Format('', [cmd_msg_error, gml_msg_null_attrib]));
                  exit;
                end;     
            end
          else
            begin
              //Falta uno o más atributos
              TIdContext(PClient(AContext.Data).idContext).Connection.Socket.WriteLn(Format('', [cmd_msg_error, gml_msg_no_attrib]));
              exit;
            end;
       end;}
       
        //Seguir implementando comandos arriba de esta línea

  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;
    //cTable.Free;
end;

end;

procedure TfrmMain.TCPServerDisconnect(AContext: TIdContext);
var
//  vIndex: Integer;
  vNickDesc: string;
begin

  //Analizar estas lineas para ver si se pueden eliminar
  // vIndex := userList.Items.IndexOf(PClient(AContext.Data).InfoUsuario.Nick);
  // vg_ListaNicks.Delete(vIndex);
  //  userList.Items.Text := vg_ListaNicks.Text;

  try
    vNickDesc := PClient(AContext.Data).InfoUsuario.Nick;

    //TODO: Esta linea debe seraparecer, esta aca solo para pruebas
    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;

  //TrayIcon.BalloonHint('Cliente desconectado', 'El usuario se ha desconectado del servidor', btWarning, 10000);

  (***** Enviando la nueva lista de nicks a los clientes conectados *****)
  SendNickList();
  
end;

procedure TfrmMain.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin

//  TCPServer.StopListening;
  TCPServer.Active := False;

end;

procedure TfrmMain.Button4Click(Sender: TObject);
begin

  PruebasXMLDoc.Active := False;
  PruebasXMLDoc.XML.Text := Memo2.Lines.Text;
  PruebasXMLDoc.Active := True;

  //ShowMessage(XMLDoc.DocumentElement.ChildNodes['nick'].Text);
  //ShowMessage(XMLDoc.DocumentElement.AttributeNodes.Nodes['from'].Text );
   //ShowMessage(XMLDoc.DocumentElement.AttributeNodes.Nodes['to'].Text);
   //ShowMessage(XMLDoc.DocumentElement.ChildNodes['body'].Text);
   ShowMessage(PruebasXMLDoc.DocumentElement.LocalName);
 { if XmlDoc.DocumentElement.HasAttribute('to') then
    ShowMessage('Si')
  else
    ShowMessage('No');
 }
 
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.

En esta aplicacion utilizo.

Indy 10
TMS Component pack (version 5.5.4.1)
JVCL338CompleteJCL201-Build3449

y algun que otro componente que puedan ver ahi. Pero bueno la idea es que miren el codigo para que entiendan mas o menos como se hace todo esto. Me tomo el trabajo de escribir todas estas cosas por que se que hay muchas personas que no utilizan o no conocen la potencia que tienen los componentes de la Indy y quisas con esto logre alentarlos y darles alguna que otra idea.