I use this snippet to create a new instance of an Indy10 TCPServer:
procedure TPortWindow.AddPort (Item : TListItem);
var
Socket : TIdTcpServer;
begin
Socket := TIdTcpServer.Create(nil);
try
Socket.DefaultPort := strtoint (item.Caption);
Socket.OnConnect := MainWindow.OnConnect;
Socket.OnDisconnect := MainWindow.OnDisconnect;
Socket.OnExecute := MainWindow.OnExecute;
Socket.Active := TRUE;
except
Socket.Free;
OutputError ('Error','Port is already in use or blocked by a firewall.' + #13#10 +
'Please use another port.');
Item.Data := Socket;
Item.Checked := FALSE;
end;
end;
I use this to Delete the instance:
procedure TPortWindow.RemovePort (Item : TListItem);
var
Socket : TIdTcpServer;
begin
if Item.Data = NIL then Exit;
Socket := TIdTcpServer(Item.Data);
try
Socket.Active := FALSE;
finally
Socket.Free;
end;
Item.Data := NIL;
end;
For some reason the instance does NOT stop listening and all clients stay connected. When I try to make a new instance of the previous Port (after the deletion) it says, that the port is already in use which means it did not stop listening.
How can I properly Shutdown this Instance (and also disconnect all connected clients)?
EDIT:
procedure TMainWindow.OnConnect(AContext: TIdContext);
begin
ShowMessage ('connected');
end;
procedure TMainWindow.OnDisconnect(AContext: TIdContext);
begin
ShowMessage ('disconnected');
end;
procedure TMainWindow.OnExecute(AContext: TIdContext);
begin
// Not defined yet.
end;
Setting the Active property to False is the correct thing to do. It will automatically close the listening port(s) and close any active client connections.
What you do need to watch out for, however, is make sure that your server event handlers are not performing any synchronized operations to the main thread while the main thread is busy deactivating the server, otherwise a deadlock will occur.
Related
I need to write a simple chat program that will be used by some customers. Basically, there are a lot of clients connected to a server and they chat together. The server works:
Here the code if needed:
//CONNECT TO THE SERVER
procedure TFormServer.ButtonStartClick(Sender: TObject);
begin
if not TCPServer.Active then
begin
try
TCPServer.DefaultPort := 8002;
TCPServer.Bindings[0].IP := LIP.Text;
TCPServer.Bindings[0].Port := StrToInt(LPort.Text);
TCPServer.MaxConnections := 5;
TCPServer.Active := true;
Memo1.Lines.Add(TimeNow + 'Server started.');
except
on E: Exception do
Memo1.Lines.Add(sLineBreak + ' ====== INTERNAL ERROR ====== ' +
sLineBreak + ' > ' + E.Message + sLineBreak);
end;
end;
end;
//DISCONNECT
procedure TFormServer.ButtonStopClick(Sender: TObject);
begin
if TCPServer.Active then
begin
TCPServer.Active := false;
Memo1.Lines.Add(TimeNow + 'Server stopped.');
end;
end;
//IF CLOSE THE APP DONT FORGET TO CLOSE SERVER!!
procedure TFormServer.FormClose(Sender: TObject; var Action: TCloseAction);
begin
ButtonStopClick(Self);
end;
procedure TFormServer.FormCreate(Sender: TObject);
begin
FClients := 0;
end;
//When a client connects I write a log
procedure TFormServer.TCPServerConnect(AContext: TIdContext);
begin
Inc(FClients);
TThread.Synchronize(nil, procedure
begin
LabelCount.Text := 'Connected sockets: ' + FClients.ToString;
Memo1.Lines.Add(TimeNow + ' Client connected # ' + AContext.Binding.IP + ':' + AContext.Binding.Port.ToString);
end);
end;
//Same, when a client disconnects I log it
procedure TFormServer.TCPServerDisconnect(AContext: TIdContext);
begin
Dec(FClients);
TThread.Synchronize(nil, procedure
begin
LabelCount.Text := 'Connected sockets: ' + FClients.ToString;
Memo1.Lines.Add(TimeNow + ' Client disconnected');
end);
end;
//WHAT I DO HERE:
//I receive a message from the client and then I send this message to EVERYONE that is connected here. It is a global chat
procedure TFormServer.TCPServerExecute(AContext: TIdContext);
var
txt: string;
begin
txt := AContext.Connection.IOHandler.ReadLn();
AContext.Connection.IOHandler.WriteLn(txt);
TThread.Synchronize(nil, procedure
begin
Memo1.Lines.Add(TimeNow + txt);
end);
end;
The sever code is very easy and minimal but it does what I need. This is the client instead:
Here there is the code, very simple:
//CONNECT TO THE SERVER
procedure TFormClient.ConnectClick(Sender: TObject);
begin
if Length(Username.Text) < 4 then
begin
Memo1.Lines.Clear;
Memo1.Lines.Add('ERROR: Username must contain at least 4 characters');
Exit;
end;
if not TCPClient.Connected then
begin
try
Username.Enabled := false;
Memo1.Lines.Clear;
TCPClient.Host := '127.0.0.1';
TCPClient.Port := 8002;
TCPClient.ConnectTimeout := 5000;
TCPClient.Connect;
Connect.Text := 'Disconnect';
except
on E: Exception do
Memo1.Lines.Add(' ====== ERROR ======' + sLineBreak +
' > ' + E.Message + sLineBreak);
end;
end
else
begin
TCPClient.Disconnect;
Username.Enabled := true;
Connect.Text := 'Connect';
end;
end;
//IF YOU FORGET TO DISCONNECT WHEN APP IS CLOSED
procedure TFormClient.FormDestroy(Sender: TObject);
begin
if TCPClient.Connected then
TCPClient.Disconnect;
end;
//Here I send a string to the server and it's good
procedure TFormClient.SendClick(Sender: TObject);
begin
if TCPClient.Connected then
begin
TCPClient.IOHandler.WriteLn(Username.Text + ': ' + EditMessage.Text);
EditMessage.Text := '';
end
else
begin
Memo1.Lines.Add('ERROR: You aren''t connected!');
end;
end;
//Problems here
procedure TFormClient.Timer1Timer(Sender: TObject);
begin
Memo1.Lines.Add(TCPClient.IOHandler.ReadLn());
end;
The problems start in the last procedure Timer1Timer. I have found that TCPServer uses a thread and this is why I call Synchronize to update the UI. Instead TCPClient does not use a thread and I manually have to check the server. Please see this code:
procedure TFormServer.TCPServerExecute(AContext: TIdContext);
var
txt: string;
begin
txt := AContext.Connection.IOHandler.ReadLn();
AContext.Connection.IOHandler.WriteLn(txt);
TThread.Synchronize(nil, procedure
begin
Memo1.Lines.Add(TimeNow + txt);
end);
end;
As you can see, when the server receives a string he immediatly sends it back to all the clients. I try to get the string here:
procedure TFormClient.Timer1Timer(Sender: TObject);
begin
Memo1.Lines.Add(TCPClient.IOHandler.ReadLn());
end;
What is wrong? I have seen a similar question here and answers said that I have to use a timer and IOHandler.ReadLn(), which is what I am doing. I think that the problem is here. How to fix?
Also timer has an interval of 200, is it too short?
I have read what Remy Lebeau said in the answer and I've produced this simple code:
procedure TFormClient.Timer1Timer(Sender: TObject);
begin
if not(TCPClient.Connected) then
Exit;
if TCPClient.IOHandler.InputBufferIsEmpty then
Exit;
Memo1.Lines.Add(TCPClient.IOHandler.InputBufferAsString());
end;
There is a Timer1 component in the form. This works as I expect but it still could lock the UI or not?
The server works
Just an FYI, you don't need the FClients variable at all, especially since you are not really accessing it safely. At the very least, use TInterlocked to access it safely. Or switch to TIdThreadSafeInteger. Though really, the only place you use it is in LabelCount, and you can get the current client count from the TIdTCPServers.Contexts property instead.
This is the client instead:
...
The problems start in the last procedure Timer1Timer.
That is because you are using a UI-based TTimer, and (like most things in Indy) the IOHandler.ReadLn() method blocks until completed. You are calling it within the context of the UI thread, so it blocks the UI message loop until a full line has arrived from the socket.
One way to work around blocking the UI is to place an Indy TIdAntiFreeze component onto your Form. Then the UI will remain responsive while ReadLn() blocks. However, this would be kind of dangerous to use with a TTimer, as you would end up with OnTimer reentry issues that could corrupt the IOHandler's data.
Really, the best solution is to simply not call the IOHandler.ReadLn() in the UI thread at all. Call it in a worker thread instead. Start the thread after you successfully Connect() to the server, and terminate the thread when disconnected. Or even move the Connect() itself into the thread. Either way, you can use Indy's TIdThreadComponent, or write your own T(Id)Thread-derived class.
Instead TCPClient does not use a thread and I manually have to check the server.
Correct, but the way you are doing it is wrong.
If you don't want to use a worker thread (which you should), then at least change your OnTimer event handler so it does not block the UI anymore, like this:
Or:
procedure TFormClient.Timer1Timer(Sender: TObject);
begin
if TCPClient.IOHandler.InputBufferIsEmpty then
begin
TCPClient.IOHandler.CheckForDataOnSource(0);
TCPClient.IOHandler.CheckForDisconnect(False);
if TCPClient.IOHandler.InputBufferIsEmpty then Exit;
end;
// may still block if the EOL hasn't been received yet...
Memo1.Lines.Add(TCPClient.IOHandler.ReadLn);
end;
Alternatively:
procedure TFormClient.Timer1Timer(Sender: TObject);
begin
// Connected() performs a read operation and will buffer
// any pending bytes that happen to be received...
if not TCPClient.Connected then Exit;
while TCPClient.IOHandler.InputBuffer.IndexOf(Byte($0A)) <> -1 do
Memo1.Lines.Add(TCPClient.IOHandler.ReadLn());
end;
I have seen a similar question here and answers said that I have to use a timer and IOHandler.ReadLn(), which is what I am doing.
Whoever said that is wrong, or you misunderstood what was required. Using a timer in the UI is a possible solution, if used correctly, but it is not a very good solution.
Create a thread for your tcpclient and sync messages back to the UI.
I have one external program which doesn't support proxy to access internet and but I need proxy.
As a solution, I've written one simple Delphi Application using Indy 10.6.0.5040 and its TIdMappedPortTCP component. How it works simply, external application connects to IdMappedPortTCP locally and IdMappedPortTCP connects to real server using my proxy settings.
To do my proxy setting, I handled OnConnect event of IdMappedPortTCP like below:
procedure TForm1.IdMappedPortTCP1Connect(AContext: TIdContext);
var
io: TIdIOHandlerStack;
proxy: TIdConnectThroughHttpProxy;
begin
if Assigned(TIdMappedPortContext(AContext).OutboundClient) then
begin
io := TIdIOHandlerStack.Create(TIdMappedPortContext(AContext).OutboundClient);
proxy := TIdConnectThroughHttpProxy.Create(io);
proxy.Enabled := False;
proxy.Host := FSettings.ProxyAddress;
proxy.Port := FSettings.ProxyPort;
proxy.Username := FSettings.ProxyUserName;
proxy.Password := FSettings.ProxyPassword;
If (proxy.Username <> '') or (proxy.Password <> '') then proxy.AuthorizationRequired(True);
proxy.Enabled := True;
io.DefaultPort := FSettings.DestinationPort[0];
io.Port := FSettings.DestinationPort[0];
io.Destination := FSettings.DestinationHostAddress[0];
io.Host := FSettings.DestinationHostAddress[0];
io.TransparentProxy := proxy;
io.OnStatus := StackStatus;
TIdMappedPortContext(AContext).OutboundClient.IOHandler := io;
end;
Log(Format('Listener connected at %s:%d', [TIdMappedPortContext(AContext).Server.MappedHost, TIdMappedPortContext(AContext).Server.MappedPort]));
end;
{ TIdConnectThroughHttpProxyHelper }
procedure TIdConnectThroughHttpProxyHelper.AuthorizationRequired(const val: boolean);
begin
Self.FAuthorizationRequired := val;
end;
procedure TForm1.Log(const s: string);
begin
Memo1.Lines.Add(Format('(%s) %s', [FormatDateTime('hh:nn:ss:zzz', Now), s]));
end;
procedure TForm1.IdMappedPortTCP1Disconnect(AContext: TIdContext);
begin
// Log(Format('Listener disconnected at %s:%d', [TIdMappedPortContext(AContext).Server.MappedHost, TIdMappedPortContext(AContext).Server.MappedPort]));
end;
procedure TForm1.IdMappedPortTCP1Exception(AContext: TIdContext;
AException: Exception);
begin
Log(Format('Exception: %s (%s:%d)', [AException.Message,TIdMappedPortContext(AContext).Server.MappedHost, TIdMappedPortContext(AContext).Server.MappedPort]));
end;
procedure TForm1.IdMappedPortTCP1ListenException(AThread: TIdListenerThread;
AException: Exception);
begin
Log(Format('Listener Exception: %s', [AException.Message]));
end;
procedure TForm1.IdMappedPortTCP1OutboundConnect(AContext: TIdContext);
begin
Log('MappedPort Destination connected.');
end;
procedure TForm1.IdMappedPortTCP1OutboundDisconnect(AContext: TIdContext);
begin
Log('MappedPort Destination disconnected.');
end;
procedure TForm1.StackStatus(ASender: TObject;
const AStatus: TIdStatus; const AStatusText: string);
begin
Log(Format('Stack Status: %s', [AStatusText]));
end;
I have many active connections and all work flawlessly. My problem is that, if I try to deactivate IdMappedPortTCP using "IdMappedPortTCP.Active := false;" while there are active traffics, connections, it hangs there and I had to terminate delphi application using task manager.
Is there anything that I need to do manually before setting Active to false?
Thanks.
Indy servers are multi-threaded. Their events (like OnConnect, OnDisconnect, OnExecute, OnException, and OnListenException) are triggered in the context of worker threads, not the context of the main UI thread. As such, you must sync with the main thread, such as with the TThread.Synchronize() or TThread.Queue() methods, or Indy's TIdSync or TIdNotify classes, in order to access UI components safely.
If the main thread is busy deactivating the server, it cannot process sync requests, so an asynchronous approach (TThread.Queue() or
TIdNotify) is preferred over a synchronous one (TThread.Synchronize() or TIdSync) to avoid a deadlock. Alternatively, deactivate the server in a worker thread so the main thread is free to process sync requests.
I need to set custom timeout for TTcpClient. I think the default timeout time is about 20-25 seconds but I need to change it to 500ms. Is it possible And How?
procedure TForm1.Button1Click(Sender: TObject);
begin
TcpClient2.RemoteHost := '192.168.1.1';
TcpClient2.RemotePort := '23';
TcpClient2.Connect;
tcpclient2.Receiveln();
tcpclient2.Sendln('admin');
tcpclient2.Receiveln;
end;
I tried non-blocking option but the software returns an error after I click on button And I have to do it again 4-5 times. Any help?
Thanks :)
Winsock has no connect timeout, but this can be overcomed.
You have several options:
Without threads:
Using non-blocking mode: call Connect, then wait using Winsock select function (encapsulated in TBaseSocket Select method inherited by TTcpClient).
Using blocking mode: changing temporarily to non-blocking mode and proceeding as in the previous case.
With threads: see Remy Lebeau's answer to How to control the connect timeout with the Winsock API?.
Use Indy.
Blocking vs non-blocking
Using blocking or non-blocking mode is a very important design decision that will affect many of your code and which you can't easily change afterward.
For example, in non-blocking mode, receive functions (as Receiveln), will not wait until there is enough input available and could return with an empty string. This can be an advantage if is this what you need, but you need to implement some strategy, such as waiting using TcpClient.WaitForData before calling the receive function (in your example, the Receiveln-Sendln-Receiveln will not work as is).
For simple tasks, blocking mode is easier to deal with.
Non-blocking mode
The following function will wait until the connection is successful or the timeout elapses:
function WaitUntilConnected(TcpClient: TTcpClient; Timeout: Integer): Boolean;
var
writeReady, exceptFlag: Boolean;
begin
// Select waits until connected or timeout
TcpClient.Select(nil, #writeReady, #exceptFlag, Timeout);
Result := writeReady and not exceptFlag;
end;
How to use:
// TcpClient.BlockMode must be bmNonBlocking
TcpClient.Connect; // will return immediately
if WaitUntilConnected(TcpClient, 500) then begin // wait up to 500ms
... your code here ...
end;
Also be aware of the following drawbacks/flaws in TTcpClient's non-blocking mode design:
Several functions will call OnError with SocketError set to WSAEWOULDBLOCK (10035).
Connected property will be false because is assigned in Connect.
Blocking mode
Connection timeout can be achieved by changing to non-blocking mode after socket is created but before calling Connect, and reverting back to blocking mode after calling it.
This is a bit more complicated because TTcpClient closes the connection and the socket if we change BlockMode, and also there is not direct way of creating the socket separately from connecting it.
To solve this, we need to hook after socket creation but before connection. This can be done using either the DoCreateHandle protected method or the OnCreateHandle event.
The best way is to derive a class from TTcpClient and use DoCreateHandle, but if for any reason you need to use TTcpClient directly without the derived class, the code can be easily rewriten using OnCreateHandle.
type
TExtendedTcpClient = class(TTcpClient)
private
FIsConnected: boolean;
FNonBlockingModeRequested, FNonBlockingModeSuccess: boolean;
protected
procedure Open; override;
procedure Close; override;
procedure DoCreateHandle; override;
function SetBlockModeWithoutClosing(Block: Boolean): Boolean;
function WaitUntilConnected(Timeout: Integer): Boolean;
public
function ConnectWithTimeout(Timeout: Integer): Boolean;
property IsConnected: boolean read FIsConnected;
end;
procedure TExtendedTcpClient.Open;
begin
try
inherited;
finally
FNonBlockingModeRequested := false;
end;
end;
procedure TExtendedTcpClient.DoCreateHandle;
begin
inherited;
// DoCreateHandle is called after WinSock.socket and before WinSock.connect
if FNonBlockingModeRequested then
FNonBlockingModeSuccess := SetBlockModeWithoutClosing(false);
end;
procedure TExtendedTcpClient.Close;
begin
FIsConnected := false;
inherited;
end;
function TExtendedTcpClient.SetBlockModeWithoutClosing(Block: Boolean): Boolean;
var
nonBlock: Integer;
begin
// TTcpClient.SetBlockMode closes the connection and the socket
nonBlock := Ord(not Block);
Result := ErrorCheck(ioctlsocket(Handle, FIONBIO, nonBlock)) <> SOCKET_ERROR;
end;
function TExtendedTcpClient.WaitUntilConnected(Timeout: Integer): Boolean;
var
writeReady, exceptFlag: Boolean;
begin
// Select waits until connected or timeout
Select(nil, #writeReady, #exceptFlag, Timeout);
Result := writeReady and not exceptFlag;
end;
function TExtendedTcpClient.ConnectWithTimeout(Timeout: Integer): Boolean;
begin
if Connected or FIsConnected then
Result := true
else begin
if BlockMode = bmNonBlocking then begin
if Connect then // will return immediately, tipically with false
Result := true
else
Result := WaitUntilConnected(Timeout);
end
else begin // blocking mode
// switch to non-blocking before trying to do the real connection
FNonBlockingModeRequested := true;
FNonBlockingModeSuccess := false;
try
if Connect then // will return immediately, tipically with false
Result := true
else begin
if not FNonBlockingModeSuccess then
Result := false
else
Result := WaitUntilConnected(Timeout);
end;
finally
if FNonBlockingModeSuccess then begin
// revert back to blocking
if not SetBlockModeWithoutClosing(true) then begin
// undesirable state => abort connection
Close;
Result := false;
end;
end;
end;
end;
end;
FIsConnected := Result;
end;
How to use:
TcpClient := TExtendedTcpClient.Create(nil);
try
TcpClient.BlockMode := bmBlocking; // can also be bmNonBlocking
TcpClient.RemoteHost := 'www.google.com';
TcpClient.RemotePort := '80';
if TcpClient.ConnectWithTimeout(500) then begin // wait up to 500ms
... your code here ...
end;
finally
TcpClient.Free;
end;
As noted before, Connected doesn't work well with non-blocking sockets, so I added a new IsConnected property to overcome this (only works when connecting with ConnectWithTimeout).
Both ConnectWithTimeout and IsConnected will work with both blocking and non-blocking sockets.
I have a Delphi application with a Indy TCPServer and TCPClient. I use the AContext.Bindind.Handle for the identification of each connection (wrong?).
So I have a grid which displayed the connections and I will remove the entry after disconnection:
procedure TfrmMain.serverIndyDisconnect(AContext: TIdContext);
var I:Integer;
begin
for I := 0 to gridClients.RowCount - 1 do
begin
if gridClients.Cells[0, I] = IntToStr(AContext.Binding.Handle) then
begin
gridClients.Rows[I].Delete(I);
end;
end;
WriteLogEntry('Connection closed... (' + AContext.Binding.PeerIP+')');
end;
But in the Disconnect Event, the Handle is already empty (it's ever 401xxxxx, so the last Integer number).
Ideas?
You do not mention which version of Delphi or Indy you are using, but the following holds for D2010 and Indy 10.x.
I've used the "AContext.Data" property for identification of the client. I usually Create an object there and release it when the disconnect event happens.
New OnConnect() code:
procedure TfrmMain.serverIndyConnect(AContext: TIdContext);
begin
AContext.Data := TMyObject.Create(NIL);
// Other Init code goes here, including adding the connection to the grid
end;
Modified OnDisconnect() code below:
procedure TfrmMain.serverIndyDisconnect(AContext: TIdContext);
var I:Integer;
begin
for I := 0 to gridClients.RowCount - 1 do
begin
if gridClients.Cells[0, I] = IntToStr(AContext.Data) then
begin
gridClients.Rows[I].Delete(I);
end;
end;
WriteLogEntry('Connection closed... (' + AContext.Binding.PeerIP+')');
end;
Is there a more elegant way of checking if a TCP port is available with Delphi other than catching a netstat call?
I guess you can use Indy's components to do that. For instance a TIdHTTPServer will raise an exception if a port is in use when it is being opened.
So basically you could create such component, bind it to localhost:<yourport> and if an exception is raised ( catch it and check it ) then the port is probably in use, else it is free.
I guess other indy components can tell if a port is open or not, but I can't look at it right now.
This was just to give you an approach.
#Mattl, if Available means open for you, you can use this code.
program CheckTCP_PortOpen;
{$APPTYPE CONSOLE}
uses
Winsock; //Windows Sockets API Unit
function PortTCPIsOpen(dwPort : Word; ipAddressStr:string) : boolean;
var
client : sockaddr_in;//sockaddr_in is used by Windows Sockets to specify a local or remote endpoint address
sock : Integer;
begin
client.sin_family := AF_INET;
client.sin_port := htons(dwPort);//htons converts a u_short from host to TCP/IP network byte order.
client.sin_addr.s_addr := inet_addr(PChar(ipAddressStr)); //the inet_addr function converts a string containing an IPv4 dotted-decimal address into a proper address for the IN_ADDR structure.
sock :=socket(AF_INET, SOCK_STREAM, 0);//The socket function creates a socket
Result:=connect(sock,client,SizeOf(client))=0;//establishes a connection to a specified socket.
end;
var
ret : Integer;
wsdata : WSAData;
begin
Writeln('Init WinSock');
ret := WSAStartup($0002, wsdata);//initiates use of the Winsock
if ret<>0 then exit;
try
Writeln('Description : '+wsData.szDescription);
Writeln('Status : '+wsData.szSystemStatus);
if PortTCPIsOpen(80,'127.0.0.1') then
Writeln('Open')
else
Writeln('Close');
finally
WSACleanup; //terminates use of the Winsock
end;
Readln;
end.
netstat information can be retrieved by calling the GetTcpTable and GetUdpTable functions in the IP Helper API, or IPHLPAPI.DLL. For more information on calling the IPHLPAPI.DLL from Delphi, check out this Network traffic monitor. There are some wrappers for it too, and it is part of JEDI API Library.
I wrote a Delphi version of NetStat long ago, but have since lost the source code. Those resources should get you started though.
The following code from Synapse works very well:
uses
blcksock;
function PortAvailable(Port:STring):boolean;
var
svr : TTCPBlockSocket;
begin
svr := TTCPBlockSocket.Create;
try
svr.Bind('0.0.0.0',Port);
svr.Listen;
result := svr.LastError = 0;
Svr.CloseSocket;
finally
svr.Free;
end;
end;
Using an Indy.Sockets v10 TIdTCPServer component:
function TExample.IsTCPPortAvailable(const APort: Word): Boolean;
var
LTCPServer: TIdTCPServer;
LBinding: TIdSocketHandle;
begin
Result := True;
LTCPServer := TIdTCPServer.Create;
try
try
with LTCPServer do
begin
DefaultPort := APort;
LBinding := Bindings.Add;
LBinding.IP := '127.0.0.1';
LBinding.Port := APort;
OnExecute := TCPServerExecute;
Active := True;
end;
finally
LTCPServer.Free;
end;
except on EIdCouldNotBindSocket do
Result := False;
end;
end;
procedure TExample.TCPServerExecute(AContext: TIdContext);
begin
end;
Based on Silver's example above, and since in many cases you want to find an available port rather than just verifying that a given port is in use:
uses
//Indy V10
IdContext,
IdSocketHandle,
IdTcpServer;
type
//our port-checking tool
TPortChk = class(TIdTCPServer)
procedure OnExec(AContext: TIdContext);
end;
procedure TPortChk.OnExec(AContext: TIdContext);
begin
//does nothing, but must exist and be hooked
end;
//check a TCP port to see if it's already in use.
//normally used before opening a listener.
function PortAvailable(APort: Word): Boolean;
var
svr: TPortChk;
bnd: TIdSocketHandle;
begin
//assume our port is available
Result := True;
//create our checking object
svr := TPortChk.Create;
try
//set the execute event
svr.OnExecute := svr.OnExec;
//loop looking for an available port
try
//set up the binding for our local system and the
//port in question
bnd := svr.Bindings.Add;
bnd.IP := '127.0.0.1';
bnd.Port := APort;
//try to bind. This will throw an EIdCouldNotBindSocket
//exception if the port is already in use.
svr.Active := True;
//if we get here, the port is *currently* available.
//close the server and bail
svr.Active := False;
Exit;
except
//whoops, port's in use (or some related failure)
Result := False;
end;
finally
svr.Free;
end;
end;
//search a range of ports for the first available
function FindAvailablePort(First, Count: Word): Word;
var
svr: TPortChk;
bnd: TIdSocketHandle;
begin
//assume our initial port is available
Result := First;
//create our checking object
svr := TPortChk.Create;
try
//set the execute event
svr.OnExecute := svr.OnExec;
//loop looking for an available port
while (Result - First) < Count do begin
try
//set up the binding for our local system and the
//port in question
bnd := svr.Bindings.Add;
bnd.IP := '127.0.0.1';
bnd.Port := Result;
//try to bind. This will throw an EIdCouldNotBindSocket
//exception if the port is already in use.
svr.Active := True;
//if we get here, we found our available port, so kill the
//server and bail
svr.Active := False;
Exit;
except
Inc(Result);
svr.Bindings.Clear;
end;
end;
//if we get here, all of our possible ports are in use,
//so return $FFFF to indicate that no port is available
Result := $FFFF;
finally
svr.Free;
end;
end;