No hay respuestas en este tema

[genyus00]

Hola, buenas a todos, este es el primer tema que abro. a  ver como me va. La cuestion es la siguiente, actualmente trabajo con delphi XE y la version indy 10.5.7, anteriorme en delphi 7 cpon los indy 9.xxxx habia creado una aplicacion cliente servidor con componentes TidTCPClient y TidTCPServer enviando los mensajes como un objeto de tipo "Record" el cual encapsula los parametros que deseo enviar de un cliente a un servidor y viceversa, dado que me funcionaba sin problema, decidi traermelo a delphi XE, encontre varios problemas por que algunas propiedades de los componentes cambiaron de nombre y de forma de manejo , pero alli lo hice funcionar, mi sorpresa actual es que si envio un mensaje al servidor y luego le doy al boton desconectar en el cliente, se obtiene el mensaje en servidor y cliente que la conexion se cerro (esto es correcto), pero en realidad en el cliente la conexion sigue activa, y no encuentro como cerrar, ni por las buenas ni por las malas, adicionalmente recibo en el cliente el mensaje "su conexion se a cerrado graciosamente" "conection closedgracefully", mirando en muchos foros y hasta en al pagina de indy, la explicacion que dan es que al cerrar el cliente el servidor pareciera no enterarse, pero la cosa es que si se entera, por que muestra en el log del server que evidentemente un cliente se deconecto, por otro lado que cambia en la accion de enviar mensaje que haga que despues la coneccion del cliente no se pueda cerrar, dado que si activo el cliente y no envio mensaje y le doy dessconectar funciona bien, puedo darle conectar/desconectar cuantas veces quiera que no se bloquea, pero al enviar el mensaje y querer cerrar el cliente pailas... no se permite desactivar el TidTCPclient. el codigo de la aplicacion en el siguiente.. cualquie ayuda en el analis se los agradezco.   

CODIGO DEL CLIENTE

delphi

unit ClientFrmMainUnit;
 
interface
 
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, StdCtrls,
  GlobalUnit, IdAntiFreezeBase, IdAntiFreeze,idglobal;
 
type
   TClientFrmMain = class(TForm)
   IncomingMessages: TMemo;
   Label1: TLabel;
 
   IdTCPClient1: TIdTCPClient;
   Label2: TLabel;
   EditCommand: TComboBox;
   Label3: TLabel;
   EditMessage: TEdit;
   Label4: TLabel;
   EditRecipient: TEdit;
   ButtonSend: TButton;
   puertoremoto: TEdit;
   ipremota: TEdit;
   btndesconectar: TButton;
   lbl4: TLabel;
   lbl3: TLabel;
   IdAntiFreeze1: TIdAntiFreeze;
   btnconectar: TButton;
 
   procedure ButtonSendClick(Sender: TObject);
   procedure btnconectarClick(Sender: TObject);
   procedure btndesconectarClick(Sender: TObject);
   procedure IdTCPClient1Connected(Sender: TObject);
   procedure IdTCPClient1Disconnected(Sender: TObject);
 
   private
         procedure Log(s: string);
         public
         end;
 
   TClientHandleThread = class(TThread)
   private
         CB: TCommBlock;
         procedure HandleInput;
         protected
         procedure Execute; override;
         end;
var
  ClientFrmMain: TClientFrmMain;
  ClientHandleThread: TClientHandleThread;
 
implementation
 
{$R *.DFM}
procedure TClientFrmMain.Log(s: string);
begin
IncomingMessages.Lines.Add(DateTimeToStr(now) + ' ' + s);
end;
 
procedure TClientHandleThread.HandleInput;
begin
if CB.Command = 'MESSAGE' then
   ClientFrmMain.IncomingMessages.Lines.Add (CB.UsuarioNom + ': ' + CB.Msj)
else
if CB.Command = 'DIALOG' then
   MessageDlg ('"'+CB.UsuarioNom+'" sends you this message:'+#13+CB.Msj, mtInformation, [mbOk], 0)
else
   MessageDlg('Unknown command "'+CB.Command+'" containing this message:'+#13+CB.Msj, mtError, [mbOk], 0);
end;
 
procedure TClientHandleThread.Execute;
var RxBuf:TIdBytes;
begin
ClientFrmMain.IdTCPClient1.ReadTimeout := 1000;
repeat
     try
        ClientFrmMain.IdTCPClient1.IOHandler.ReadBytes(RxBuf, SizeOf (CB));
        Idglobal.BytesToRaw(RxBuf, CB, SizeOf (CB));
        Synchronize(HandleInput);
        except
            // nothing
        end;
     until (Terminated) or (not ClientFrmMain.IdTCPClient1.Connected);
Free;
end;
 
procedure TClientFrmMain.IdTCPClient1Connected(Sender: TObject);
begin
Log('Conectado al Servidor ' + ipremota.text + ':' + puertoremoto.text);
end;
 
procedure TClientFrmMain.IdTCPClient1Disconnected(Sender: TObject);
begin
Log('Desconectado del Servidor' + ipremota.text + ':' + puertoremoto.text);
end;
 
procedure TClientFrmMain.btnconectarClick(Sender: TObject);
begin
try
   IdTCPClient1.Host := IPRemota.text;
   IdTCPClient1.Port := StrToInt(PuertoRemoto.text);
   try
     IdTCPClient1.Connect;
     ClientHandleThread := TClientHandleThread.Create(True);
     ClientHandleThread.FreeOnTerminate:=True;
     ClientHandleThread.Resume;
     ButtonSend.Enabled := IdTCPClient1.Connected;
     btnconectar.Enabled:=not IdTCPClient1.Connected;
     btndesconectar.Enabled:=IdTCPClient1.Connected;
     except
         on E: Exception do MessageDlg ('Error while connecting:'+#13+E.Message, mtError, [mbOk], 0);
        end;
   except
        raise exception.Create('Error');
   end;
end;
 
procedure TClientFrmMain.btndesconectarClick(Sender: TObject);
begin
try
  if IdTCPClient1.Connected then
     begin
     ClientHandleThread.Terminate;
     IdTCPClient1.Disconnect;
     ButtonSend.Enabled := IdTCPClient1.Connected;
     btnconectar.Enabled:=not IdTCPClient1.Connected;
     btndesconectar.Enabled:=IdTCPClient1.Connected;
     end;
except
     on E: Exception do
        showmessage(E.Message);
     end;
end;
 
procedure TClientFrmMain.ButtonSendClick(Sender: TObject);
var
  CommBlock : TCommBlock;
  RxBuf:TIdBytes;
begin
   CommBlock.Command      := EditCommand.Text;
   CommBlock.UsuarioNom   := 'PC0117';//DNS
   CommBlock.Msj          := EditMessage.Text;
   CommBlock.Hora         := FormatDateTime('HH:mm:ss',Time);
   CommBlock.ResiveName := EditRecipient.Text;
   CommBlock.Turno        := '';
   CommBlock.Modulo       := '';
   RxBuf := Idglobal.RawToBytes(CommBlock, SizeOf (CommBlock));
   IdTCPClient1.IOHandler.Write(RxBuf);// and there it goes...
end;
 
end.

CODIGO DEL SERVIDOR

delphi

unit ServerFrmMainUnit;
 
interface
 
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, IdTCPServer, Idcontext,IdBaseComponent,idglobal,
  IdComponent, IdStack, IdCustomTCPServer,IdSocketHandle;
 
type
  PClient   = ^TClient;
  TClient   = record  // Object holding data of client (see events)
              IPAddress ,  // Guarda el IP de cada cliente
              DNS         : String[20]; { Hostname }
              Connected,                           { Time of connect }
              LastAction  : TDateTime;             { Time of last transaction }
              Context     : Pointer;               { Pointer to thread }
              end;
 
  TServerFrmMain = class(TForm)
  IdTCPServer1: TIdTCPServer;
  CBServerActive: TCheckBox;
  Protocol: TMemo;
  DefaultServerPort: TEdit;
  btn1: TButton;
  DefaultServerIP: TEdit;
  lbl2: TLabel;
  lbl1: TLabel;
 
  procedure CBServerActiveClick(Sender: TObject);
  procedure IdTCPServer1Connect(AContext: TIdContext);
  procedure IdTCPServer1Execute(AContext: TIdContext);
  procedure IdTCPServer1Disconnect(AContext: TIdContext);
  procedure FormCreate(Sender: TObject);
  procedure FormClose(Sender: TObject; var Action: TCloseAction);
  procedure btn1Click(Sender: TObject);
  procedure IdTCPServer1Status(ASender: TObject; const AStatus: TIdStatus;
  const AStatusText: string);
 
  private
        procedure Log(s: string);
  Public
       end;
 
var
  ServerFrmMain   : TServerFrmMain;
  Clients         : TThreadList;     // Holds the data of all clients
  log:string;
 
implementation
 
uses GlobalUnit;
 
{$R *.DFM}
procedure TServerFrmMain.Log(s: string);
begin
protocol.Lines.Add(DateTimeToStr(now) + ' ' + s);
end;
 
procedure TServerFrmMain.btn1Click(Sender: TObject);
var Bindings: TIdSocketHandles;
begin
Bindings := TIdSocketHandles.Create(IdTCPServer1);
try
   with Bindings.Add do
        begin
        IP := DefaultServerIP.text;
        Port := StrToInt(DefaultServerPort.text);
        end;
   try
      IdTCPServer1.Bindings := Bindings;
      IdTCPServer1.Active := True;
      Log('Server Iniciado en ' + DefaultServerIP.text);
      Log('Esperando comunicación cliente...');
      except on E: Exception do
             ShowMessage(E.Message);
      end;
  finally
        Bindings.Free;
  end;
end;
 
procedure TServerFrmMain.CBServerActiveClick(Sender: TObject);
begin
IdTCPServer1.Active := CBServerActive.Checked;
end;
 
procedure TServerFrmMain.IdTCPServer1Connect(AContext: TIdContext);
var NewClient: PClient;
begin
GetMem(NewClient, SizeOf(TClient));
NewClient.IPAddress := AContext.Connection.Socket.Binding.PeerIP;
NewClient.DNS := GStack.HostByAddress(NewClient.IPAddress);
NewClient.Connected   := Now;
NewClient.LastAction  := NewClient.Connected;
NewClient.Context     :=AContext;
AContext.Data:=TObject(NewClient);
 
try
   Clients.LockList.Add(NewClient);
   finally
         Clients.UnlockList;
   end;
 
Protocol.Lines.Add(TimeToStr(Time)+' Connection from "'+NewClient.DNS+'"');
Log('Connectado a : ' + AContext.Binding.PeerIP + ':' + IntToStr(AContext.Binding.Port));
end;
 
procedure TServerFrmMain.IdTCPServer1Execute(AContext: TIdContext);
var ActClient, RecClient: PClient;
Paquete, NewPaquete: TCommBlock;
RecContext: TIdContext;
i: Integer;
RxBuf:TIdBytes;
begin
if AContext.Connection.Connected then    //not AContext.Terminated and
   begin
   AContext.Connection.IOHandler.readBytes(RxBuf, SizeOf (Paquete));
   Idglobal.BytesToRaw(RxBuf, Paquete, SizeOf (Paquete));// Obtener el texto enviado desde el cliente
   ActClient := PClient(AContext.Data);
   ActClient.LastAction := Now;  // update the time of last actio
 
   if (Paquete.Command = 'MESSAGE') or (Paquete.Command = 'DIALOG') then
       begin  // 'MESSAGE': A message was send - forward or broadcast it
           // 'DIALOG':  A dialog-window shall popup on the recipient's screen
           // it's the same code for both commands...
 
       if Paquete.ResiveName = '' then
          begin  // no recipient given - broadcast
          Protocol.Lines.Add (TimeToStr(Time)+' Broadcasting '+Paquete.Command+': "'+Paquete.Msj+'"');
          NewPaquete := Paquete;  // nothing to change ;-))
 
          with Clients.LockList do
               try
                 for i := 0 to Count-1 do  // iterate through client-list
	                   begin
                     RecClient := Items[i];           // get client-object
                     RecContext := RecClient.Context; // conseguir el hilo del cliente
                     RxBuf := Idglobal.RawToBytes(RecContext, SizeOf (RecContext));
                     AContext.Connection.IOHandler.Write(RxBuf);// enviar el material
                     AContext.Connection.IOHandler.WriteBufferFlush;
                     AContext.Connection.IOHandler.WriteBufferClose;
                     end;
               finally
                     Clients.UnlockList;
               end;
          end
       else
          begin  // receiver given - search him and send it to him
          NewPaquete := Paquete; // again: nothing to change ;-))
          Protocol.Lines.Add(TimeToStr(Time)+' Sending '+Paquete.Command+' to "'+Paquete.ResiveName+'": "'+Paquete.Msj+'"');
          with Clients.LockList do
               try
                  for i := 0 to Count-1 do
                      begin
                      RecClient:=Items[i];
                      if RecClient.DNS=Paquete.ResiveName then  // we don't have a login function so we have to use the DNS (Hostname)
                         begin
                         RecContext:=RecClient.Context;
                         RxBuf := Idglobal.RawToBytes(RecContext, SizeOf (RecContext));
                         AContext.Connection.IOHandler.Write(RxBuf);// enviar el material
                         AContext.Connection.IOHandler.WriteBufferFlush;
                         AContext.Connection.IOHandler.WriteBufferClose;
                         end;
                      end;
               finally
                      Clients.UnlockList;
                      end;
          end;
       end
   else
      begin  // unknown command given
      Protocol.Lines.Add (TimeToStr(Time)+' Unknown command from "'+Paquete.UsuarioNom+'": '+Paquete.Command);
      NewPaquete.Command := 'DIALOG';       // the message should popup on the client's screen
      NewPaquete.UsuarioNom := '[Server]';  // the server's username
      NewPaquete.Msj := 'I don''t understand your command: "'+Paquete.Command+'"';  // the message to show
      NewPaquete.ResiveName := '[return-to-sender]'; // unnecessary
      RxBuf := Idglobal.RawToBytes(NewPaquete, SizeOf (NewPaquete));
      AContext.Connection.IOHandler.Write(RxBuf);// y ahí va ...
      end;
 
   AContext.Connection.IOHandler.WriteBufferFlush;
   AContext.Connection.IOHandler.WriteBufferClose;
   end;
end;
 
procedure TServerFrmMain.IdTCPServer1Status(ASender: TObject;
  const AStatus: TIdStatus; const AStatusText: string);
begin
protocol.Lines.Add('Status : ' + AStatusText);
end;
 
procedure TServerFrmMain.IdTCPServer1Disconnect(AContext: TIdContext);
var ActClient: PClient;
begin
ActClient := PClient(AContext.Data);
Protocol.Lines.Add (TimeToStr(Time)+' Disconnect from "'+ActClient^.DNS+'"');
Log('Desconectado de : ' + AContext.Binding.PeerIP + ':' + IntToStr(AContext.Binding.Port));
 
try
   Clients.LockList.Remove(ActClient);
   finally
         Clients.UnlockList;
   end;
 
FreeMem(ActClient);
AContext.Data := nil;
end;
 
procedure TServerFrmMain.FormCreate(Sender: TObject);
begin
Clients := TThreadList.Create;
end;
 
procedure TServerFrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
IdTCPServer1.Active := False;
Clients.Free;
end;
 
end.

UNIDAD COMUN A LOS DOS PROYECTOS

delphi

unit GlobalUnit;
 
interface
type
TCommBlock = record // the Communication Block used in both parts (Server+Client)
             Command, //comando a interpretar por el usuario
             UsuarioNom,//usuario que envio el mensage
             Msj,//mensage enviado por el usuario
             Hora,
             ResiveName, //name of receiver
             Turno,//tabla en la que se realizo la operacion
             Modulo:string[100]; //codigo o pk del registro modificado o registrado
             end;
 
 
implementation
 
end.