aceswildab1
asked on
Find Open Port
I'm trying to search for an open port using Delphi. Basically, I have a port range that I am trying to scan over. If the port is closed (or unable to be connected with), it moves onto the next. Problem is that no ports are showing as being open (if the first is closed, all others are saying they are closed). Any suggestions on what I'm doing wrong? Here is the code I'm using:
for intIndex := qryServer.FieldByName('port_min').AsInteger to qryServer.fieldByName('port_max').AsInteger do
begin
if ServerConnect(idyServer, intIndex, idyFreeze)= TRUE then
break;
end;
function ServerConnect(AServer : TIdTCPServer; APort : Integer; AFreeze : TIdAntiFreeze) : Boolean;
begin
try
AServer.DefaultPort := APort;
AFreeze.Active := TRUE;
AServer.Active := TRUE;
Application.ProcessMessages;
Result := TRUE;
except
Result := FALSE;
end;
end;
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
lol, aflarin, you got me on that one ...
well, here is the code anyway :)
well, here is the code anyway :)
unit Unit2;
interface
type
TThreadInfoProc = procedure (aPort: integer; IsPortOpen: Boolean; var KeepGoing: Boolean) of object;
const
ReportProgressPortDelta = 500;
procedure FindOpenPort(aInfoProc: TThreadInfoProc; aPortStart, aPortEnd: integer);
implementation
uses Classes, SysUtils,
IdContext, IdBaseComponent, IdComponent, IdCustomTCPServer, IdTCPServer;
type
TThreadOpenPort = class(TThread)
private
FInfoProc: TThreadInfoProc;
FOpenPort: integer;
FIsPortOpen: Boolean;
FKeepGoing: Boolean;
fPortStart, fPortEnd: Integer;
procedure SynchedInfo;
procedure DummyExecute(AContext: TIdContext);
protected
procedure ReportOpenPort(aOpenPort: integer; aIsPortOpen: Boolean); virtual;
procedure Execute; override;
public
constructor Create(aInfoProc: TThreadInfoProc;
aPortStart, aPortEnd: integer;
CreateSuspended: Boolean = False); reintroduce; virtual;
end;
procedure FindOpenPort(aInfoProc: TThreadInfoProc; aPortStart, aPortEnd: integer);
begin
TThreadOpenPort.Create(aInfoProc, aPortStart, aPortEnd);
end;
{ TThreadOpenPort }
constructor TThreadOpenPort.Create(aInfoProc: TThreadInfoProc; aPortStart, aPortEnd: integer; CreateSuspended: Boolean = False);
begin
inherited Create(CreateSuspended);
FreeOnTerminate := True;
FInfoProc := aInfoProc;
FKeepGoing := True;
FOpenPort := 0;
FPortStart := aPortStart;
FPortEnd := aPortEnd;
end;
procedure TThreadOpenPort.ReportOpenPort(aOpenPort: integer; aIsPortOpen: Boolean);
begin
FOpenPort := aOpenPort;
fIsPortOpen := aIsPortOpen;
Synchronize(SynchedInfo);
end;
procedure TThreadOpenPort.SynchedInfo;
begin
if Assigned(FInfoProc) then
FInfoProc(FOpenPort, FIsPortOpen, FKeepGoing);
end;
procedure TThreadOpenPort.DummyExecute(AContext: TIdContext);
begin
// Do nothing
end;
procedure TThreadOpenPort.Execute;
var
IdTCPServer1: TIdTCPServer;
delta: Integer;
ResultAttempt: integer;
begin
IdTCPServer1 := TIdTCPServer.Create(nil);
try
IdTCPServer1.OnExecute := DummyExecute;
Delta := 0;
repeat
ResultAttempt := 0;
try
IdTCPServer1.Active := False;
IdTCPServer1.DefaultPort := fPortStart + Delta;
IdTCPServer1.Active := True;
Sleep(100);
ResultAttempt := 1;
IdTCPServer1.Active := False;
except
// Port not open
ResultAttempt := -1;
end;
if ResultAttempt < 1 then
begin
if Delta mod ReportProgressPortDelta = 0 then
ReportOpenPort(fPortStart + Delta, ResultAttempt = 1);
end else
ReportOpenPort(fPortStart + Delta, ResultAttempt = 1);
Delta := Delta + 1;
until FKeepGoing and ((ResultAttempt = 1) or (fPortStart + Delta > fPortEnd));
finally
IdTcpServer1.Free;
end;
end;
end.
uses Unit2;
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
FindOpenPort(infoProc, 1000, 2000);
end;
procedure TForm1.infoProc(aPort: integer; IsPortOpen: Boolean; var KeepGoing: Boolean);
const
cStrOpen: array[Boolean] of string = ('open', 'closed');
begin
Memo1.Lines.Add(Format('Port: %d = %s', [aPort, cStrOpen[IsPortOpen]]));
KeepGoing := not IsPortOpen;
end;
Even simpler:
function ScanTCPPort(IP: String; Port: DWORD): Boolean;
// Scans a specific TCP port and on a specific IP
function ScanTCPPort(IP: String; Port: DWORD): Boolean;
// Scans a specific TCP port and on a specific IP
unit uPing;
interface
uses
Windows, SysUtils, Classes;
type
TSunB = packed record
s_b1, s_b2, s_b3, s_b4: byte;
end;
TSunW = packed record
s_w1, s_w2: word;
end;
PIPAddr = ^TIPAddr;
TIPAddr = record
case integer of
0: (S_un_b: TSunB);
1: (S_un_w: TSunW);
2: (S_addr: longword);
end;
IPAddr = TIPAddr;
function IcmpCreateFile : THandle; stdcall; external 'icmp.dll';
function IcmpCloseHandle (icmpHandle : THandle) : boolean;
stdcall; external 'icmp.dll'
function IcmpSendEcho
(IcmpHandle : THandle; DestinationAddress : IPAddr;
RequestData : Pointer; RequestSize : Smallint;
RequestOptions : pointer;
ReplyBuffer : Pointer;
ReplySize : DWORD;
Timeout : DWORD) : DWORD; stdcall; external 'icmp.dll';
function Ping(InetAddress : string) : boolean;
function ScanTCPPort(IP: String; Port: DWORD): Boolean;
implementation
uses
WinSock;
function Fetch(var AInput: string;
const ADelim: string = ' ';
const ADelete: Boolean = true)
: string;
var
iPos: Integer;
begin
if ADelim = #0 then begin
// AnsiPos does not work with #0
iPos := Pos(ADelim, AInput);
end else begin
iPos := Pos(ADelim, AInput);
end;
if iPos = 0 then begin
Result := AInput;
if ADelete then begin
AInput := '';
end;
end else begin
result := Copy(AInput, 1, iPos - 1);
if ADelete then begin
Delete(AInput, 1, iPos + Length(ADelim) - 1);
end;
end;
end;
procedure TranslateStringToTInAddr(AIP: string; var AInAddr);
var
phe: PHostEnt;
pac: PChar;
GInitData: TWSAData;
begin
WSAStartup($101, GInitData);
try
phe := GetHostByName(PChar(AIP));
if Assigned(phe) then
begin
pac := phe^.h_addr_list^;
if Assigned(pac) then
begin
with TIPAddr(AInAddr).S_un_b do begin
s_b1 := Byte(pac[0]);
s_b2 := Byte(pac[1]);
s_b3 := Byte(pac[2]);
s_b4 := Byte(pac[3]);
end;
end
else
begin
raise Exception.Create('Error getting IP from HostName');
end;
end
else
begin
raise Exception.Create('Error getting HostName');
end;
except
FillChar(AInAddr, SizeOf(AInAddr), #0);
end;
WSACleanup;
end;
function Ping(InetAddress : string) : boolean;
var
Handle : THandle;
InAddr : IPAddr;
DW : DWORD;
rep : array[1..128] of byte;
begin
result := false;
Handle := IcmpCreateFile;
if Handle = INVALID_HANDLE_VALUE then
Exit;
TranslateStringToTInAddr(InetAddress, InAddr);
DW := IcmpSendEcho(Handle, InAddr, nil, 0, nil, @rep, 128, 0);
Result := (DW <> 0);
IcmpCloseHandle(Handle);
end;
function ScanTCPPort(IP: String; Port: DWORD): Boolean;
// Scans a specific TCP port and on a specific IP
var
OPTON: DWORD;
TCPsock: TSocket;
A: TSockAddrIn;
Buffer : DWORD;
begin
result := False;
Buffer := ntohl(inet_addr(PChar(IP)));
// Create/open a socket (stream, not datagram)
TCPsock := socket(AF_INET, SOCK_STREAM, 0);
if TCPsock <> INVALID_SOCKET then
try
// Set socket options
OPTON := 0;
setsockopt(TCPsock, SOL_SOCKET, SO_KEEPALIVE, @OPTON, sizeof(OPTON));
OPTON := 1;
setsockopt(TCPsock, SOL_SOCKET, SO_DONTLINGER, @OPTON, sizeof(OPTON));
// Only for compatibility with WinSock 1.1! It's default on newer versions.
setsockopt(TCPsock, IPPROTO_TCP, TCP_NODELAY, @OPTON, sizeof(OPTON));
// Reset and init address structure
ZeroMemory(@A, sizeof(A));
A.sin_family := AF_INET;
A.sin_addr.S_addr := ntohl(Buffer);
A.sin_port := htons(Port);
// Try to connect and return result
result := connect(TCPsock, A, sizeof(A)) = 0;
finally
// Close the socket
closesocket(TCPsock);
end;
end;
end.
ASKER
Aflarin,
I tried your solution, but it kept returning the port 0 (which is not in the range). Any ideas what I could be doing wrong?
I tried your solution, but it kept returning the port 0 (which is not in the range). Any ideas what I could be doing wrong?
it seems you have other bindings.
so, just clear Bindings property of your IdTCPServer1 and try again
so, just clear Bindings property of your IdTCPServer1 and try again
ASKER
It is still returning 0 for the default port of the idyServer. I figure I'm missing something small here that's throwing it off and not going with the range I've provided. Here's what my code looks like now:
idyServer.Bindings.Clear;
with idyServer.Bindings.Add do
begin
Port := 0;
ClientPortMin := qryServer.FieldByName('por t_Min').As Integer;
ClientPortMax := qryServer.FieldByName('por t_Max').As Integer;
end;
ServerConnect(idyServer, intIndex, idyFreeze);
function ServerConnect(AServer : TIdTCPServer; APort : Integer; AFreeze : TIdAntiFreeze) : Boolean;
begin
try
// AServer.DefaultPort := APort;
AFreeze.Active := TRUE;
AServer.Active := TRUE;
Result := TRUE;
except
AServer.Active := FALSE;
Result := FALSE;
end;
end;
idyServer.Bindings.Clear;
with idyServer.Bindings.Add do
begin
Port := 0;
ClientPortMin := qryServer.FieldByName('por
ClientPortMax := qryServer.FieldByName('por
end;
ServerConnect(idyServer, intIndex, idyFreeze);
function ServerConnect(AServer : TIdTCPServer; APort : Integer; AFreeze : TIdAntiFreeze) : Boolean;
begin
try
// AServer.DefaultPort := APort;
AFreeze.Active := TRUE;
AServer.Active := TRUE;
Result := TRUE;
except
AServer.Active := FALSE;
Result := FALSE;
end;
end;
default port always will return value that you set in object inspector. to get actived port you should examine bindings property
like this:
for i:= 0 to IdTCPServer.Bindings.Count -1 do
if IdTCPServer.Bindings.Items [i].Handle Allocated then
res:= IdTCPServer.Bindings.Items [i].Port;
for i:= 0 to IdTCPServer.Bindings.Count
if IdTCPServer.Bindings.Items
res:= IdTCPServer.Bindings.Items
ASKER
That worked to get the active port. I have that returned now. Maybe it's just a lack of understanding on my part, but how do I then connect a client to that port? I've been setting the IdTCPClient.Port to the default port of the IdTCPServer. Do I not want to do this? If I enter the active port here, it will not connect for me. Any suggestions?
ASKER
OK, I think I figured out my issue. As soon as I told the IdTCPServer the IP in the settings of the Binding, it worked fine.
ASKER
It was exactly what I was looking for. Further explanations helped as well.
shouldn't you run this in a thread ?
i'll wip up a sample using a thread which sends messages back to the main form
when it finds a open port