unit utoposock;
{$mode delphi}
interface

uses
  Classes, SysUtils,
  {$IFDEF LINUX}
  ERRORS,
  baseunix,
  unix,
  uEmuladorWinIPC,
  uKeyDir,
  netdb,
  uWinMsgs,
  ctypes,
  sockets,
  pthreads,
  {$ELSE}
  Windows,
  Messages,
  Variants,
  WinSock,
  ipcthrd,
  FileUtil,
  {$ENDIF}

  {$IFDEF LCL}
  Forms,
  Controls, Graphics, Dialogs, StdCtrls,
  {$ENDIF}

  {$IFDEF NETTOPOS_DLL}
    uimpnettopos,
  {$ELSE}
    unettopos,
    unettopostypes,
    uglobsharedmem,
  {$ENDIF}
    uDatosConexionNodo,
    uconstantes_nettopos,
    // uAuxiliares,
    ubuffrw, uComunicacionEnProgreso,
  {$IFDEF appsConocidas}
    uListaAppsConocidas,
  {$ENDIF}
    xMatDefs,
    urosx, uDataSetGenerico,
    uConstantesSimSEE,
    uMsgRetardados;
type

  TPackedBytes= packed array of Byte;

  //TNodo= class
  //  public
  //    idNodo: cardinal;
  //    maquina: string;
  //    puerto: cardinal;
  //    ixPoderDeCalculo: cardinal; // indicador de poder de cálculo con test
  //    ixVelocidadDeTransferencia: cardinal; // indicador de velocidad de transf.
  //    estado: integer; // -1 = ?; 0=down; > 0 Up
  //    constructor Create( IPStr: string; puerto: cardinal; maquina: string );
  //end;

  TFichaAplicacion = Record
      idAplic : cardinal;
      nombreAplic: ShortString;
  end;

  //



// Demonio que escucha los mensajes que le vienen de los clientes.
  TTopoSrv= class(TThread)
    private
      fichasCom: array [0..63] of TComunicacionEnProgreso;

      function asignarFicha(s: TSocket; var lastIFicha: Integer): Integer; //asigna la primer ficha disponible al socket s
      procedure liberarFicha(i: Integer; var lastIFicha: Integer); //libera la ficha asignada al socket s
    public
      Puerto: word;
      myaddr: sockaddr_in;     //sockaddr_in;     // dirección del servidor
      remoteaddr: sockaddr_in; // dirección del cliente
      fdmax: integer;          // número máximo de descriptores de fichero
      toporx: TSocket;         // descriptor de socket a la escucha
      newfd: TSocket;          // descriptor de socket de nueva conexión aceptada

      flg_finalizar: boolean;
      constructor Create( xPuerto: word );
      procedure Execute; override;
      procedure senializarFin;
      procedure Free;
  end;


type
  { TTopoSock }
   {$IFNDEF LCL}
   TTopoSock = class( TComponent )
   {$ELSE}
   TTopoSock = class( TForm )
   {$ENDIF}
   {$IFDEF LCL}
    BGetNodosRegistrados: TButton;
    BIpToCardinal: TButton;
    BLimpiarListaTopos: TButton;
    BListarAppsLocales: TButton;
    btTestMemoAdd: TButton;
    eDireccionIP: TEdit;
    eIdNodo: TEdit;
    eIdTopo: TEdit;
    eIpNodoDestino: TEdit;
    eNombreMaquina: TEdit;
    ETestConvertIp: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    memo: TMemo;
    procedure BGetNodosRegistradosClick(Sender: TObject);
    procedure BIpToCardinalClick(Sender: TObject);
    procedure BListarAppsLocalesClick(Sender: TObject);
    procedure btTestMemoAddClick(Sender: TObject);

    procedure ReadRosXCFG;

    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
 {$ENDIF}

 private
  nextIdTareaMemoAdd: Cardinal;
{$IFDEF appsConocidas}
   appsConocidas: TListaAppsConocidas;
{$ENDIF}
  function getNextIdTareaMemoAdd: Integer;

//    function registrarse : String;
 public
   topoSrv: TTopoSrv;
   public_ip: shortstring;
   public_port: word;
   global_nid: integer; // nid en la tabla "topos".

// Configuración de rosx
   rosx_host: string;
   rosx_port: string;
   rosx_uri: string;



   {$IFDEF LINUX}
     //Regestro para el manejo de senales del OS
     SActionRec_: SigActionRec;
     idTopo: integer;
     recolectar: boolean;
   {$ENDIF}

   {$IFNDEF LCL}
   constructor Create(AOwner: TComponent); reintroduce;
   procedure Free; virtual;
   {$ENDIF}

   procedure cargarListadoDeNodos;
   { Public declarations }

   procedure msg_GetIdAplicByName(var Msg: TMessage); message MSGP_GETIDAPLICBYNAME;

   (* Este mensaje se recibe cuando finaliza una tarea síncrona lanzada por el topo
   para avisar que la misma finalizó. El topo en respuesta a ese mensaje
   busca en su lista de tareas síncronas la ficha correspondiente y lanza la
   notificación a quién solicitó la ejecución de la tarea en cuestioón *)
   procedure msg_RespuestaTS(var Msg: TMessage); message MSG_RESPUESTA_TS;

// agrega los datos a el memo. Es para test de los topos.
   procedure msg_memoAdd( var Msg: TMessage ); message MSGP_TOPO_MEMO_ADD;
   procedure msg_respuestaMemoAdd( var Msg: TMessage ); message MSGR_TOPO_MEMO_ADD;

// igual que el memo add pero responde que termino para probar los mensajes sincronos
   procedure msg_memoAddSincrono( var Msg: TMessage ); message MSGx_TOPO_MEMO_ADD_SINCRONO;

(* Solicitudes Al Topo como aplicación *)
   procedure msg_get_naplics( var Msg: TMessage ); message MSGP_GET_NAPLICS;

// retorna un array con los idNodos y los nombres listados en la lista Nodos
   procedure msgp_Get_Nodos( var Msg: TMessage ); message MSGP_GETNODOS;

(* Respuestas de solicitudes lanzadas por el Topo *)
//    procedure msgr_naplics( var Msg: TMessage ); message MSGR_NAPLICS;

   procedure msg_RunCmd( var Msg: TMessage ); message MSGP_RUNCMD;
   procedure msgp_CloseApp( var Msg: TMessage ); message MSGP_CLOSEAPP;

   procedure MSGP_App_Conocida (var Msg: TMessage); message MSGP_AppConocida;

   procedure puntito (var Msg: TMessage); message MSGP_PUNTITO;

   procedure leer_global_nid;
   procedure guardar_global_nid;
   procedure wrln_memo( r: string );
   end;


var
  TopoSock: TTopoSock;
  idTopo: cardinal;
  idNodo: cardinal;
  Nodos: TList;
//  Archivo: TFichaArchivoAbierto;//Ver si no tiene que ser una lista

implementation

{$IFDEF LINUX}
var
  SActionRec: SigActionRec;

{ Procedimientos agregados para el manejo de señales
del sistema.}
procedure Handler(Sig : Integer); cdecl;
begin
//  writeln('--estoy en el Handler---', GetThreadId);
  case Sig of
    SIGALRM:
    begin
      writeln('SIGALRM');
      //msgsRetardados.Start;
      exit;
    end;
    SIGINT, SIGTERM :
    begin
      writeln('--- recibi SIGINT o SIGTERM --- pongo recolectar=false ' );
      TopoSock.recolectar:= false;
      exit;
    end;
    //  SIGIO: writeln('SIGIO');
  end; { case }
end;

procedure InstallHandlers;
begin
//  writeln('Instalo Handlers, ThreadId= ', GetThreadId);
  with SActionRec do
  begin
    sa_handler:= SigActionHandler(@Handler);
    fpsigemptyset(sa_mask);
    FpSigAddSet(sa_mask, SIGALRM);
    sa_flags:= 0;
  end; { with }
	fpsigaction(SIGINT, @SActionRec, nil);
	fpsigaction(SIGTERM, @SActionRec, nil);
	fpsigaction(SIGALRM, @SActionRec, nil);
//   sigaction(SIGIO, @SActionRec, nil );

end;
{$ENDIF}

{$IFDEF CONLOG}
procedure conlog( s: string; WParam, lParam: Integer);
begin
  writeln(now(), 'clog> ('+s+'), wp:'+IntToStr( wparam )+', lp: '+IntToStr( lparam ) );
end;
{$ENDIF}


procedure invertirComunicado(var comunicado: TFichaComunicado);
var
  aux_Swap: Cardinal;
begin
  aux_Swap:= comunicado.idNodoOrigen;
  comunicado.idNodoOrigen:= comunicado.idNodoDestino;
  comunicado.idNodoDestino:= aux_Swap;

  aux_Swap:= comunicado.idOrigen;
  comunicado.idOrigen:= comunicado.idDestino;
  comunicado.idDestino:= aux_Swap;
end;


{$IFDEF LINUX}
function WSAGetLastError: integer;
begin
  result:= socketerror;
end;
{$ENDIF}



function GetDatosMaquina(var HostName, IPaddr, WSAErr: String): Boolean;
begin
writeln('->utoposock.GetDatosMaquina' );
  Result := False;
  IPaddr := '';
  writeln( ' ... obteniendo nombre de la maquina ..');
  HostName:= urosx.GetLocalHostName;
  writeln( 'Esta maquina es: '+ HostName );
  if HostName <> '' then
  begin
    IPaddr:= urosx.getipbyname( HostName );
    if IPAddr <> '' then result:= true;
  end
  else
  {$IFDEF LINUX}
     WSAErr:= 'Error en GetDatosMaquina. SocketError: '+IntToStr( socketerror );
  {$ELSE}
    case WSAGetLastError of
      WSANOTINITIALISED:WSAErr:='WSANotInitialised';
      WSAENETDOWN      :WSAErr:='WSAENetDown';
      WSAEINPROGRESS   :WSAErr:='WSAEInProgress';
    else
      WSAErr:= 'WS???';
    end;
  {$ENDIF}

writeln('utoposock.GetDatosMaquina->' );

end;

(*****
var
  i: Integer;
  nombreMaquina: PAnsiChar;
  pHEnt: PHostEnt;
begin
  GetMem( nombreMaquina, 255);
  if  nombreMaquina <> nil then
  begin
    HostName := StrPas(nombreMaquina);
    pHEnt:= gethostbyname(nombreMaquina);
    FreeMem(nombreMaquina, 255);
    IPaddr:= '';
    if pHEnt <> NIL then
    begin
      for i:= 0 to pHEnt^.h_length - 1 do
         IPaddr := Concat(IPaddr, IntToStr(Ord(pHEnt^.h_addr_list^[i])) + '.');
      SetLength(IPaddr, Length(IPaddr) - 1);
      Result := True;
    end
    else
    begin
      result:= false;
    end;
  end
  else
  begin
    case WSAGetLastError of
      WSANOTINITIALISED:WSAErr:='WSANotInitialised';
      WSAENETDOWN      :WSAErr:='WSAENetDown';
      WSAEINPROGRESS   :WSAErr:='WSAEInProgress';
    end;
    result:= false;
  end;
end;
***)

procedure setDatosMaquina;
var
  HostName, IPAddr, WSAErr: String;
begin
  if GetDatosMaquina( HostName, IPaddr, WSAErr) then
  begin
    pm^.nombreMaquina:= HostName;
    pm^.idNodoLocal:= IP4StrToCardinal( IPAddr );
  end
  else
  begin
    pm^.nombreMaquina:= '?';
    pm^.idNodoLocal:= 0;
  end;
end;


(*

function cliSendAll( s: TSocket; var Buf; len: integer ): boolean;
var
  total: integer;        // cuántos bytes hemos enviado
  bytesleft: integer; // cuántos se han quedado pendientes
  n: integer;
begin
  total:= 0;
  bytesleft:= len;

  while(total < len) do
  begin
    n:= send(s, TBufBytes(buf)[total], bytesleft, 0);
    if (n = -1) then break;
    total:= total + n;
    bytesleft:= bytesleft - n;
  end;
  result:=  len <> total;
end;


function cliWriteln( s: TSocket; const r: string ): boolean;
var
  ts: string;
begin
  ts:= r+#10;
  result:= cliSendAll( s, ts[1], length( ts ) );
end;

function cliReadln( var sock: TSocket ): ShortString;
var
  buf: ShortString;
  kw: integer;
  tam: integer;
  nleidos: integer;
  socketCerrado: boolean;
begin
  tam:= 255;
  kw:= 1;
  buf[0]:=#0;
  socketCerrado:= false;
  nleidos:= 0;
  while ((tam >0 )
//        and ( buf[kw-1] <> #13 )
        and (buf[kw-1] <> #10)
        ) and not socketCerrado do
  begin
    nleidos:= recv( sock, buf[kw], tam, 0 );
    if nleidos > 0 then
    begin
      kw:= kw + nleidos;
      tam:= tam - nleidos;
    end
    else
      socketCerrado:= true;
  end;

  while (nleidos > 0) and (( buf[nleidos]=#13) or ( buf[nleidos]=#10) ) do
    dec( nleidos );
  buf[0]:= chr(nleidos);
  result:= buf;
end;
*)


(*
function cliOpen(var sock: TSocket; hostId: cardinal; port : integer ): boolean;
var
  addr: sockaddr_in;
  k: integer;
begin
  addr.sin_family:= PF_INET;
  addr.sin_port:= htons(port); // ShortHostToNet(port);
  addr.sin_addr.S_addr:= htonl(Longint(hostId)); //HostTonet(longint(h.IPAddress));

  for k:= 0 to 7 do
{$IFDEF LINUX}
    addr.xpad[k]:= chr(0);
{$ELSE}
    addr.sin_zero[k]:= chr(0);
{$ENDIF}

  sock := Socket(PF_INET, SOCK_STREAM, 0);
{$IFDEF LINUX}
  if sock = -1 then
{$ELSE}
  if WSAGetLastError <> 0 then
{$ENDIF}
  begin
    result:= false;
    exit;
  end;

{$IFDEF LINUX}
  if not Connect(sock, addr, sizeOf( addr )) then
{$ELSE}
  if Connect(sock, addr, sizeOf( addr )) <> 0 then
{$ENDIF}
  begin
    closesocket(sock);
    result:= false;
    Exit;
  end;
  result:= true;
end;
  *)

constructor TTopoSrv.Create( xPuerto: word );
var
  i: Integer;
begin
  writeln('creando thread topoSrv');
  inherited Create(true);
  Puerto:= xPuerto;
  toporx:= TSocket(-1);
  for i:= 0 to high(fichasCom) do
    fichasCom[i]:= TComunicacionEnProgreso.Create;
  self.FreeOnTerminate:= false;
  self.Resume;
  writeln('Fin Creacion');
end;

procedure TTopoSrv.Free;
var
  i: Integer;
begin
  if toporx >=0  then
    closeSocket( toporx );
  for i:= 0 to high(fichasCom) do
    fichasCom[i].Free;
  inherited Free;
end;

procedure TTopoSrv.Execute;
var
  yes: integer;        // para setsockopt() SO_REUSEADDR, más abajo
  addrlen: integer;
  i, iFichaNueva, lastIFicha: integer;

  com: TComunicacionEnProgreso;
  resContinuar: Integer;

  idPeticion: cardinal;
  ftars: PRecFichaTareaSincrona;
  smfTS: TMutex;
  tOut: Integer;
  resSelect: Integer;

  master: TFDSet;          // conjunto maestro de descriptores de fichero
  read_fds: TFDSet;        // conjunto temporal de descriptores de fichero para select()

begin
  yes:= 1;

{$IFNDEF WINDOWS}
  fpFD_ZERO(master);    // borra los conjuntos maestro y temporal
  fpFD_ZERO(read_fds);
{$ELSE}
  FD_ZERO(master);    // borra los conjuntos maestro y temporal
  FD_ZERO(read_fds);
{$ENDIF}

  // obtener socket a la escucha
  {$IFDEF LINUX}
  toporx:= fpSocket(AF_INET, SOCK_STREAM, 0 );
  {$ELSE}
  toporx:= socket(AF_INET, SOCK_STREAM, 0 );
  {$ENDIF}

  if ( toporx = -1) then
  begin
    logError('TTopoSrv.Execute: error creando el socket');
    exit;
  end;

  // obviar el mensaje "address already in use" (la dirección ya se está usando)
{$IFNDEF WINDOWS}
  if ( fpsetsockopt( toporx, SOL_SOCKET, SO_REUSEADDR, @yes, sizeof(yes))= -1) then
{$ELSE}
  if ( setsockopt( toporx, SOL_SOCKET, SO_REUSEADDR, @yes, sizeof(yes))= -1) then
{$ENDIF}
  begin
    logError('TTopoSrv.Execute: error en setsockopt');
    exit;
  end;

  // enlazar
  myaddr.sin_family:= AF_INET;
  myaddr.sin_addr.s_addr:= INADDR_ANY;
  myaddr.sin_port:= htons( puerto );
  // memset( &(myaddr.sin_zero), '\0', 8);
  for i:= 0 to 7 do
{$IFDEF LINUX}
    myaddr.xpad[i]:= chr(0);
{$ELSE}
    myaddr.sin_zero[i]:= chr(0);
{$ENDIF}

{$IFDEF LINUX}
  if fpBind( toporx, @myaddr, sizeof(myaddr)) = -1   then
{$ELSE}
  if ( bind( toporx, myaddr, sizeof(myaddr)) = -1) then
{$ENDIF}
  begin
{$IFDEF LINUX}
    writeln('TTopoSrv.Execute: error en el bind ' + strerror( socketerror ) );
{$ENDIF}
    logerror('bind');
    exit;
  end;

  writeln('Me dispongo a escuchar' );

  // escuchar
  {$IFDEF LINUX}
  if fplisten( toporx, 10) = -1  then
  {$ELSE}
  if listen( toporx, 10) = -1 then
  {$ENDIF}
  begin
    closesocket( toporx );
    toporx:= TSocket(-1);
    logError('TTopoSrv.Execute: error en listen');
    exit;
  end;

  // añadir listener al conjunto maestro

{$IFNDEF WINDOWS}
{xIFDEF FPC}
  fpFD_SET(toporx, master);
{$ELSE}
  FD_SET(toporx, master);
{$ENDIF}

  // seguir la pista del descriptor de fichero mayor
  fdmax:= toporx; // por ahora es éste
  lastIFicha:= -1;

  flg_finalizar:= false;
  // bucle principal
  while not flg_finalizar do
  begin
    read_fds:= master; // cópialo

   //writeln('->fpselect');
{$IFNDEF WINDOWS}
    resSelect:= fpselect(fdmax+1, @read_fds, nil, nil, nil);
{$ELSE}
    resSelect:= select(fdmax+1, @read_fds, nil, nil, nil);
{$ENDIF}
    if resSelect = -1 then
    begin
      closesocket( toporx );
      toporx:= TSocket(-1);
      logerror('TTopoSrv.Execute: error en select');
      exit;
    end;
    //writeln('fpselect->');
    if (resSelect <> 0) and not flg_finalizar then//Me pueden haber avisado de terminar entre el while y aca
    begin
{$IFNDEF WINDOWS}
      if (fpFD_ISSET(toporx, read_fds) <> 0) then
{$ELSE}
      if (FD_ISSET(toporx, read_fds)) then
{$ENDIF}
      begin
        // gestionar nuevas conexiones
        addrlen:= sizeof(remoteaddr);
{$IFNDEF WINDOWS}
        newfd:= fpaccept( toporx, @remoteaddr, @addrlen);
{$ELSE}
        newfd:= accept( toporx, @remoteaddr, @addrlen);
{$ENDIF}
        if (newfd = -1) then
        begin
          logError('TTopoSrv.Execute: error en accept');
          writeln('TTopoSrv.Execute: error en accept');
        end
        else
        begin
{$IFNDEF WINDOWS}
          fpFD_SET(newfd, master); // añadir al conjunto maestro
{$ELSE}
          FD_SET(newfd, master); // añadir al conjunto maestro
{$ENDIF}
          if (newfd > fdmax) then    // actualizar el máximo
            fdmax:= newfd;

          iFichaNueva:= asignarFicha(newfd, lastIFicha);
          fichasCom[iFichaNueva].empezar(newfd);
  writeln('Nueva conexión desde socket: ', newfd);
        end
      end;

      // explorar conexiones existentes en busca de datos que leer
      for i:= 0 to lastIFicha do
      begin
        com:= fichasCom[i];
        if (com.socket <> -1) and
{$IFNDEF WINDOWS}
           (fpFD_ISSET(com.socket, read_fds) <> 0)
{$ELSE}
           (FD_ISSET(com.socket, read_fds))
{$ENDIF}
        then
        begin // tenemos datos!!
          resContinuar:= com.continuar;
          if resContinuar = -1 then
          begin
            closesocket(com.socket);
{$IFNDEF WINDOWS}
            fpFD_CLR(com.socket, master); // eliminar del conjunto maestro
{$ELSE}
            FD_CLR(com.socket, master); // eliminar del conjunto maestro
{$ENDIF}
            liberarFicha(i, lastIFicha);
            com.abortar;
          end
          else if resContinuar = 1 then
          begin
{$IFDEF DBGLOG}
            dbglog('Comunicado remoto recibido' + GenFCStr(@com.fc, nil));
{$ENDIF}
            // mandamos la comunicación via nettopos
            com.fc.idNodoDestino:= 0;
{$IFDEF LINUX}
            smfTS:= TMutex.Create( keySmfTopoTareasSincronas, 1);
{$ELSE}
            smfTS:= TMutex.Create( uconstantes_nettopos.nom_Smf_topo_tareassincronas);
{$ENDIF}
            if smfTS.Get( 10000 ) then
            begin

writeln( 'Si la aplicación destino es el propio Topo, busco si hay Taréa Síncrona con ese idTarea' );
              if (( com.fc.idDestino = 0) or ( com.fc.idDestino = idTopo )) then
                ftars:= buscartareasincro( com.fc.idTarea )
              else
                ftars:= nil;

              if ( ftars = nil ) then
              begin
                tOut:= trunc(timeOutComsCte + com.fc.nBytesDatos * timeOutComsPorByte);
                if com.fc.nbytesdatos > 0 then
                  comunicar(@com.fc, com.pdatos, tOut )
                else
                  comunicar(@com.fc, nil, tOut);
              end
              else
              begin
                idPeticion:= ftars^.idPeticion;
                if com.fc.nbytesdatos > 0 then
                  respuestaTS(idPeticion, ftars^.idTareaOriginal, @com.fc, com.pdatos)
                else
                  respuestaTS(idPeticion, ftars^.idTareaOriginal, @com.fc, nil);
                ftars^.idPeticion:= 0; // libero la ficha
              end;
              smfTS.Release;
              smfTS.Free;
            end
            else
            begin
              smfTS.Free;
              logError('toporxExecute, no logré smf_topo_tareassincronas' );
            end;
          end
          else if resContinuar = 2 then
          begin
            closesocket(com.socket);
{$IFNDEF WINDOWS}
            fpFD_CLR(com.socket, master); // eliminar del conjunto maestro
{$ELSE}
            FD_CLR(com.socket, master); // eliminar del conjunto maestro
{$ENDIF}
            liberarFicha(i, lastIFicha);
          end;
        end;
      end;
    end;
  end;
{$IFDEF LINUX}
  closesocket(toporx);
{$ENDIF}
//  Writeln('Chau...');
end;

procedure TTopoSrv.senializarFin;
{$IFDEF LINUX}
var
  sock: TSocket;
{$ENDIF}
begin
  flg_finalizar:= true;
{$IFDEF LINUX}
  //Envío algo al socket de escucha en TTopoSrv para sacarlo del select. No
  //cerramos sock porque como flg_finalizar = true nunca se realizara el accept,
  //se cierra el socket en topotx y el connect falla y el mismo cliOpen lo cierra
  cliOpen(sock, pm^.idNodoLocal, PuertoTopo, 0);
{$ELSE}
  closesocket(toporx);
{$ENDIF}
end;

function TTopoSrv.asignarFicha(s: TSocket; var lastIFicha: Integer): Integer; //asigna la primer ficha disponible al socket s y lo registra en el mapa
var
  i, res: Integer;
begin
  res:= -1;
  for i:= 0 to high(fichasCom) do
    if fichasCom[i].socket = -1 then
    begin
      fichasCom[i].socket:= s;
      res:= i;
      break;
    end;
  if res > lastIFicha then
    lastIFicha:= res;
  result:= res;
end;

procedure TTopoSrv.liberarFicha(i: Integer; var lastIFicha: Integer); //libera la ficha asignada al socket s
var
  k: Integer;
begin
  fichasCom[i].socket:= TSocket(-1);
  if i = lastIFicha then
  begin
    k:= i - 1;
    while (k > 0) and (fichasCom[k].socket = -1) do
      k:= k - 1;
    lastIFicha:= k;
  end;
end;

function nextpalSoloEspacios( var s: string ): string;
var
 res: string;
 i: integer;
begin
 s:= trim( s );
 i:= pos( ' ',s );
 if i = 0 then
 begin
   result:= s;
   s:= '';
 end
 else
 begin
   res:= copy( s, 1, i-1 );
   delete( s, 1, i );
   result:= res;
 end;
end;

function nextintSoloEspacios( var s: string ): integer;
var
 res: integer;
begin
 try
   res:= StrToInt( nextpalSoloEspacios( s ) );
 except
   res:= 0;
 end;
 result:= res;
end;


{$IFDEF LINUX}
function RunChild_NOWAIT( apl: string ): boolean;
var
  i: Integer;
  aplx: string;
  paramsList: TStringList;
  params: array of String;
begin
  aplx:= nextpalSoloEspacios( apl );
  paramsList:= TStringList.Create;
  while apl <> '' do
  begin
    paramsList.add(nextpalSoloEspacios( apl ));
  end;

  setlength(params, paramsList.Count);
  for i:= 0 to paramsList.Count - 1 do
  begin
    params[i]:= paramsList[i];
  end;
  paramsList.Free;

  result:= LanzarApl( Aplx, params );
end;

{$ELSE}
function RunChild_NOWAIT( apl: string ):boolean;
var
  proc_info: TProcessInformation;
  startinfo: TStartupInfo;
  ExitCode: longword;
  aplic, cmdline: string;
  ipos: integer;
begin
  aplic:= apl;
  cmdline:= apl+#0;
  ipos:= pos( ' ', apl );
  if ipos > 0 then
  begin
    aplic:= trim(copy( apl, 1, ipos-1 ));
  end;
  if aplic= '' then
  begin
    result:= false;
    exit;
  end;
  aplic:= aplic+#0;

  // Inicializamos las estructuras
  FillChar(proc_info, sizeof(TProcessInformation), 0);
  FillChar(startinfo, sizeof(TStartupInfo), 0);
  startinfo.cb := sizeof(TStartupInfo);

  // Intentamos crear el proceso
  if CreateProcess( @aplic[1], @cmdline[1], nil,
                    nil, false, NORMAL_PRIORITY_CLASS, nil, nil,
                    startinfo, proc_info) <> False then
  begin
    // El proceso se creó exitosamente
    // Ahora esperemos a que termine...
//    WaitForSingleObject(proc_info.hProcess, INFINITE);
    // Proceso finalizado. Ahora debemos cerrarlo.
    GetExitCodeProcess(proc_info.hProcess, ExitCode);  // Opcional
    CloseHandle(proc_info.hThread);
    CloseHandle(proc_info.hProcess);
(*
    Application.MessageBox(
      (PChar(Format( '¡Bloc de notas finalizado! (Código de retorno=%d)', [ExitCode]))),
      'Aviso', MB_ICONINFORMATION);
      *)
    result:= true;
  end
  else
  begin
  (*
    // Fracasó la creación del proceso
    Application.MessageBox('No se pudo ejecutar la '
      + 'aplicación', 'Error', MB_ICONEXCLAMATION);
      *)
    result:= false;
  end;//if
end;
{$ENDIF}

//constructor TNodo.Create( IPStr: string; puerto: cardinal; maquina: string );
//begin
//  inherited Create;
//  Self.idNodo:= IP4StrToCardinal( IPStr );
//  Self.maquina:= maquina;
//  Self.puerto:= puerto;
//  ixPoderDeCalculo:= 0;
//  ixVelocidadDeTransferencia:= 0;
//  estado:=-1;
//end;


procedure TTopoSock.wrln_memo( r: string );
begin
{$IFDEF WINDOWS}
    memo.Lines.Add( r );
{$ELSE}
    writeln(r);
{$ENDIF}
end;


procedure TTopoSock.msg_get_naplics( var Msg: TMessage );
var
  pfc: PFichaComunicado;
  pdatos: string;
  idPeticion: cardinal;
  cntAplicsLocales: integer;
begin
  idPeticion:= msg.WParam;
  new( pfc );
  if leerFichaComunicado( idPeticion, pfc ) > 0 then
  begin
    if pfc^.nbytesdatos> 0 then
    begin
      setlength( pdatos, pfc^.nbytesdatos );
      levantarDatosComunicado( idPeticion, @pdatos[1], pfc^.nbytesdatos );
    end
    else
      levantarDatosComunicado( idPeticion, nil, 0 );

    cntAplicsLocales:= GetNAplicsRegistradas;
    pfc^.idNodoDestino:= pfc^.idNodoOrigen;
    pfc^.idDestino:= pfc^.idOrigen;
    pfc^.idNodoOrigen:= idNodo;
    pfc^.idOrigen:= idTopo;
    pfc^.codigomsg:= uconstantes_nettopos.MSGR_NAPLICS;
    pfc^.nbytesdatos:= SizeOf( cntAplicsLocales );
    comunicar( pfc, @cntAplicsLocales, timeOutComsCTE );
  end;
  dispose( pfc );
end;

procedure TTopoSock.msgp_Get_Nodos( var Msg: TMessage );
var
  comunicadoEntrante, comunicadoSaliente: TFichaComunicado;
  datosSalientes: TBuffWriter;

  k: integer;
  ids: TDAofNCardinal;
  nombres: TStringList;

begin
  cargarListadoDeNodos;

  if leerFichaComunicado(msg.WParam, @comunicadoEntrante) > 0 then
  begin
    if levantarDatosComunicado(msg.WParam, nil, 0) > 0 then
    begin
        SetLength(ids, Nodos.Count*2);
        nombres := TStringList.Create;
        for k := 0 to Nodos.Count - 1 do
          begin
           ids[k]:= TNodo( nodos.items[k] ).idNodo;
           ids[k+1]:= TNodo( nodos.items[k] ).puerto;
           nombres.Add(TNodo( nodos.items[k] ).maquina);
          end;

        PrepararFCRespuesta(comunicadoSaliente, comunicadoEntrante, MSGR_GETNODOS, xSizeOf(ids)+xSizeOf(nombres));
        datosSalientes:= TBuffWriter.Create(comunicadoSaliente.nBytesDatos);
        datosSalientes.xTDAOfCardinal(ids);
        datosSalientes.xStringList(nombres);
        comunicar(@comunicadoSaliente, datosSalientes.pBuff, timeOutComsCTE);
        datosSalientes.Free;
    end
    else
    begin
        logError('TopoSock.msgp_Get_Nodos,'+ getNetTopos_strError(ERROR_NO_SE_PUDO_TRAER_LOS_DATOS_DEL_COMUNICADO_DESDE_LA_DLL));
    end;
  end
  else
  begin
    logError('TopoSock.msgp_Get_Nodos,'+ getNetTopos_strError(ERROR_NO_SE_PUDO_TRAER_EL_COMUNICADO_DESDE_LA_DLL));
  end;
end;

procedure TTopoSock.msg_memoAdd( var Msg: TMessage );
var
  fc: TFichaComunicado;
  pdatos: string;
  idPeticion: cardinal;
begin
  dbglog('->memoadd');
  idPeticion:= msg.WParam;
  if leerFichaComunicado(  idPeticion, @fc ) > 0 then
  begin
    dbglog('fc.nbytesdatos: '+IntToStr( fc.nbytesdatos ) );
    if fc.nbytesdatos> 0 then
    begin
      setlength( pdatos, fc.nbytesdatos );
      levantarDatosComunicado( idPeticion, @pdatos[1], fc.nbytesdatos );
    end
    else
      levantarDatosComunicado( idPeticion, nil, 0 );
    dbglog('pdatos: '+pdatos );
    wrln_memo( pdatos );
    PrepararFCRespuesta( fc, fc, MSGR_TOPO_MEMO_ADD, 0 );
    dbglog('->comunicar');
    comunicar( @fc, NIL, 1000);
    dbglog('comunicar->');
  end;
  dbglog('memoadd->');
end;

procedure TTopoSock.msg_respuestaMemoAdd( var Msg: TMessage );
var
  fc: TFichaComunicado;
begin
  if leerFichaComunicado(msg.WParam, @fc) > 0 then
  begin
    if levantarDatosComunicado(msg.WParam, NIL, 0) > 0 then
    begin
      wrln_memo('Comunicar: Respuesta recibida tarea MemoAdd ' + IntToStr(fc.idTarea) + ' OK');
    end
    else
      wrln_memo('Comunicar Fallo: No pude levantar los datos de la respuesta a la tarea MemoAdd ' + IntToStr(fc.idTarea));
  end
  else
    wrln_memo('Comunicar Fallo: No pude levantar la respuesta');
end;

procedure TTopoSock.msg_memoAddSincrono( var Msg: TMessage );
var
  fc: TFichaComunicado;
  pdatos: string;
  idPeticion: cardinal;
begin
writeln('->memoaddSincrono');
  idPeticion:= msg.WParam;
  if leerFichaComunicado(  idPeticion, @fc ) > 0 then
  begin
    if fc.nbytesdatos> 0 then
    begin
      setlength( pdatos, fc.nbytesdatos );
      levantarDatosComunicado( idPeticion, @pdatos[1], fc.nbytesdatos );
    end
    else
      levantarDatosComunicado( idPeticion, nil, 0 );
    writeln('pdatos: '+pdatos );
//    memo.Lines.Add( pdatos );
    invertirComunicado(fc);
    fc.nBytesDatos:= 0;
    if comunicar( @fc, NIL, trunc(timeOutComsCte + fc.nBytesDatos * timeOutComsPorByte)) = 0 then
      logError('TTopoSock, msg_memoAddSincrono: error comunicado finalizacion de tarea');
  end;
writeln('memoaddSincrono->');
end;

procedure TTopoSock.msg_RunCmd(var Msg: TMessage);
var
  fc, fr: TFichaComunicado;
  idPeticion, idAplic: cardinal;
  nombreAplic, binName: String;
  paramsAplic: TStringList;
  datosEntrantes: TBuffReader;

  res: integer;
  msjError: String;
  datosSalientes: TBuffWriter;
{$IFDEF CONLOG}
  idTarea: Cardinal;
  lparam: Cardinal;
{$ENDIF}
begin
{$IFDEF CONLOG}
  conlog('msg_runcmd...begin', msg.WParam, msg.LParam);
  idTarea:= 0;
  lparam:= 0;
{$ENDIF}
  res:= 0;
  idPeticion:= msg.WParam;
  if leerFichaComunicado( idPeticion, @fc) > 0 then
  begin
{$IFDEF CONLOG}
    idTarea:= fc.idTarea;
    lparam:= fc.lParam;
{$ENDIF}
    datosEntrantes:= TBuffReader.Create(fc.pdatos, fc.nBytesDatos);
    datosEntrantes.xString(nombreAplic);
    if levantarDatosComunicado(idPeticion, nil, 0) > 0 then
    begin
      //{$IFDEF appsConocidas}
      //binName:= appsConocidas.getBinName(nombreAplic);
      {$IFDEF LINUX}
      binName := getDir_Bin+nombreAplic;
      writeln('voy a ejecutar ',binName);
      {$ELSE}
      binName := getDir_Bin+nombreAplic+'.exe';
      {$ENDIF}
       if FileExists(binName){binName <> ''} then
       begin
         if fc.nBytesDatos > xSizeOf(nombreAplic) then
          begin
           datosEntrantes.xStringList(paramsAplic);
           paramsAplic.Delimiter:=' ';
           binName:=binName+' '+paramsAplic.DelimitedText+' '+IntToStr(fc.idTarea);
           writeln(binName);
          end;
         if RunChild_NOWAIT( binName ) then res:= 1;
         PrepararFCRespuesta(fr, fc, MSGR_RUNCMD, xSizeOf( res ) );
         datosSalientes:= TBuffWriter.Create(fr.nBytesDatos);
         datosSalientes.xInteger(res);
       end
       else
       begin
         res:= -1;
         msjError:= 'No se encuentra la aplicación ' + nombreAplic + ' en las aplicaciones conocidas';
         PrepararFCRespuesta(fr, fc, MSGR_RUNCMD, xSizeOf( res ) + xSizeOf(msjError));

         datosSalientes:= TBuffWriter.Create(fr.nBytesDatos);
         datosSalientes.xInteger(res);
         datosSalientes.xString(msjError);
       end;
       comunicar( @fr, datosSalientes.pBuff, timeOutComsCTE );
       datosSalientes.Free;
    end
    else
    begin
      logError( 'TTopoSock.msg_runcmd; fallaó LevantarComunicado ');
      PrepararFCRespuesta(fr, fc, MSGR_RUNCMD, sizeOf( res ) );
      comunicar( @fr, @res, timeOutComsCTE );
    end
  end
  else
    logError('TTopoSock.msg_runcmd; falló LeerFichaComunicado ');
{$IFDEF CONLOG}
  conlog('msg_runcmd...end:' + IntToStr(idTarea), idPeticion, lparam);
{$ENDIF}

 datosEntrantes.Free;
end;

procedure TTopoSock.msgp_CloseApp( var Msg: TMessage );
var
  fc, fr: TFichaComunicado;
  idPeticion: cardinal;
  nombreAplic: String;
  nomApp: PChar;
  idAplic: Integer;
  datosEntrantes: TBuffReader;

  res: integer;
{$IFDEF CONLOG}
  idTarea: Cardinal;
  lparam: Cardinal;
{$ENDIF}
begin
{$IFDEF CONLOG}
  conlog('msgp_CloseApp...begin', msg.WParam, msg.LParam);
  idTarea:= 0;
  lparam:= 0;
{$ENDIF}
  res:= -1;
  idPeticion:= msg.WParam;
  if leerFichaComunicado( idPeticion, @fc) > 0 then
  begin
{$IFDEF CONLOG}
    idTarea:= fc.idTarea;
    lparam:= fc.lParam;
{$ENDIF}
    datosEntrantes:= TBuffReader.Create(fc.pdatos, fc.nBytesDatos);
    datosEntrantes.xString(nombreAplic);
    datosEntrantes.Free;
    if levantarDatosComunicado(idPeticion, nil, 0) > 0 then
    begin
      GetMem(nomApp, length(nombreAplic) + 1);
      StrPCopy(nomApp, nombreAplic);
      idAplic:= getIdAplicacion(0, nomApp);
      FreeMem(nomApp, length(nombreAplic) + 1);
      if idAplic > 0 then
      begin
      {$IFDEF LINUX}
        if FpKill(idAplic, SIGTERM) = 0 then
//?? ojo no será esta la válida  if xPostMessage(idAplic, WM_CLOSE, 0, fc.lParam) = 0 then
      {$ELSE}
        if PostMessage(idAplic, WM_CLOSE, 0, fc.lParam) then
      {$ENDIF}
          res:= 1
        else
          res:= -1
      end
      else
        res:= 0;
      PrepararFCRespuesta(fr, fc, MSGR_CLOSEAPP, sizeOf( res ) );
      comunicar( @fr, @res, timeOutComsCTE );
    end
    else
    begin
logError( 'topo.msgp_CloseApp; Falló LevantarComunicado');
      res:= -2;
      PrepararFCRespuesta(fr, fc, MSGR_CLOSEAPP, sizeOf( res ) );
      comunicar( @fr, @res, timeOutComsCTE );
    end;
  end
  else
    logError('topo.msgp_CloseApp; Falló LeerFichaComunicado');
{$IFDEF CONLOG}
  conlog('msgp_CloseApp...end:' + IntToStr(idTarea), idPeticion, lparam);
{$ENDIF}
end;

procedure TTopoSock.MSGP_App_Conocida(var Msg: TMessage);
var
  fc_e, fc_s: TFichaComunicado;
  nombreAplic, binName: string;
  datoEntrante:TBuffReader;
  res: Integer;
begin
  res := 0;
  if leerFichaComunicado(msg.wParam, @fc_e) > 0 then
   begin
    if fc_e.nBytesDatos > 0 then
     begin
      datoEntrante := TBuffReader.Create(fc_e.pdatos, fc_e.nBytesDatos);
      datoEntrante.xString(nombreAplic);
      datoEntrante.Free;
      levantarDatosComunicado(msg.wParam, nil, 0 );
      {$IFDEF LINUX}
      binName := getDir_Bin+nombreAplic;
      {$ELSE}
      binName := getDir_Bin+nombreAplic+'.exe';
      {$ENDIF}
      if FileExists(binName) then
       res := 1;
     end;
   end;
  PrepararFCRespuesta(fc_s, fc_e, MSGR_AppConocida, xSizeOf(res));
  comunicar(@fc_s, @res, 5000)
end;

procedure TTopoSock.puntito(var Msg: TMessage);
var
 fc_e:TFichaComunicado;
begin
 
leerFichaComunicado( msg.wParam, @fc_e);  
levantarDatosComunicado(msg.wParam, nil, 0);
writeln('puntito');

fc_e.codigoMsg := WM_CLOSE;

comunicar(@fc_e, nil, 500);

end;



function TTopoSock.getNextIdTareaMemoAdd: Integer;
begin
  nextIdTareaMemoAdd:= nextIdTareaMemoAdd + 1;
  result:= nextIdTareaMemoAdd
end;


{function TTopoSock.registrarse : String;
begin
  Button2Click(self);
  memo.Clear;
end;}

procedure TTopoSock.msg_GetIdAplicByName(var Msg: TMessage);
var
  fc: TFichaComunicado;
  idPeticion: cardinal;
  idAplic: cardinal;
  nombreAplic: string;
begin
  idPeticion:= msg.WParam;
  if leerFichaComunicado( idPeticion, @fc) > 0 then
  begin
    if fc.nbytesdatos> 0 then
    begin
      setlength( nombreAplic, fc.nbytesdatos+1 );
      levantarDatosComunicado( idPeticion, @nombreAplic[1], fc.nbytesdatos );
      nombreAplic[fc.nbytesdatos+1]:= #0;
      idAplic:= getIdAplicacion(0, @nombreAplic[1]);
    end
    else
    begin
      idAplic:= 0;
      levantarDatosComunicado( idPeticion, nil, 0 );
    end;
    invertirComunicado(fc);
    fc.codigoMsg:= uconstantes_nettopos.MSGR_TOPO_GETIDAPLICBYNAME;

writeln( 'NodoOrigen: ', fc.idNodoOrigen, ', IdOrigen: ', fc.idOrigen, ' NodoDestino: ', fc.idNodoDestino, ', idDestino: ', fc.idDestino );
writeln( 'msg: ', fc.codigoMsg, ' idAplic: ', idAplic, ' idTarea: ', fc.idTarea );

    fc.nBytesDatos:= sizeOf( idAplic );
    comunicar( @fc, @idAplic, timeOutComsCTE );
  end;
end;


{$IFDEF LCL}
procedure TTopoSock.BListarAppsLocalesClick(Sender: TObject);
var
  cntAplics: integer;
  aplics: array of TFichaAplicacion;
  k: Integer;
begin
  cntAplics:= GetNAplicsRegistradas;
  if cntAplics < 0  then
  begin
    memo.Text:= 'No puede obtener el semáforo sobre el array de aplicaciones.';
    exit;
  end;

  if cntAplics = 0 then
  begin
    memo.text:= 'No hay aplicaciones registgradas. Medio raro no, y el topo?';
    exit;
  end;

  if cntAplics > 0 then
  begin
    setlength( aplics, cntAplics );
    dumpFichasAplics( @aplics[0], cntAplics );
    memo.Lines.Clear;
    for k := 0 to high( aplics ) do
      memo.Lines.Add( aplics[k].nombreAplic+ ' ('+IntToStr( aplics[k].idAplic )+ ' )');
    exit;
  end;
end;


procedure TTopoSock.BGetNodosRegistradosClick(Sender: TObject);
begin

  cargarListadoDeNodos;

(*
  if not FileExists(archiListadoDeTopos) then
    raise Exception.Create('TTopoSock.BGetNodosRegistradosClick: No se encuentra el archivo con el listado de topos ' + archiListadoDeTopos);

  lineas:= TStringList.Create;
  lineas.LoadFromFile(archiListadoDeTopos);

  for k := 0 to Nodos.Count - 1 do
    TNodo(Nodos.Items[k]).Free;
  nodos.Clear;

  for k := 0 to lineas.Count - 1 do
  begin
    r:= lineas[k];
    if (pos('fin.', r ) = 0) and (pos('//', r) <> 1) then
    begin
      ipStr:= uAuxiliares.nextPal( r );
      puertoStr:= uAuxiliares.nextPal( r );
      maquinaStr:= uAuxiliares.nextPal( r );
      if (ipStr <> '') and (puertoStr <> '') then
      begin
        aNodo:= TNodo.Create( ipStr, StrToInt( puertoStr ), maquinaStr);
        nodos.Add( aNodo );
      end;
    end;
  end;
  *)


end;

procedure TTopoSock.btTestMemoAddClick(Sender: TObject);
const
  NIters = 10000;
var
  s: string;
  idNodoDestino: cardinal;
  fc: TFichaComunicado;
  idPet: Cardinal;
  maxSizeBufferChico: Cardinal;
  k: Integer;
begin
  s:= 'Hola....';
  maxSizeBufferChico:= getMaxSizeBufferChico;
  k:= 0;
  while Length(s) <= maxSizeBufferChico do
  begin
    s:= s+ IntToStr(k)+'123456789';
    k:= k + 1;
  end;

  if self.eIpNodoDestino.Text='localhost' then
    idNodoDestino:= getIdNodoLocal
  else
    idNodoDestino:= IP4StrToCardinal( eIpNodoDestino.text );

  fc.idNodoOrigen:= getIdNodoLocal;
  fc.idOrigen:= idTopo;
  fc.idNodoDestino:= idNodoDestino;
  fc.idDestino:= 0;
  fc.codigoMsg:= MSGP_TOPO_MEMO_ADD;
  fc.idTarea:= getNextIdTareaMemoAdd;
  fc.nBytesDatos:= length( s );
  idPet:= comunicar( @fc, @s[1], 5000 );
  if idPet > 0 then
    memo.Lines.Add('Comunicar: Tarea MemoAdd' + IntToStr(fc.idTarea) + ' enviada ok')
  else
    memo.Lines.Add('Comunicar Fallo');
end;

procedure TTopoSock.ReadRosXCFG;
var
  f: textfile;

begin
 if not FileExists( ARCHI_ROSX_CFG ) then
 begin
   writeln( 'ERROR, debe crear el archivo: ', ARCHI_ROSX_CFG );
   writeln( 'Con tres líneas, host ,port  y uri a un rosx.php' );
   raise exception.Create('Definir configuración rosx' );
 end;

 filemode:= 0;
 assignfile( f, ARCHI_ROSX_CFG );
 reset( f );
 readln( f, rosx_host );
 readln( f, rosx_port );
 readln( f, rosx_uri );
 closefile( f );

end;

procedure TTopoSock.BIpToCardinalClick(Sender: TObject);
begin
  ETestConvertIp.Text:= IntToStr(IP4StrToCardinal(eIpNodoDestino.Text));
end;
{$ENDIF}



procedure TTopoSock.cargarListadoDeNodos;
var
  lineas: TStringList;
  r, ipStr, puertoStr, maquinaStr: String;
  k: Integer;
  aNodo: TNodo;
  ds: TResultadoQuery;
  rec: TDataRecord;
  dbcon: TDBrosxCon;
begin

(**** que lo lea del servidor
  lineas:= TStringList.Create;
  lineas.LoadFromFile( archiListadoDeTopos );

  for k := 0 to Nodos.Count - 1 do
    TNodo( Nodos.Items[k] ).Free;
  nodos.Clear;

  for k := 0 to lineas.Count - 1 do
  begin
    r:= lineas[k];
    if (pos('fin.', r ) = 0) and (pos('//', r) <> 1) then
    begin
      ipStr:= uAuxiliares.nextPal( r );
      puertoStr:= uAuxiliares.nextPal( r );
      maquinaStr:= uAuxiliares.nextPal( r );
      if (ipStr <> '') and (puertoStr <> '') then
      begin
        aNodo:= TNodo.Create( ipStr, StrToInt( puertoStr ), maquinaStr);
        nodos.Add( aNodo );
      end;
    end;
  end;
***)

  dbcon:= TDBrosxCon.Create('', rosx_host, rosx_port, rosx_uri );

writeln( '--- intentando cargar listado de nodos ...' );
  for k := 0 to Nodos.Count - 1 do
    TNodo(Nodos.Items[k]).Free;
  nodos.Clear;

  dbcon.ros_getmyipandport( public_ip, public_port );

  leer_global_nid;
  if  ( global_nid = 0 )
    or ( dbcon.sql_func( 'SELECT count(*) FROM topos WHERE nid =  '+IntToStr( global_nid )+' LIMIT 1 ') <> '1' )
  then
  begin
    // si no tengo un global_nid pido uno
    global_nid:= dbcon.sql_nextnid( 'topos' );
    guardar_global_nid;
    dbcon.sql_exec(
              'INSERT INTO topos ( nid, maquina, iplocal, puertolocal, ipglobal, puertoglobal, dtu ) '
              + ' VALUES ( '+IntToStr( global_nid )
                +', "'+ pm^.nombreMaquina +'"'
                +', "'+CardinalToIP4Str(pm^.idNodoLocal)+'", '+IntToStr(  topoSrv.Puerto )
                +', "'+public_ip+'", '+IntToStr( public_port )+', now() ) '  );
  end
  else
  begin
    dbcon.sql_exec(
              'UPDATE topos SET '
              +' maquina="'+pm^.nombreMaquina+'",'
              +' iplocal = "'+CardinalToIP4Str(pm^.idNodoLocal)+'",'
              +' puertolocal='+IntToStr(  topoSrv.Puerto )+', ipglobal="'+public_ip
              +'", puertoglobal='+IntToStr( public_port )+', dtu= now( ) '
              +' WHERE nid = '+IntToStr( global_nid )+' LIMIT 1' );

  end;

  ds:= dbcon.sql_query( 'SELECT * FROM topos' );
  rec:= ds.next();
  while rec <> nil do
  begin
      ipStr:= rec.GetByNameAsString('iplocal');
      puertoStr:= rec.GetByNameAsString('puertolocal');
      maquinaStr:= rec.GetByNameAsString('maquina');
      writeln( 'NODO: ', ipStr,':',puertoStr,':', maquinaStr );
      if (ipStr <> '') and (puertoStr <> '') then
      begin
        aNodo:= TNodo.Create( ipStr, StrToInt( puertoStr ), maquinaStr);
        nodos.Add( aNodo );
      end;
      rec:= ds.next();
  end;
  ds.Free;

  dbcon.free;
end;



procedure TTopoSock.leer_global_nid;
var
   f: textfile;
begin
   global_nid:= 0;
   assignfile( f, ARCHI_GLOBAL_NID );
   {$I-}
   reset( f );
   {$I+}
   if ioresult = 0 then
   begin
     system.readln( f , global_nid );
     closefile( f );
   end;
end;

procedure TTopoSock.guardar_global_nid;
var
   f: textfile;
begin

   assignfile( f, ARCHI_GLOBAL_NID );
   rewrite( f );
   system.writeln( f , global_nid );
   closefile( f );
end;

{$IFDEF LCL}
procedure TTopoSock.FormCreate(Sender: TObject);
{$ELSE}
constructor TTopoSock.Create(AOwner: TComponent);
{$ENDIF}

var
  fc: TFichaComunicado;
  {$IFDEF LINUX}
  sigs: sigset_t;
  {$ENDIF}
begin
 CrearArchivosKeys;
 ReadRosXCFG;

 // Crea arbol de directorios SimSEE
 uConstantesSimSEE.crearDirectorios;
 if not (DirectoryExists(dirbase + DirectorySeparator + 'config')) then
    CreateDir(dirbase + DirectorySeparator + 'config');
 if not (DirectoryExists(dir_temp)) then
    CreateDir(dir_temp);

 writeln( '->FormCreate' );

 {$IFNDEF LCL}
 inherited Create( AOwner );
 {$ENDIF}
 {$IFDEF LINUX}
 recolectar:= false;
 {$ELSE}
 //Le asigno alta prioridad al topo para que no se pierdan mensajes
 //por estar realizando calculos
 SetPriorityClass(GetCurrentProcess, HIGH_PRIORITY_CLASS);
 {$ENDIF}
 Nodos:= TList.Create;
 writeln('TTopoSock.Create: NetTopos-Inicializar');

 if not inicializar then
    begin
      {$IFDEF LINUX}
       recolectar := false;
      {$ELSE}
       PostMessage(Handle,WM_CLOSE, 0, 0);
      {$ENDIF}
      exit;
    end;

 writeln('TTopoSock.Create: NetTopos-RegistrarAplicacion');
 {$IFDEF LINUX}
 idTopo:= registrarAplicacion( uconstantes_nettopos.AppName_Topo , fpGetPid);
 //writeln( 'instalo handlers->' );
 InstallHandlers;
 FpsigEmptySet(sigs);
 FpSigAddSet(sigs, SIGALRM);
 pthread_sigmask(SIG_SETMASK, @sigs, nil);
 //writeln( 'volvi de instalar handlers <-');
 {$ELSE}
 idTopo:= registrarAplicacion( uconstantes_nettopos.AppName_Topo , handle);
 {$ENDIF}
 writeln('IDTOPO: ',idTopo);
 if idTopo = 0 then
    begin
      {$IFDEF LINUX}
      recolectar:= false;
      {$ELSE}
      PostMessage(Handle,WM_CLOSE, 0, 0);
      {$ENDIF}
      exit;
    end;

 writeln('Volvi de registrarAplicacion, idTopo: ', idTopo );
 //  eIdTopo.Text:= IntToStr( idTopo );
 if idTopo <> 0 then
     begin
        {$IFDEF appsConocidas}
        appsConocidas:= NIL;
        {$ENDIF}
        topoSrv:= NIL;
        writeln('TTopoSock.Create: setDatosMaquina');
        setDatosMaquina;
        {$IFDEF appsConocidas}
        writeln( 'appsConocidas' );
        appsConocidas:= TListaAppsConocidas.Create_ReadFromArchi(  archiListadoDeAplicacionesConocidas );
        {$ENDIF}
        idNodo:= getIdNodoLocal;
        writeln('NombreMaquina: ', getNombreNodoLocal );
        writeln('DireccionIP: ', CardinalToIP4Str( idNodo ) );
        writeln('idNodo: ', IntToStr( idNodo ));
        writeln('idTopo: ', IntToStr( idTopo ));
        writeln('TTopoSock.Create: Creando el TopoSrv...');

        topoSrv:= TTopoSrv.Create( PuertoTopo );
        DateSeparator:= '/';
        ShortDateFormat:='d/m/y';
        {$IFDEF LINUX}
        recolectar:= true;
        cargarListadoDeNodos;
        {$ELSE}
        BGetNodosRegistradosClick(Self);
        {$ENDIF}

        {$IFDEF LCL}
        eNombreMaquina.Text:= getNombreNodoLocal;
        eDireccionIP.Text:= CardinalToIP4Str( idNodo );
        eIdNodo.Text:= IntToStr( idNodo );
        eIdTopo.Text:= IntToStr( idTopo );
        {$ENDIF}
     end
     else
     begin
     writeln('TTopoSock.Create: Error al registrarme en DLL');
     {$IFDEF WINDOWS}
     PostMessage(Handle,WM_CLOSE, 0, 0);
     {$ENDIF}
     end;

 //msgsRetardados := TMensajesRetardados.Create;
 //fc.idNodoOrigen:=pm^.idNodoLocal;
 //fc.idOrigen:=idAplicYo;
 //fc.idNodoDestino:=pm^.idNodoLocal;
 //fc.idDestino:=idAplicYo;
 //fc.nBytesDatos:=0;
 //fc.codigoMsg:=WM_CLOSE;
 ////agendar_msgRetardado(fc, 0, 10, false);
 end;

{$IFDEF LCL}
procedure TTopoSock.FormDestroy(Sender: TObject);
{$ELSE}
procedure TTopoSock.Free;
{$ENDIF}
var
  k: integer;
  cntAplics: integer;
  aplics: array of TFichaAplicacion;
  fc:TFichaComunicado;
  s:String;
  dbcon: TDBrosxCon;
begin
 dbcon:= TDBrosxCon.Create('', rosx_host, rosx_port, rosx_uri );
// borra al topo de la tabla...
 writeln ('NID TOPO ', IntToStr(global_nid));
 dbcon.sql_exec('DELETE FROM topos WHERE nid='+IntToStr(global_nid));

 if Nodos <> nil then
  begin
    for k := 0 to Nodos.Count - 1 do
      TNodo( Nodos.items[k] ).Free;
    FreeAndNil( nodos );
  end;

{$IFDEF appsConocidas}
  if appsConocidas <> NIL then
    appsConocidas.FreeConElemenentos;
{$ENDIF}

  // --- le pedimos al servidor que salga de su loop de escucha
  // --- y le damos un tiempito para que lo haga amigablemente.
  if topoSrv <> NIL then
  begin
    topoSrv.senializarFin;
    topoSrv.WaitFor;
    topoSrv.Free;
  end;

  cntAplics:= GetNAplicsRegistradas;
  if cntAplics > 0 then
  begin
    fc.idNodoOrigen:=pm^.idNodoLocal;
    fc.idOrigen:=idAplicYo;
    fc.idNodoDestino:=pm^.idNodoLocal;
    fc.codigoMsg:=WM_CLOSE;
    fc.nBytesDatos:=0;

    setlength( aplics, cntAplics );
    dumpFichasAplics( @aplics[0], cntAplics );

    for k := 0 to cntAplics-1 do
      if idAplicYo <> aplics[k].idAplic then
        begin
          fc.idDestino:=aplics[k].idAplic;
          comunicar(@fc, nil, 500);
        end;
  end;

  if idTopo > 0 then
  begin
    desregistrarAplicacion( idTopo );
  end;
  finalizar;

  dbcon.Free;
  writeln('topo: CHAUU');

{$IFDEF LINUX}
//  inherited Free;
{$ENDIF}
end;

procedure TTopoSock.msg_RespuestaTS(var Msg: TMessage);
var
  fc: TFichaComunicado;
  datos: TPackedBytes;
  pdatos: pointer;
  idPeticion: cardinal;
  smfTS: TMutex;
  ftars: PRecFichaTareaSincrona;
begin
  pdatos:= nil;
  if leerFichaComunicado( msg.WParam, @fc ) > 0 then
  begin
    if fc.nbytesdatos > 0 then
    begin
      setlength( datos, fc.nbytesdatos );
      pdatos:= @datos[0];
      levantarDatosComunicado( msg.WParam, pdatos, fc.nbytesdatos );
    end
    else
      levantarDatosComunicado( msg.WParam, nil, 0 );

    // mandamos la comunicación vía dlginter
    fc.idNodoDestino:= 0;

{$IFDEF LINUX}
    smfTS:= TMutex.Create( keySmfTopoTareasSincronas, 1);
{$ELSE}
    smfTS:= TMutex.Create( uconstantes_nettopos.nom_Smf_topo_tareassincronas);
{$ENDIF}
    if smfTS.Get( 10000 ) then
    begin
      ftars:= buscartareasincro(fc.idTarea);
      if ( ftars <> nil ) then
      begin
        idPeticion:= ftars^.idPeticion;
        respuestaTS(idPeticion, ftars^.idTareaOriginal, @fc, pdatos);
        ftars^.idPeticion:= 0;
      end;
      smfTS.Release;
    end;
    smfTS.Free;
  end
  else
    logError('msg_RespuestaTS: ' + getNetTopos_StrError(ERROR_NO_SE_PUDO_TRAER_EL_COMUNICADO_DESDE_LA_DLL) + ' IdPeticion= ' + IntToStr(msg.WParam));
end;

{$R *.lfm}
end.
