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