Find Open Port

aceswildab1
aceswildab1 used Ask the Experts™
on
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;

Open in new window

Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Geert GOracle dba
Top Expert 2009

Commented:
i think application.processmessages isn't a very good approach for this

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
Top Expert 2010
Commented:
You can set the binding's ClientPortMin and ClientPortMax properties to the desired values. When activating the server, it will automatically loop through the range and find an available port:

procedure TForm1.Button1Click(Sender: TObject);
begin
  with IdTCPServer1.Bindings.Add do
  begin
    Port:= 0;
    ClientPortMin:= qryServer.FieldByName('port_min').AsInteger;
    ClientPortMax:= qryServer.fieldByName('port_max').AsInteger;
  end;
  IdTCPServer1.Active:= True;
end;
Geert GOracle dba
Top Expert 2009

Commented:
lol, aflarin, you got me on that one ...

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;

Open in new window

Exploring ASP.NET Core: Fundamentals

Learn to build web apps and services, IoT apps, and mobile backends by covering the fundamentals of ASP.NET Core and  exploring the core foundations for app libraries.

Even simpler:

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. 

Open in new window

Author

Commented:
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?
Top Expert 2010

Commented:
it seems you have other bindings.

so, just clear Bindings property of your IdTCPServer1 and try again

Author

Commented:
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('port_Min').AsInteger;
     ClientPortMax := qryServer.FieldByName('port_Max').AsInteger;
  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;
Top Expert 2010

Commented:
default port always will return value that you set in object inspector. to get actived port you should examine bindings property
Top Expert 2010

Commented:
like this:

for i:= 0 to IdTCPServer.Bindings.Count-1 do
  if IdTCPServer.Bindings.Items[i].HandleAllocated then
    res:= IdTCPServer.Bindings.Items[i].Port;

Author

Commented:
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?

Author

Commented:
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.

Author

Commented:
It was exactly what I was looking for. Further explanations helped as well.

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial