Link to home
Start Free TrialLog in
Avatar of aceswildab1
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;

Open in new window

Avatar of Geert G
Geert G
Flag of Belgium image

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
ASKER CERTIFIED SOLUTION
Avatar of aflarin
aflarin

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
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

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

Avatar of aceswildab1
aceswildab1

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?
it seems you have other bindings.

so, just clear Bindings property of your IdTCPServer1 and try again
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;
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].HandleAllocated then
    res:= IdTCPServer.Bindings.Items[i].Port;
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?
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.
It was exactly what I was looking for. Further explanations helped as well.