Broadcast a traves de Threads

[[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