How to find a free port?

I did not understand why you need to look for a free TCP port, but if you still want perversions, use the GetTcpTable function (http://msdn.microsoft.com/en-us/library/aa366026(VS.85).aspx). It will return a list of all TCP connections on the machine.

Once I wrote such a program ... but by example.

unit AdrPortScanner; interface uses Classes,SysUtils,WinSock,AppEvnts,Windows,Forms,Messages; type // Найден открытый порт TPortExistsEvent = procedure (Sender:TObject; Port:Integer) of object; // Начало проверки TWorkBeginEvent = procedure (Sender:TObject; Min,Max:integer) of object; TPortScanner = class abstract private FIPAddress: AnsiString; //FOnPortChecking: TPortExistsEvent; //FOnCheckingDone: TNotifyEvent; FOnPortExists: TPortExistsEvent; FOnWork: TPortExistsEvent; FOnWorkBegin: TWorkBeginEvent; FOnWorkEnd: TNotifyEvent; FTerminated: boolean; FTimeOut: Word; FPortStart: Word; FPortEnd: Word; protected FWorking: boolean; FMaxOpenPort: Word; procedure SetMaxOpenPort(const Value: Word); virtual; abstract; public constructor Create; // Можно запустить, указав URI и в ответ получить существует ли такой function StartChecking(const URI:string):boolean; overload; // А можно указать IP через свойство и просто запустить проверку procedure StartChecking; overload; virtual; abstract; procedure Terminate; property IPAddress:AnsiString read FIPAddress write FIPAddress; property MaxOpenPort:Word read FMaxOpenPort write SetMaxOpenPort; property PortStart:Word read FPortStart write FPortStart; property PortEnd:Word read FPortEnd write FPortEnd; property Terminated:boolean read FTerminated write FTerminated; property TimeOut:Word read FTimeOut write FTimeOut; property Working:boolean read FWorking; // ...проверка продолжается? property OnWork:TPortExistsEvent read FOnWork write FOnWork; property OnWorkBegin:TWorkBeginEvent read FOnWorkBegin write FOnWorkBegin; property OnWorkEnd:TNotifyEvent read FOnWorkEnd write FOnWorkEnd; property OnPortExists:TPortExistsEvent read FOnPortExists write FOnPortExists; end; //============================================================================== TPortScanner1 = class (TPortScanner) type TFSocket = record sa: TSockAddr; FData: integer; ATimeOut: word; end; private FSocket: array of TFSocket; FPort: WORD; FInfo: TWSADATA; FHost: integer; FWorking:boolean; FTerminated:boolean; procedure InitSockets; procedure ApplicationEventsMessage(var Msg: tagMSG; var Handled: Boolean); procedure Checking; protected procedure SetMaxOpenPort(const Value: Word); override; public constructor Create; destructor Destroy; override; procedure StartChecking; override; end; function getIPFromHost(const HostName: AnsiString): AnsiString; implementation//**************************************************************** function GetIPFromHost(const HostName: Ansistring): AnsiString; type TaPInAddr = array[0..10] of PInAddr; PaPInAddr = ^TaPInAddr; var phe: PHostEnt; pptr: PaPInAddr; i: Integer; GInitData: TWSAData; begin WSAStartup($101, GInitData); Result := ''; phe := GetHostByName(PAnsiChar(HostName)); if phe = nil then Exit; pPtr := PaPInAddr(phe^.h_addr_list); i := 0; while pPtr^[i] <> nil do begin Result := inet_ntoa(pptr^[i]^); Inc(i); end; WSACleanup; end; { TPortScanner1 } procedure TPortScanner1.ApplicationEventsMessage(var Msg: tagMSG; var Handled: Boolean); begin if (Msg.message>=FPortStart+WM_USER) and (Msg.message<=FPortEnd+WM_USER) then if WSAGETSELECTERROR(Msg.lParam)=0 then case WSAGETSELECTEVENT(msg.lParam) of FD_CONNECT: begin if Assigned(OnPortExists) then OnPortExists(Self,Msg.message - WM_USER); Application.ProcessMessages; end; end; Handled:=false; end; procedure TPortScanner1.Checking; var i: integer; buf: in_addr; begin FHost:=inet_addr(PAnsiChar(FIPAddress)); if (FPortEnd<=FPortStart)or (FPortEnd>32768) then FHost:=SOCKET_ERROR; if FHost=SOCKET_ERROR then begin if Assigned(OnWorkEnd) then OnWorkEnd(self); Exit; end; buf.S_addr:=FHost; FPort:=FPortStart; for i:=0 to MaxOpenPort-1 do with FSocket[i] do begin TimeOut:=0; FData:=Socket(AF_INET, SOCK_STREAM, 0); end; // while not Terminated do begin Application.ProcessMessages; InitSockets; if FPort>=FPortEnd then break; end; // for i:=0 to MaxOpenPort-1 do CloseSocket(FSocket[i].FData); // end; constructor TPortScanner1.Create; var i: integer; begin inherited; SetLength(FSocket,MaxOpenPort); if WSAStartup(MAKEWORD(2, 0), FInfo)<>0 then Halt; for i:=0 to MaxOpenPort-1 do with FSocket[i] do begin ATimeOut := 0; FData := Socket(AF_INET, SOCK_STREAM, 0); if FData = SOCKET_ERROR then begin WSACleanup; Halt; end; end; Application.OnMessage:=ApplicationEventsMessage; end; destructor TPortScanner1.Destroy; var i: integer; begin for i:=0 to MaxOpenPort-1 do CloseSocket(FSocket[i].FData); WSACleanup; inherited; end; procedure TPortScanner1.InitSockets; var i,time: word; begin for i:=0 to MaxOpenPort-1 do with FSocket[i] do if (FPort>=FPortEnd) or (FTerminated) then break else if (GetTickCount-ATimeOut>TimeOut) then begin sa.sin_family:=AF_INET; sa.sin_addr.S_addr:=FHost; sa.sin_port:=htons(FPort); // WSAAsyncSelect(FData, Application.Handle, WM_USER+FPort, FD_CONNECT); connect(FData, FSocket[i].sa, SizeOf(FSocket[i].sa)); ATimeOut:=GetTickCount; inc(FPort); if Assigned(OnWork) then OnWork(Self,FPort); Application.ProcessMessages; // //Sleep(TimeOut div MaxOpenPort); time:=GetTickCount; while GetTickCount-time<TimeOut div MaxOpenPort do Application.ProcessMessages; end; end; procedure TPortScanner1.SetMaxOpenPort(const Value: Word); begin SetLength(FSocket,Value); FMaxOpenPort:=Value; end; procedure TPortScanner1.StartChecking; begin if not Working then begin FWorking:=true; if Assigned(OnWorkBegin) then OnWorkBegin(self,FPortStart,FPortEnd); try Checking; FWorking:=false; finally if Assigned(OnWorkEnd) then OnWorkEnd(self); end; end; end; { TPortScanner } constructor TPortScanner.Create; begin inherited; FTerminated:=false; FPortStart:=0; FPortEnd:=MAXSHORT; FTimeOut:=5000; FMaxOpenPort:=500; end; function TPortScanner.StartChecking(const URI: string): boolean; var s:Ansistring; begin s:=getIPFromHost(AnsiString(URI)); Result:=s<>''; if Result then begin IPAddress:=s; StartChecking(); end; end; procedure TPortScanner.Terminate; begin FTerminated:=true; end; end. 

Use this:

 ... TMainForm = class(TForm) ... procedure Scan_OnWorkBegin(Sender:TObject; Min,Max:integer); procedure Scan_OnWork(Sender:TObject; Port:Integer); procedure Scan_OnWorkEnd(Sender:TObject); procedure Scan_OnPortChecking(Sender:TObject; Port:integer); public { Public declarations } end; var MainForm: TMainForm; Scan:TPortScanner; ... procedure TMainForm.FormCreate(Sender: TObject); begin Scan:=TPortScanner1.Create; with Scan do begin OnWork:=Scan_OnWork; OnWorkBegin:=Scan_OnWorkBegin; OnWorkEnd:=Scan_OnWorkEnd; OnPortExists:=Scan_OnPortChecking; end; end; ... procedure TMainForm.Scan_StartBtnClick(Sender: TObject); begin with scan do begin TimeOut:=Scan_TimeOutSpinEdit.Value; MaxOpenPort:=Scan_PortsSpinEdit.Value; PortStart:=Scan_StartSpinEdit.Value; PortEnd:=Scan_StopSpinEdit.Value; end; if not Scan.Working then // если сканер еще не запущен... if not Scan.StartChecking(Scan_AddressEdit.Text) then // то запустить... with Scan_DisplayMemo.Lines do // а если ошибка попытки узнать IP адрес по URI была не удачная... begin // то сообщаем об этом Add('Невозможно определить IP адрес '+Scan_AddressEdit.Text); Scan_DisplayMemo.SelStart:=Length(Text); end else else // иначе останавливаем его (у меня была кнопка Старт / Стоп) begin // название кнопки менялось по событию 'OnWorkBegin'и 'OnWorkEnd' Scan.Terminate; // приказываем не посылать новые запросы Scan_StartBtn.Enabled:=false; //к нопка станет активной по событию 'OnWorkEnd' end; end; 

It is possible and without checks and the default number of ports, etc.