problemas escaner de puertos
 

Hola, estoy intentando hacer una aplicación que dado un rango de direcciones ip, y una lista de puertos nos diga los puertos abiertos de cada ip.

Para ello primero hago un ping (esta parte del programa me funciona bien) y si la la maquina de esa ip responde paso a escanear los puertos de la lista. Para escanear los puertos he utilizado una función posteada por seoane que es la siguiente:

Código Delphi [-]
 
function EstaAbierto(Host: string; Puerto: Integer): Boolean;
var
  WSAData: TWSADATA;
  Address: u_long;
  HostEnt: phostent;
  Addr: sockaddr_in;
  CSocket: Tsocket;
begin
  Result:= FALSE;
  if WSAStartup(MAKEWORD(1, 1), WSADATA) = 0 then
  begin
    Address:= inet_addr(Pchar(Host));
    if Address = INADDR_NONE then
    begin
      HostEnt:= gethostbyname(PChar(Host));
      if HostEnt <> nil then
        Address:= PInteger(HostEnt.h_addr_list^)^;
    end;
    if Address <> INADDR_NONE then
    begin
      CSocket:= socket(AF_INET, SOCK_STREAM, 0);
      if CSocket <> INVALID_SOCKET then
      begin
        Addr.sin_family:= AF_INET;
        Addr.sin_addr.S_addr:= Address;
        Addr.sin_port:= htons(Puerto);
        Result:= connect(CSocket, Addr, Sizeof(Addr)) <> SOCKET_ERROR;
        Closesocket(CSocket);
      end;
    end;
    WSACleanup;
  end;
end;

Cuando los puertos estan abiertos la función responde rapidamente pero cuando estan cerrados tarda al rededor de 21 segundos lo cual hace la función inutilizable para mis propositos.
Tambien lo he intentado mediante TidTcpClient, que se les puede fijar un timeOut, y me funciona bien con un solo Thread pero a medida que aumentamos el numero de threads, aumenta el numero de puertos que nos da como cerrados cuando en realidad estan abiertos.

¿Alguna idea?
Gracias.

Una idea un poco chapucera sería ponerles temporizador.

Si hize el intento de que si no seconectaba en 2 segundo se cerrara el socket pero no funciona. Hasta que la función conect no devuelve un valor no se puede operar sobre el socket.

Gracias de todas formas.

¿No hay ningún evento TimeOut para el connect del TSocket?

Ten en cuenta que realizar un ping no es el método más adecuado, ya que la mayoría de los routers y firewalls impiden los pings, con lo que te dará que la IP no está activa.

.
No, no lo hay.

No estoy de acuerdo, por defecto los router aceptan ping y la gente generalmente no suele cambiar la configuración y los firewall tampoco se suele configurar para que no acepte ping.

Sin duda esperar dos semanas para obtener un resultado es algo deprimente; creo que el problema no es la función o componente, sino cómo estas abordando el problema...

Código Delphi [-]
//...
 
type
  TForm1 = class(TForm)
    Button1: TButton;
    ListBox1: TListBox;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    procedure Found(var Message: TMessage); message WM_USER;
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$r *.dfm}
 
uses WinSock;
 
var IP, Port, Threads: Integer;

function Scan(hWnd: Integer): Integer; stdcall;
var Addr: TSockAddr; hSocket: Integer;
label Back;
begin
 Addr.sin_family := AF_INET;
 Addr.sin_addr.S_addr := IP;
 InterlockedIncrement(Threads);
 SetThreadPriority(DWORD(-2), THREAD_PRIORITY_IDLE);
 repeat Result := InterlockedIncrement(Port);
  Addr.sin_port := htons(Result);
  hSocket := socket(AF_INET, SOCK_STREAM, 0);
  if connect(hSocket, Addr, Sizeof(Addr)) <> SOCKET_ERROR then
   PostMessage(hWnd, WM_USER, IP, Result);
  closesocket(hSocket);
 until Port = $FFFF;
 InterlockedDecrement(Threads);
end;
 
procedure TForm1.Button1Click(Sender: TObject);
var Thread: Word;
begin
 Port := -1;
 ListBox1.Clear;
 IP := inet_addr('212.34.137.175'); // 127.0.0.1
 for Thread := 1 to 1024 do
  CreateThread(nil, 1024, @Scan, Ptr(Handle), 0, PDWORD(0)^);
end;
 
procedure TForm1.FormCreate(Sender: TObject);
var WSData: TWSAData;
begin
 WSAStartup($0202, WSData);
end;
 
procedure TForm1.FormDestroy(Sender: TObject);
begin
 WSACleanup;
end;
 
procedure TForm1.Found(var Message: TMessage);
begin
 ListBox1.AddItem(IntToStr(Message.LParam), nil);
end;
 
//...

Si la anterior solución no te satisface puedes considerar "configurar" los sockets creados con la API setsockopt, opción SO_SNDTIMEO si el equipo remoto usa alguna plataforma de M$.

Claro que depende mucho de la forma en que el equipo remoto responda ante un escaneado, en tal caso el uso de hilos te permite forzar a un hilo "rezagado" a terminar en un determinado tiempo y crear otro en reemplazo del mismo, eso depende (como ya insinué) de la forma en que abordes el problema.


Edito: Si el proceso de escaneado está siendo depurado notificará al depurador cada vez que cree un nuevo hilo, esto afectará considerablemente en el rendimiento del sistema.

Es importante comprender que las variables globales Port y Threads son inicializadas automáticamente en 0, y no deben ser manipuladas directamente por el programador (al igual que la variable IP durante el escaneado).

La variable Threads, ha sido implementada como método de notificación de "escaneado activo" e inactivo.

Finalmente considero que el rango razonable de hilos por proceso para este tipo de aplicaciones es de 256 a 1024.

Saludos

Gracias por tu respuesta cHackAll, lo probare y ya dire que tal resultado dio.