Title: Multi Socket Port Scanner
Question: Many people need port scanning for different app. The fastest way of doing a port scanning is via multi socket port scanning.
Answer:
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_LastprtNil Then FLbl_Lastprt.Caption:='0';
If FLbl_MaxSNil Then FLbl_MaxS.Caption:='0';
If FLbl_OpenprtNil Then FLbl_Openprt.Caption:='0';
If FLbl_IpNil 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.