{-------------------------------------------------------------------------------
  (c) 2003 zw84611
  Simple TCP Port Scan.
  This is not a vcl component, it's just a unit, needn't install.
-------------------------------------------------------------------------------}

unit TCPScan;

interface

uses
  Windows, Messages, SysUtils, Classes, WinSock, Forms;

const
  WM_SOCK = WM_USER + 1;    //自定義windows消息

type

  TScanStatus = class(TObject)
    IP, Port: string;
  end;

  TScanTcpPortThread=class(TThread)
  private
    SockAddrIn: TSockAddrIn;
    FHandle:    HWnd;              //非可視構件消息處理使用
    FirstIP, LastIP, IP: String;
    FirstPort, LastPort, TimeOut: DWORD;
    WAIT_ACK_EVENT:       Thandle;
    ScanStatus: TScanStatus;
  protected
    procedure Execute; override;
    procedure AddItem;
    procedure ShowProgress;
    procedure OnExit;
    procedure ReadData(var Message: TMessage); //message WM_SOCK;
  public
    OnSendEvent: TNotifyEvent;
    OnConnectEvent: TNotifyEvent;
    OnExitEvent: TNotifyEvent;
    constructor Create(First_IP, Last_IP: String; First_Port, Last_Port, Time_Out: DWORD);
    destructor Destroy; override;
  end;

var
  exit_tcp_port_scan: boolean;

implementation

constructor TScanTcpPortThread.Create(First_IP, Last_IP: String; First_Port, Last_Port, Time_Out: DWORD);
var
  WSAData: TWSAData;
begin
  WSAStartup($0101,WSAData);
  FHandle := AllocateHWnd(ReadData);  //attention here.
  WAIT_ACK_EVENT:=CreateEvent(nil,true,false,pchar('TCP_SCAN_WAIT_ACK'));
  
  FirstIP := First_IP;
  LastIP := Last_IP;
  FirstPort := First_Port;
  LastPort := Last_Port;
  TimeOut := Time_Out;

  ScanStatus := TScanStatus.Create; // must be created first.

  FreeOnTerminate := True;
  inherited Create(True);
end;

procedure TScanTcpPortThread.AddItem;
begin

  if assigned(OnConnectEvent) then
  begin
    OnConnectEvent(ScanStatus{TObject(IP)});
  end;

end;

procedure TScanTcpPortThread.ShowProgress;
begin

  if assigned(OnSendEvent) then
  begin
    OnSendEvent(ScanStatus{TObject(IP)});
  end;

end;

procedure TScanTcpPortThread.OnExit;
begin
  if assigned(OnExitEvent) then OnExitEvent(nil);
  DeallocateHWnd(FHandle);
end;

procedure TScanTcpPortThread.Execute;
var
  FSocket: integer;
  //err: integer;
  IP1, IP2, i, j: dword;
begin

  IP1 := ntohl(inet_addr(pchar(FirstIP)));
  IP2 := ntohl(inet_addr(pchar(LastIP)));

  for i := IP1 to IP2 do
  for j := FirstPort to LastPort do
  begin
    //去掉x.x.x.0或x.x.x.255的地址。
    if (((i - 255) mod 256)=0)or((i mod 256)=0) then continue;

    FSocket := socket(PF_INET, SOCK_STREAM,IPPROTO_IP);
    //FHandle := AllocateHWnd(ReadData);
    WSAAsyncSelect(FSocket, FHandle , WM_SOCK, {FD_READ or }FD_CONNECT); //NonBlock

    SockAddrIn.sin_addr.s_addr := htonl(i);
    SockAddrIn.sin_family := PF_INET;
    SockAddrIn.sin_port := htons(j);

    IP := inet_ntoa(SockAddrIn.sin_addr);
    ScanStatus.IP := IP;
    ScanStatus.Port := inttostr(j);
    Synchronize(ShowProgress);

    {err:=}connect(FSocket,SockAddrIn, SizeOf(SockAddrIn));
    //if err=0 then Synchronize(AddItem); // NonBlock mode, err always equals -1
    WaitForSingleObject(WAIT_ACK_EVENT, TimeOut);
    ResetEvent(WAIT_ACK_EVENT);

    WSAAsyncSelect(FSocket, FHandle ,0, 0);
    //DeallocateHWnd(FHandle);
    CloseSocket(FSocket);

    if exit_tcp_port_scan then
    begin
      //break;
      Synchronize(OnExit);
      exit;
    end;
    
  end;

  Synchronize(OnExit);

end;

procedure TScanTcpPortThread.ReadData(var Message: TMessage);
var
  Event: word;
begin

  Event := WSAGetSelectEvent(Message.LParam);
  if Event = FD_CONNECT then
  begin
    //Synchronize(AddItem);
    AddItem;
  end;

end;

destructor TScanTcpPortThread.Destroy;
begin

  //CloseSocket(FSocket);
  WSACleanup();
  //DeallocateHWnd(FHandle);
  inherited Destroy; 

end;

end.