Broadcast a traves de Threads

[josepicd]

Vuelvo para plantearos otro problema. De momento no tiene aplicacion practica, pero estoy intentando aprender como funciona.

Tengo varios programas por la red que tienen activo un TSockectServer y estan escuchando por el puerto 7000.


Ahora tengo que hacer un programa con varios TSocketClient que se conecte a todos los Servers.

Tengo algo asi

Código Delphi [-]
var
  i: Integer;
begin
  lsb.Items.Clear;

  for i := 2 to 255 do
  begin
    if cs.Active then cs.Close;
    cs.Address := '192.168.0.' + inttostr(i);
    cs.Port := 7000;
    try
      cs.Open;
    except
    end;
    if cs.Active then lsb.Items.Add( cs.Address);
  end;
end;

Esto funciona, pero va lento porque tiene que esperar a que cs.Open de un error. La intencion seria lanzar 255 Threads y que vayan respondiendo. Esto sabria hacerlo, lo que no se como hacer es que cada Thread añada una linea a lsb. Y ya puestos para no obtener 255 mensajes de error, alguien sabe como silenciar cs.open?

[[AgustinOrtu]]

Yo creo que lo ideal seria escanear la red buscando los ip que existían, en vez de intentar conectar a 255; estoy seguro que escafandra había comentado al respecto

Estas ocultando la excepción con un try except, no deberías verla en tiempo de ejecución: obvio que si ejecutas desde Delphi y con el depurador (f9) ahí si ves la excepción

[josepicd]

Empezado por AgustinOrtu

Yo creo que lo ideal seria escanear la red buscando los ip que existían, en vez de intentar conectar a 255; estoy seguro que escafandra había comentado al respecto

Estas ocultando la excepción con un try except, no deberías verla en tiempo de ejecución: obvio que si ejecutas desde Delphi y con el depurador (f9) ahí si ves la excepción

¿A scanear te refieres a lanzar un ping y si hay respuesta intentar la conexion?

[[escafandra]]

Podemos escanear toda la red, o un rango de IPs, haciendo ping en varios hilos (de esto hay información en el foro), o bien, como mostré en este ejemplo, usar un servidor UDP en un hilo de nuestro programa servidor, que responda a un mensaje por ese protocolo a cada cliente que lo envíe. Los clientes envían un solo mensaje a la dirección broadcast de la red, de forma que todos los servidores lo recibirán. Dado que UDP no depende de conexión y que puede fallar, se puede repetir el mensaje un número determinado de veces. El mensaje de cada servidor, será recibido por el cliente que lo envía. Para ello, debe estar a la escucha en dicho protocolo UDP en un hilo a parte, que tomará nota de cada IP que responda. De esta forma, el cliente sabe los servidores que están en ese momento a la escucha. El sistema es parecido al que usan los dispositivos que quieren conectarse a un router para establecer la conexión después de esta verificación.

Para encontrar la dirección del broadcast de una red, se puede usar este método.
Para hacer ping sin usar componentes de terceros, propongo este código.

Saludos.

[josepicd]

Os pongo este codigo, me funciona bien pero creo que tengo algun problema con la liberacion de los hilos, porque lo ejecuto una primera vez y ok, la segunda vez que le doy, a veces funciona, a veces se para por la mitad y le lanza el error que adjunto. Supongo que se queda corto de recursos porque no libero algo bien.

Código Delphi [-]
constructor TSearchPLCs.Create( sip : string; lst : TStrings);
  begin
    inherited create( true);
    FreeOnTerminate := true;

    faddress := sip;
    self.lst := lst;

    fcs := TClientSocket.Create( nil);
    fcs.ClientType := ctNonBlocking;
    fcs.Port       := 7000;
    fcs.Address    := faddress;
    resume;
  end;

Destructor TSearchPLCs.Destroy;
begin
  if fcs.Active then fcs.close;
  fcs.Free;
  inherited;
end;


procedure TSearchPLCs.Execute;
  begin
    try
      fcs.Open; delay( 150);
    except
    end;
    if fcs.Active then Synchronize( dosync);
    terminate;
  end;

procedure TSearchPLCs.DoSync;
begin
  lst.Add( faddress);
end;

//////////////////////////////////////////

procedure TForm1.Button1Click(Sender: TObject);
const base = '192.168.0.';
var
  i: Integer; list : TStrings;
begin
  lsb.Items.Clear;
  list := TStringList.Create;

  for I := $01 to $FF do
  begin
    TSearchPLCs.Create(base + inttostr(i), list);
    caption := base + inttostr(i);
  end;

  lsb.Items.Assign( list);
  list.Free;
end;

[[escafandra]]

A bote pronto, parece que puedes estar destruyendo list antes de que terminen los hilos. No debes usar una variable local como parámetro de un hilo, debe existir mientras dure la vida del cada hilo.

Saludos.

[[AgustinOrtu]]

No estas protegiendo el acceso a un recurso compartido (TStringList)

Ese codigo crea el TStringList, pone cierta cantidad de hilos en marcha, y mientras los hilos estan trabajando, asignas a un ListBox el StringList y luego lo liberas. No podes afirmar que todos los hilos terminaron su trabajo

[[AgustinOrtu]]

Podes probar de esta manera

MainForm;

Código Delphi [-]
unit Unit1;

interface

uses
  Windows,
  Messages,
  SysUtils,
  Variants,
  Classes,
  Graphics,
  Controls,
  Forms,
  Dialogs,
  StdCtrls;

type
  TForm1 = class(TForm)
    ListBox1: TListBox;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  strict private
    procedure OnWorkFinish(Sender: TObject; const AResult: Boolean; const AIpAdress: string);
  end;

var
  Form1: TForm1;

implementation

uses
  UThread;

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
const
  base = '192.168.1.';
var
  i: Integer;
  LWorker: TIpWorker;
begin
  ListBox1.Items.Clear;

  for i := 1 to 3 do
  begin
    LWorker := TIpWorker.Create(base + IntToStr(I), OnWorkFinish);
    LWorker.Execute;
  end;
end;

procedure TForm1.OnWorkFinish(Sender: TObject; const AResult: Boolean; const AIpAdress: string);
begin
  TThread.Queue(NIL,
    procedure
    begin
      ListBox1.Items.Add(Format('Resultado = %s, IP [%s] ', [BoolToStr(AResult, True), AIpAdress]));
    end);
end;

end.

Código Delphi [-]
unit UThread;

interface

uses
  Classes,
  ScktComp;

type
  TIpWorkerEvent = procedure(Sender: TObject; const AResult: Boolean; const AIpAdress: string) of object;

  TIpWorker = class(TThread)
  strict private
    FSocket: TClientSocket;
    FOnWorkFinish: TIpWorkerEvent;
    procedure SetOnWorkFinish(const Value: TIpWorkerEvent);
  public
    constructor Create(const AAdress: string; AOnFinish: TIpWorkerEvent);
    destructor Destroy; override;
    procedure Execute; override;
    property OnWorkFinish: TIpWorkerEvent read FOnWorkFinish write SetOnWorkFinish;
  end;

implementation

{ TIpWorker }

constructor TIpWorker.Create(const AAdress: string; AOnFinish: TIpWorkerEvent);
begin
  inherited Create(True);
  FreeOnTerminate := True;
  FOnWorkFinish := AOnFinish;
  FSocket := TClientSocket.Create(NIL);
  FSocket.Address := AAdress;
  FSocket.ClientType := ctBlocking;
  FSocket.Port := 80;
end;

destructor TIpWorker.Destroy;
begin
  FSocket.Free;
  inherited;
end;

procedure TIpWorker.Execute;
begin
  try
    try
      FSocket.Open;
    except

    end;
  finally
    if Assigned(FOnWorkFinish) then
      FOnWorkFinish(Self, FSocket.Active, FSocket.Address);
    Terminate;
  end;
end;

procedure TIpWorker.SetOnWorkFinish(const Value: TIpWorkerEvent);
begin
  FOnWorkFinish := Value;
end;

end.

Aunque la verdad la implementacion TClientSocket es una lagrima: no tiene para establecer TimeOut

[[AgustinOrtu]]

Vaya, pesimo de mi parte

El metodo TThread.Execute deberia estar en la seccion protegida de la clase

Código Delphi [-]
  TIpWorker = class(TThread)
  strict private
    FSocket: TClientSocket;
    FOnWorkFinish: TIpWorkerEvent;
    procedure SetOnWorkFinish(const Value: TIpWorkerEvent);
  protected
    procedure Execute; override;
  public
    constructor Create(const AAdress: string; AOnFinish: TIpWorkerEvent);
    destructor Destroy; override;
    property OnWorkFinish: TIpWorkerEvent read FOnWorkFinish write SetOnWorkFinish;
  end;

Y nunca deberiamos llamar a Execute directamente, sino Start

Código Delphi [-]
  for i := 1 to 255 do
  begin
    LWorker := TIpWorker.Create(base + IntToStr(I), OnWorkFinish);
    LWorker.Start;
  end;

[josepicd]

Gracias a todos y en especial a AgustinOrtu, me ha servido de mucha ayuda. Tema resuelto.