I have a piece of code which scans 256 IPv4 addresses within user's network, checks each one for a particular TCP port and checks if it is a server which it can connect to. The concept is fairly simple...
type
TIPAddressV4 = record
IP1: Byte;
IP2: Byte;
IP3: Byte;
IP4: Byte;
function AsString: String;
end;
TServerResult = class(TObject)
//Some proprietary properties...
end;
TServerSearchCallback = Reference to procedure(AItem: TServerResult);
TProgressCallback = Reference to procedure(ACurrent, AMax: Integer);
procedure ServerSearch(ACallback: TServerSearchCallback; AProgressCallback: TProgressCallback);
begin
TThread.CreateAnonymousThread(
procedure
var
Cli: TIdHTTP;
Url, Res, T: String;
IP: TIPAddressV4;
X: Integer;
O: ISuperObject;
S: TServerResult;
begin
IP:= GetThisDeviceIPv4Address;
Cli:= TIdHTTP.Create(nil);
try
Cli.ConnectTimeout:= 50;
//Iterate every possible IPv4 address in same range...
for X := 0 to 255 do begin
//Concatenate IP address and URL...
T:= IntToStr(IP.IP1)+'.'+IntToStr(IP.IP2)+'.'+IntToStr(IP.IP3)+'.'+IntToStr(X);
Url:= 'http://'+T+':12345/ServerInfo';
try
//Test HTTP GET request and check if JSON...
Res:= Cli.Get(Url);
O:= SO(Res);
if O <> nil then begin
//Check if JSON is really expected format...
if O.S['Name'] = 'My Unique Name' then begin
//Trigger callback...
S:= TServerResult.Create;
try
//Populate with proprietary properties...
S.Host:= O.S['host'];
//...
finally
TThread.Synchronize(TThread.CurrentThread,
procedure
begin
if Assigned(ACallback) then
ACallback(S);
end);
//Object is NOT free'd here, receiver takes ownership.
end;
end;
end;
except
on E: Exception do begin
//We don't care about handling exceptions here...
end;
end;
//Used for progress bar...
TThread.Synchronize(TThread.CurrentThread,
procedure
begin
if Assigned(AProgressCallback) then
AProgressCallback(X, 255);
end);
end;
finally
Cli.Free;
end;
end).Start;
end;
For example, if this device's IP is 192.168.0.5, it will scan IP addresses from 192.168.0.0 to 192.168.0.255 to find particular servers it can connect to.
The problem arises with the fact that Apple requires IPv6 support. This code is of course only supporting IPv4 at the moment. IPv6 works entirely differently, and not to mention, a single server might be found on both IPv4 and IPv6.
What do I need to do to make this also work for IPv6, thus fulfilling Apple's IPv6 support requirement?
EDIT
I'm actually thinking that this may not be absolutely required in particular for Apple's requirement. General communication with the API, of course. But for this particular feature of the app, I question whether it falls into the category of this requirement.
Related
The following code always returns True on my system:
uses
WinInet;
function CheckInternetConnection() : Boolean;
var
dwConnectionTypes: Integer;
begin
dwConnectionTypes := (
INTERNET_CONNECTION_MODEM +
INTERNET_CONNECTION_LAN +
INTERNET_CONNECTION_PROXY); // "dwConnectionTypes" now "7"
if (InternetGetConnectedState(#dwConnectionTypes, 0)) then
Result := True // Always hit, "dwConnectionTypes" now "18"
else
Result := False; // Never reaches here!
end;
I've tried:
* unplugging the network cable
* stopped "Wireless Zero Configuration" service
* disabled all connections in Control Panel > Network Connections
* definitely confirmed no internet connection in a web browser
What am I missing?
UPDATE
I've confirmed that dynamically loading wininet.dll and using GetProcAddress to find the method "InternetGetConnectedState" gives exactly the same result with the internet disconnected (returns True and the parameter is set to "18").
If you want to know if you are connected to the Internet, there is no other way that contacting a host on the internet.
Correct technically then you only know if that host is online, but that's often good enough, since if your program requires internet access it's because you need to cantact a host on the internet.
One way of doing that is using a TIdHTTP from Indy:
uses
IdHTTP;
uses
IdHTTP;
function HasInternet: Boolean;
begin
with TIdHTTP.Create(nil) do
try
try
HandleRedirects := True;
Result := Get('http://www.Google.com/') <> '';
except
Result := false;
end;
finally
free;
end;
end;
And then use it :
procedure TForm1.FormCreate(Sender: TObject);
begin
Caption := BoolToStr(HasInternet, True);
end;
But it would be bettet to try to contact you host.
Ok, I am getting very frustrated with this, and want to ask for your help before I throw my computer out my window. I am messing with sockets, and I wrote piece of code to get the ip from DNS that I provide. If I do the command showmessage(getipfromdns('test.no-ip.org'));
it will show the ip address no problem.
However if I try client1.Host/address(I have tried both)
client1.Host := getipfromdns('test.no-ip.org');
and throws me an error saying no address specified.
here is the function to get the ip from dns
function getipfromdns(HostName: string): string;
type
tAddr = array [0..100] of PInAddr;
pAddr = ^tAddr;
var
I: Integer;
WSA: TWSAData;
PHE: PHostEnt;
P: pAddr;
begin
Result := HostName;
WSAStartup($101, WSA);
try
PHE := GetHostByName(pChar(HostName));
if (PHE <> nil) then
begin
P := pAddr(PHE^.h_addr_list);
I := 0;
while (P^[i] <> nil) do
begin
Result := (inet_nToa(P^[i]^));
Inc(I);
end;
end;
except
end;
WSACleanup;
end;
and here is the code for when the form is created.
procedure TForm1.FormCreate(Sender: TObject);
var
duchost : string;
begin
duchost := getipfromdns('test.no-ip.org');
Client1.Address := duchost;
Client1.Active := True;
end;
(client1 is type TCPServerSocket)
gethostbyname() can potentially return multiple addresses for a given hostname. You are looping through the entire list but only returning the last IP in the list. That is the wrong thing to do. You need to loop through the list, attempting to connect to each IP one at a time until one succeeds or the list is exhausted.
I already detect local IP address of my computer using this code (use sockets):
Function Ip_Local : String;
Var Acces_Sock : TCustomIpClient;
Begin
Acces_Sock := TCustomIpClient.Create(Nil);
Try
Result := Acces_Sock.LocalHostAddr
Finally
Acces_Sock.Free;
End;
End;
What about detecting the internal LAN IP address of the router and, if possible, of any LAN-connected appliance such as a DVR?
Using Indy:
function CsiGetRemoteIpAddress(const pHostName: string): string;
begin
TIdStack.IncUsage;
try
Result := GStack.ResolveHost(pHostName);
finally
TIdStack.DecUsage;
end;
end;
When i send a message from TCPClient to a TCPServer it will be handled using OnExecute event in the server . Now i want to handle the received messages in the Client but TCPClient doesn't have any event for this. So i have to make a thread to handle them manually. how can i do it ?
As others said in response to your question, TCP is not a message oriented protocol, but a stream one. I'll show you how to write and read to a very simple echo server (this is a slightly modified version of a server I did this week to answer other question):
The server OnExecute method looks like this:
procedure TForm2.IdTCPServer1Execute(AContext: TIdContext);
var
aByte: Byte;
begin
AContext.Connection.IOHandler.Writeln('Write anything, but A to exit');
repeat
aByte := AContext.Connection.IOHandler.ReadByte;
AContext.Connection.IOHandler.Write(aByte);
until aByte = 65;
AContext.Connection.IOHandler.Writeln('Good Bye');
AContext.Connection.Disconnect;
end;
This server starts with a welcome message, then just reads the connection byte per byte. The server replies the same byte, until the received byte is 65 (the disconnect command) 65 = 0x41 or $41. The server then end with a good bye message.
You can do this in a client:
procedure TForm3.Button1Click(Sender: TObject);
var
AByte: Byte;
begin
IdTCPClient1.Connect;
Memo1.Lines.Add(IdTCPClient1.IOHandler.ReadLn); //we know there must be a welcome message!
Memo1.Lines.Add('');// a new line to write in!
AByte := 0;
while (IdTCPClient1.Connected) and (AByte <> 65) do
begin
AByte := NextByte;
IdTCPClient1.IOHandler.Write(AByte);
AByte := IdTCPClient1.IOHandler.ReadByte;
Memo1.Lines[Memo1.Lines.Count - 1] := Memo1.Lines[Memo1.Lines.Count - 1] + Chr(AByte);
end;
Memo1.Lines.Add(IdTCPClient1.IOHandler.ReadLn); //we know there must be a goodbye message!
IdTCPClient1.Disconnect;
end;
The next byte procedure can be anything you want to provide a byte. For example, to get input from the user, you can turn the KeyPreview of your form to true and write a OnKeyPress event handler and the NextByte function like this:
procedure TForm3.FormKeyPress(Sender: TObject; var Key: Char);
begin
FCharBuffer := FCharBuffer + Key;
end;
function TForm3.NextByte: Byte;
begin
Application.ProcessMessages;
while FCharBuffer = '' do //if there is no input pending, just waint until the user adds input
begin
Sleep(10);
//this will allow the user to write the next char and the application to notice that
Application.ProcessMessages;
end;
Result := Byte(AnsiString(FCharBuffer[1])[1]); //just a byte, no UnicodeChars support
Delete(FCharBuffer, 1, 1);
end;
Anything the user writes in the form will be sent to the server and then read from there and added to memo1. If the input focus is already in Memo1 you'll see each character twice, one from the keyboard and the other form the server.
So, in order to write a simple client that gets info from a server, you have to know what to expect from the server. Is it a string? multiple strings? Integer? array? a binary file? encoded file? Is there a mark for the end of the connection? This things are usually defined at the protocol or by you, if you're creating a custom server/client pair.
To write a generic TCP without prior known of what to get from the server is possible, but complex due to the fact that there's no generic message abstraction at this level in the protocol.
Don't get confused by the fact there's transport messages, but a single server response can be split into several transport messages, and then re-assembled client side, your application don't control this. From an application point of view, the socket is a flow (stream) of incoming bytes. The way you interpret this as a message, a command or any kind of response from the server is up to you. The same is applicable server side... for example the onExecute event is a white sheet where you don't have a message abstraction too.
Maybe you're mixing the messages abstraction with the command abstraction... on a command based protocol the client sends strings containing commands and the server replies with strings containing responses (then probably more data). Take a look at the TIdCmdTCPServer/Client components.
EDIT
In comments OP states s/he wants to make this work on a thread, I'm not sure about what's the problem s/he is having with this, but I'm adding a thread example. The server is the same as shown before, just the client part for this simple server:
First, the thread class I'm using:
type
TCommThread = class(TThread)
private
FText: string;
protected
procedure Execute; override;
//this will hold the result of the communication
property Text: string read FText;
end;
procedure TCommThread.Execute;
const
//this is the message to be sent. I removed the A because the server will close
//the connection on the first A sent. I'm adding a final A to close the channel.
Str: AnsiString = 'HELLO, THIS IS _ THRE_DED CLIENT!A';
var
AByte: Byte;
I: Integer;
Client: TIdTCPClient;
Txt: TStringList;
begin
try
Client := TIdTCPClient.Create(nil);
try
Client.Host := 'localhost';
Client.Port := 1025;
Client.Connect;
Txt := TStringList.Create;
try
Txt.Add(Client.IOHandler.ReadLn); //we know there must be a welcome message!
Txt.Add('');// a new line to write in!
AByte := 0;
I := 0;
while (Client.Connected) and (AByte <> 65) do
begin
Inc(I);
AByte := Ord(Str[I]);
Client.IOHandler.Write(AByte);
AByte := Client.IOHandler.ReadByte;
Txt[Txt.Count - 1] := Txt[Txt.Count - 1] + Chr(AByte);
end;
Txt.Add(Client.IOHandler.ReadLn); //we know there must be a goodbye message!
FText := Txt.Text;
finally
Txt.Free;
end;
Client.Disconnect;
finally
Client.Free;
end;
except
on E:Exception do
FText := 'Error! ' + E.ClassName + '||' + E.Message;
end;
end;
Then, I'm adding this two methods to the form:
//this will collect the result of the thread execution on the Memo1 component.
procedure TForm3.AThreadTerminate(Sender: TObject);
begin
Memo1.Lines.Text := (Sender as TCommThread).Text;
end;
//this will spawn a new thread on a Create and forget basis.
//The OnTerminate event will fire the result collect.
procedure TForm3.Button2Click(Sender: TObject);
var
AThread: TCommThread;
begin
AThread := TCommThread.Create(True);
AThread.FreeOnTerminate := True;
AThread.OnTerminate := AThreadTerminate;
AThread.Start;
end;
TCP doesn't operate with messages. That is stream-based interface. Consequently don't expect that you will get a "message" on the receiver. Instead you read incoming data stream from the socket and parse it according to your high-level protocol.
Here is my code to Read / Write with Delphi 7. Using the Tcp Event Read.
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ScktComp;
type
TForm1 = class(TForm)
ClientSocket1: TClientSocket;
Button1: TButton;
ListBox1: TListBox;
Edit1: TEdit;
Edit2: TEdit;
procedure Button1Click(Sender: TObject);
procedure ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket);
procedure ClientSocket1Error(Sender: TObject; Socket: TCustomWinSocket;
ErrorEvent: TErrorEvent; var ErrorCode: Integer);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
var
UsePort: Integer;
UseHost: String;
begin
UseHost := Edit1.Text;
UsePort := STRTOINT(Edit2.Text);
ClientSocket1.Port := UsePort;
ClientSocket1.Host := UseHost;
ClientSocket1.Active := true;
end;
procedure TForm1.ClientSocket1Read(Sender: TObject;
Socket: TCustomWinSocket);
begin
ListBox1.Items.Add(ClientSocket1.Socket.ReceiveText);
end;
procedure TForm1.ClientSocket1Error(Sender: TObject;
Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
begin
ErrorCode:=0;
ClientSocket1.Active := False;
end;
procedure TForm1.BitBtn1Click(Sender: TObject);
begin
ClientSocket1.Socket.SendText(Edit1.Text);
end;
end.
If you need the Indy client to handle incoming "messages" (definition of "message" depends on the protocol used), I recommend to take a look at the implementation of TIdTelnet in the protocols\IdTelnet unit.
This component uses a receiving thread, based on a TIdThread, which asynchronously receives messages from the Telnet server, and passes them to a message handler routine. If you have a similar protocol, this could be a good starting point.
Update: to be more specific, the procedure TIdTelnetReadThread.Run; in IdTelnet.pas is where the asynchronous client 'magic' happens, as you can see it uses Synchronize to run the data processing in the main thread - but of course your app could also do the data handling in the receiving thread, or pass it to a worker thread to keep the main thread untouched. The procedure does not use a loop, because looping / pausing / restarting is implemented in IdThread.
Add a TTimer.
Set its Interval to 1.
Write in OnTimer Event:
procedure TForm1.Timer1Timer(Sender: TObject);
var
s: string;
begin
if not IdTCPClient1.Connected then Exit;
if IdTCPClient1.IOHandler.InputBufferIsEmpty then Exit;
s := IdTCPClient1.IOHandler.InputBufferAsString;
Memo1.Lines.Add('Received: ' + s);
end;
Don't set Timer.Interval something else 1.
Because, the received data deletes after some milliseconds.
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;