Many people need port scanning for different app. The fastest way of doing a port scanning is via multi socket port scanning.

unit PortScanner;

interface

uses
  WinSock,ExtCtrls,ScktComp,Grids,StdCtrls,dialogs,
  Windows, Messages, SysUtils, Classes;

type
  TPortScanner = class(TComponent)  
  private
    FStartScan       : Boolean;
    FHost            : String;
    FIP              : String;
    FStatus          : String;
    FPortStart       : Word;
    FPortEnd         : Word;
    FNumberOfThreads : Integer;
    FLastPortScaned  : Word;
    FThreadsRunning  : Integer;
    FStringGrid      : TStringGrid;
    FOpenPort        : Word;
    FLbl_MaxS        : TLabel;
    FLbl_Lastprt     : TLabel;
    FLbl_Openprt     : TLabel;
    FLbl_Ip          : TLabel;

    FLog             : TStringList;
    FClearLog        : Boolean;
    FLastLogMessage  : String;
    FOpenPortList    : TStringList;
  protected
    
  public
    constructor Create(AOwner: TComponent); override;
    destructor  Destroy; override;
  Private
    Timer1,Timer2 : TTimer;
    Stop,Start : Boolean;
    wsaData:TWSAData;

    MainSocket:TClientSocket;
    i,l,Port_crn:integer;
    IP_Crn,adr,reqcmd,OS,wsdat,s,s1:string;
    wsd:byte;
    sock_nbr,thr_nbr:integer;
    Targetaddr:Tsockaddr;
    Phe:PHostEnt;
    port_sel:integer;
    sel:boolean;

    Procedure SetStartScan (Value : Boolean);
    Procedure OnTimer1Timer(Sender: TObject);
    Procedure OnTimer2Timer(Sender: TObject);
    procedure chk1;
    procedure Con(Sender: TObject; Socket: TCustomWinSocket);
    procedure Err(Sender: TObject; Socket: TCustomWinSocket; ErrorEvent: TErrorEvent; var ErrorCode: Integer);
    Procedure ClearAll;
    Procedure SetClearLog(Value : Boolean);
  published
    property StartScan       : Boolean read FStartScan       write SetStartScan;
    property Host            : String  read FHost            write FHost;
    property IP              : String  read FIP              write FIP;
    property Status          : String  read FStatus          write FStatus;
    property PortStart       : Word    read FPortStart       write FPortStart;
    property PortEnd         : Word    read FPortEnd         write FPortEnd;
    property NumberOfThreads : Integer read FNumberOfThreads write FNumberOfThreads;
    property LastPortScaned  : Word    read FLastPortScaned  write FLastPortScaned;
    property ThreadsRunning  : Integer read FThreadsRunning  write FThreadsRunning;
    property ClearLog        : Boolean read FClearLog        write SetClearLog;
    property LastLogMessage  : String  read FLastLogMessage  write FLastLogMessage;
    property Log             : TStringList  read FLog          write FLog;
    property OpenPortList    : TStringList  read FOpenPortList write FOpenPortList;

    property StringGrid  : TStringGrid   read FStringGrid  write FStringGrid;
    property Lbl_MaxS     : TLabel   read FLbl_MaxS  write FLbl_MaxS;
    property Lbl_Lastprt     : TLabel   read FLbl_Lastprt  write FLbl_Lastprt;
    property Lbl_Openprt     : TLabel   read FLbl_Openprt  write FLbl_Openprt;
    property Lbl_Ip     : TLabel   read FLbl_Ip  write FLbl_Ip;
    property OpenPort  : Word   read FOpenPort  write FOpenPort;
  end;

procedure Register;

implementation

Procedure TPortScanner.SetClearLog(Value : Boolean);
Begin
  If Value Then FLog.Clear;
  FClearLog:=False;
  FLastLogMessage:='Log Empty';
End;

Procedure TPortScanner.ClearAll;
begin
  If FLbl_Lastprt<>Nil Then FLbl_Lastprt.Caption:='0';
  If FLbl_MaxS<>Nil Then FLbl_MaxS.Caption:='0';
  If FLbl_Openprt<>Nil Then FLbl_Openprt.Caption:='0';
  If FLbl_Ip<>Nil Then FLbl_Ip.Caption:='';
  S:='0';
End;

Procedure TPortScanner.OnTimer1Timer(Sender: TObject);
Begin
  Start:=true;
  Stop:=false;
  Timer1.enabled:=false;
  FLbl_MaxS.Caption:='0';
  FLbl_MaxS.Update;
End;

Procedure TPortScanner.OnTimer2Timer(Sender: TObject);
Begin
  FLbl_Lastprt.Caption:=s;
  FLbl_MaxS.Caption:=inttostr(sock_nbr);
  chk1;
End;

Procedure TPortScanner.SetStartScan(Value : Boolean);
Var
  Error : Integer;
Begin
  If (csLoading  in ComponentState) Then Exit;

  If (csReading  in ComponentState) Then Exit;

  If (csDesigning  in ComponentState) Then
  begin
    ShowMessage('Start scan fail, Application on design mode.');
    Exit;
  End;
  
  FStartScan:=Value;

  If FStartScan Then
  Begin
    ClearAll;
    sel:=false;
    port_sel:=0;
    FStringGrid.SetFocus;
    FStringGrid.RowCount:=2;
    FStringGrid.Rows[1].Clear;
    Stop:=true;
    thr_nbr:=0;
    sock_nbr:=0;
    i:=FPortStart;
//if checkbox2.checked then i:=0;
    Start:=false;
    FOpenPortList.Clear;
    FLog.Add('Clear Open Ports List');
    If inet_addr(pchar(FHost))=-1 Then
    Begin
      Phe := GetHostByName(PChar(FHost));
      If phe=Nil Then ShowMessage(IntToStr(WSAGetLastError));

      If phe = Nil Then
      Begin
//        FLog.Add('Resolving Host Name Fail');
//        FLbl_Ip.Caption:='Can`t Resolve Host';
        Start:=True;
        Exit;
      End Else
      Begin
        TargetAddr.sin_addr.S_addr := longint(plongint(Phe^.h_addr_list^)^);
        adr := StrPas(inet_ntoa(TInAddr(TargetAddr.sin_addr.S_addr)));
        FIP:=adr;
//        FLog.Add('Host IP = '+adr);
//        FLbl_Ip.Caption:=adr;
        chk1;
      End;
    End Else
    Begin
      adr:=FHost;
      FLbl_Ip.Caption:=adr;
      Timer2.enabled:=true;
      chk1;
    End;
  End Else
  Begin
    Timer2.Enabled:=False;
    Stop:=False;
  End;
End;

destructor TPortScanner.Destroy;
begin
  TImer1.Enabled:=False;
  Timer2.Enabled:=False;
  Timer1.Destroy;
  Timer2.Destroy;
  FLog.Free;
  FOpenPortList.Free;
  WSACleanup;
  inherited Destroy;
end;

constructor TPortScanner.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FLog:=TStringList.Create;
  FOpenPortList:=TStringList.Create;
  Timer1:=TTimer.Create(Self);
  Timer1.OnTimer:=OnTimer1Timer;
  Timer1.Interval:=100;
  Timer2:=TTimer.Create(Self);
  Timer2.OnTimer:=OnTimer2Timer;
  Timer2.Interval:=200;
  FHost:='localhost';
  FNumberOfThreads:=50;
  FLastPortScaned:=0;
  FPortStart:=0;
  FPortEnd:=65534;
  FLbl_MaxS:=Nil;
  FLbl_Lastprt:=Nil;
  FLbl_Openprt:=Nil;
  FLbl_Ip:=Nil;
  FStringGrid:=Nil;
  FillChar(wsaData,(sizeof(wsaData)),0);
  WSAStartup($0101,wsaData);
  FLog.Add('Defualt Settings Loaded: Host=localhost, Number of threads = 10, Start port = 0, End port = 65534');
  FLastLogMessage:=FLog.Strings[0];
end;

procedure TPortScanner.Err(Sender: TObject; Socket: TCustomWinSocket; ErrorEvent: TErrorEvent; var ErrorCode: Integer);
begin
  errorcode:=0;
  socket.Close;
  dec(sock_nbr);
  sender.free;
  chk1;
  FLbl_MaxS.Caption:=inttostr(sock_nbr);
end;

Procedure TPortScanner.Con(Sender: TObject; Socket: TCustomWinSocket);
var
j,g:integer;
str3,str1,str2,stri:string;
begin
str3:=inttostr(socket.RemotePort);
str2:='No info on this port.';
socket.Close;
dec(sock_nbr);
chk1;

{for j:=0 to PortList_frm.ListBox1.Items.Count-1 do begin
   str1:=portlist_frm.ListBox1.Items.Strings[j];
   stri:=copy(str1,1,pos(';',str1)-1);
   if stri=str3 then begin
      str2:=copy(str1,pos(';',str1)+1,length(str1));
      break;
   end;
end;
}
FLbl_Openprt.caption:=inttostr(strtoint(FLbl_Openprt.Caption)+1);
g:=strtoint(FLbl_Openprt.Caption);
FStringGrid.RowCount:=g+1;
FStringGrid.cells[0,g]:=str3;
FStringGrid.cells[1,g]:=str2;
Lbl_Lastprt.Caption:=s;
FLbl_MaxS.Caption:=inttostr(sock_nbr);
sender.Free;

end;

Procedure TPortScanner.chk1;
  Label bas,smart,son,sonx;
Begin

bas:

   if Stop=false then goto sonx;
//   if checkbox2.checked then goto smart;
   if i>=FPortEnd then goto son;

if sock_nbr   MainSocket:=Tclientsocket.Create(self);
   MainSocket.OnConnect:=Con;
   MainSocket.Onerror:=Err;
   MainSocket.Address:=adr;
   MainSocket.Port:=i+1;
   inc(i);
   MainSocket.open;
   inc(sock_nbr);
   s:=inttostr(i);

   Try
     if i>(strtoint(FLbl_Lastprt.Caption)+20) then begin
     FLbl_Lastprt.Caption :=s;
     FLbl_Lastprt.Refresh;
     end;
   Except
   End;
end
else goto son;

goto bas;

son:

FLbl_MaxS.Caption:=inttostr(sock_nbr);
FLbl_Lastprt.Caption:=s;
FLbl_Lastprt.refresh;
goto sonx;

smart:

{if i>=PortList_frm.ListBox1.Items.Count-1 then goto son;
   if sock_nbr   MainSocket:=Tclientsocket.Create(self);
   MainSocket.OnConnect:=frm_main.con;
   MainSocket.Onerror:=frm_main.err;
   MainSocket.Address:=adr;
   s1:=portlist_frm.ListBox1.Items.Strings[i+1];
   s:=copy(s1,1,pos(';',s1)-1);
   inc(i);
   if s='' then goto smart;
   MainSocket.Port:=strtoint(s);
   MainSocket.open;
   inc(sock_nbr);
   Lbl_Lastprt.Caption:=copy(s,1,pos(';',s)-1);
   Lbl_MaxS.Caption:=inttostr(sock_nbr);
   Lbl_Lastprt.refresh;
   Lbl_MaxS.Update;
   end
   else goto son;}
goto smart;

sonx:

if sock_nbr=0 then begin
  timer2.enabled:=false;
  Start:=true;
  beep;
end;

end;


procedure Register;
begin
  RegisterComponents('Standard', [TPortScanner]);
end;

end.