I am using Delphi XE2 Update 4 on Windows XP sp3
I am looking to get max possible information from installed network adapters, specially the broadcast ip.
For that I used this code from Jan Schulz that I got from this article.
Unit:
Unit USock;
Interface
Uses Windows, Winsock;
{ Unit to identify the network interfaces
This code requires at least Win98/ME/2K, 95 OSR 2 or NT service pack #3
as WinSock 2 is used (WS2_32.DLL) }
// Constants found in manual on non-officially documented M$ Winsock functions
Const SIO_GET_INTERFACE_LIST = $4004747F;
IFF_UP = $00000001;
IFF_BROADCAST = $00000002;
IFF_LOOPBACK = $00000004;
IFF_POINTTOPOINT = $00000008;
IFF_MULTICAST = $00000010;
Type SockAddr_Gen = Packed Record
AddressIn : SockAddr_In;
Padding : Packed Array [0..7] of Char;
end;
Interface_Info = Record
iiFlags : u_Long;
iiAddress : SockAddr_Gen;
iiBroadcastAddress : SockAddr_Gen;
iiNetmask : SockAddr_Gen;
end;
tNetworkInterface = Record
ComputerName : String;
AddrIP : String;
SubnetMask : String;
AddrNet : String;
AddrLimitedBroadcast : String;
AddrDirectedBroadcast : String;
IsInterfaceUp : Boolean;
BroadcastSupport : Boolean;
IsLoopback : Boolean;
end;
tNetworkInterfaceList = Array of tNetworkInterface;
Function WSAIoctl (aSocket : TSocket;
aCommand : DWord;
lpInBuffer : PChar;
dwInBufferLen : DWord;
lpOutBuffer : PChar;
dwOutBufferLen : DWord;
lpdwOutBytesReturned : LPDWord;
lpOverLapped : Pointer;
lpOverLappedRoutine : Pointer) : Integer; stdcall; external 'WS2_32.DLL';
Function GetNetworkInterfaces (Var aNetworkInterfaceList : tNetworkInterfaceList): Boolean;
Implementation
Function GetNetworkInterfaces (Var aNetworkInterfaceList : tNetworkInterfaceList): Boolean;
// Returns a complete list the of available network interfaces on a system (IPv4)
// Copyright by Dr. Jan Schulz, 23-26th March 2007
// This version can be used for free and non-profit projects. In any other case get in contact
// Written with information retrieved from MSDN
// www.code10.net
Var aSocket : TSocket;
aWSADataRecord : WSAData;
NoOfInterfaces : Integer;
NoOfBytesReturned : u_Long;
InterfaceFlags : u_Long;
NameLength : DWord;
pAddrIP : SockAddr_In;
pAddrSubnetMask : SockAddr_In;
pAddrBroadcast : Sockaddr_In;
pIPString : PChar;
pSubnetMaskString : PChar;
pLimBroadcastString : PChar;
pNetAddrString : PChar;
pDirBroadcastString : PChar;
DirBroadcastDummy : In_Addr;
NetAddrDummy : In_Addr;
Buffer : Array [0..30] of Interface_Info;
i : Integer;
Begin
Result := False;
SetLength (aNetworkInterfaceList, 0);
// Startup of old the WinSock
// WSAStartup ($0101, aWSADataRecord);
// Startup of WinSock2
WSAStartup(MAKEWORD(2, 0), aWSADataRecord);
// Open a socket
aSocket := Socket (AF_INET, SOCK_STREAM, 0);
// If impossible to open a socket, not worthy to go any further
If (aSocket = INVALID_SOCKET) THen Exit;
Try
If WSAIoCtl (aSocket, SIO_GET_INTERFACE_LIST, NIL, 0,
#Buffer, 1024, #NoOfBytesReturned, NIL, NIL) <> SOCKET_ERROR THen
Begin
NoOfInterfaces := NoOfBytesReturned Div SizeOf (Interface_Info);
SetLength (aNetworkInterfaceList, NoOfInterfaces);
// For each of the identified interfaces get:
For i := 0 to NoOfInterfaces - 1 do
Begin
With aNetworkInterfaceList[i] do
Begin
// Get the name of the machine
NameLength := MAX_COMPUTERNAME_LENGTH + 1;
SetLength (ComputerName, NameLength) ;
If Not Windows.GetComputerName (PChar (Computername), NameLength) THen ComputerName := '';
// Get the IP address
pAddrIP := Buffer[i].iiAddress.AddressIn;
pIPString := inet_ntoa (pAddrIP.Sin_Addr);
AddrIP := pIPString;
// Get the subnet mask
pAddrSubnetMask := Buffer[i].iiNetMask.AddressIn;
pSubnetMaskString := inet_ntoa (pAddrSubnetMask.Sin_Addr);
SubnetMask := pSubnetMaskString;
// Get the limited broadcast address
pAddrBroadcast := Buffer[i].iiBroadCastAddress.AddressIn;
pLimBroadcastString := inet_ntoa (pAddrBroadcast.Sin_Addr);
AddrLimitedBroadcast := pLimBroadcastString;
// Calculate the net and the directed broadcast address
NetAddrDummy.S_addr := Buffer[i].iiAddress.AddressIn.Sin_Addr.S_Addr;
NetAddrDummy.S_addr := NetAddrDummy.S_addr And Buffer[i].iiNetMask.AddressIn.Sin_Addr.S_Addr;
DirBroadcastDummy.S_addr := NetAddrDummy.S_addr Or Not Buffer[i].iiNetMask.AddressIn.Sin_Addr.S_Addr;
pNetAddrString := inet_ntoa ((NetAddrDummy));
AddrNet := pNetAddrString;
pDirBroadcastString := inet_ntoa ((DirBroadcastDummy));
AddrDirectedBroadcast := pDirBroadcastString;
// From the evaluation of the Flags we receive more information
InterfaceFlags := Buffer[i].iiFlags;
// Is the network interface up or down ?
If (InterfaceFlags And IFF_UP) = IFF_UP THen IsInterfaceUp := True
Else IsInterfaceUp := False;
// Does the network interface support limited broadcasts ?
If (InterfaceFlags And IFF_BROADCAST) = IFF_BROADCAST THen BroadcastSupport := True
Else BroadcastSupport := False;
// Is the network interface a loopback interface ?
If (InterfaceFlags And IFF_LOOPBACK) = IFF_LOOPBACK THen IsLoopback := True
Else IsLoopback := False;
end;
end;
end;
Except
Result := False;
end;
// Cleanup the mess
CloseSocket (aSocket);
WSACleanUp;
Result := True;
end;
end.
Example call:
uses USock;
Procedure TForm1.Button1Click(Sender: TObject);
Var i : Integer;
aNetInterfaceList : tNetworkInterfaceList;
Begin
If (GetNetworkInterfaces (aNetInterfaceList)) THen
Begin
Memo1.Clear;
Memo1.Lines.Add (DateTimeToStr (Now)+ ' : ');
For i := 0 to High (aNetInterfaceList) do
Begin
Memo1.Lines.Add ('');
Memo1.Lines.Add ('# : ' + IntToStr(i));
Memo1.Lines.Add ('Name : ' + aNetInterfaceList[i].ComputerName);
Memo1.Lines.Add ('IP-Address : ' + aNetInterfaceList[i].AddrIP);
Memo1.Lines.Add ('Subnet mask : ' + aNetInterfaceList[i].SubnetMask);
Memo1.Lines.Add ('Net address : ' + aNetInterfaceList[i].AddrNet);
Memo1.Lines.Add ('Limited broadcast address : ' + aNetInterfaceList[i].AddrLimitedBroadcast);
Memo1.Lines.Add ('Directed Broadcast address : ' + aNetInterfaceList[i].AddrDirectedBroadcast);
Memo1.Lines.Add ('Interface up : ' + BoolToStr (aNetInterfaceList[i].IsInterfaceUp, True));
Memo1.Lines.Add ('Broadcast supported : ' + BoolToStr (aNetInterfaceList[i].BroadcastSupport, True));
Memo1.Lines.Add ('Loopback interface : ' + BoolToStr (aNetInterfaceList[i].IsLoopback, True));
Memo1.Lines.Add ('');
end;
end;
end;
The code apparently works, however it only return one network interface, the loopback (127.0.0.0), and it should return my network private interface also.
On this part of the code it always return only one interface available:
NoOfInterfaces := NoOfBytesReturned Div SizeOf (Interface_Info);
To work on XE2 I had to change the string used (AnsiString).
I have also tried using Winsock2 unit, and also tried using IdWinSock2 and the API calls from there.
On all cases the APIs worked and returned only the loopback interface.
Using another utility written on delphi I could get a this list, and the local IP 192.168.0.112 got listed, however this source code is not easy to use.
My question is: what is wrong?
Following Remy Lebeau sugestion and help documenting this thread I found this source code in delphi, tested with XP and W7, that brings the information using GetAdaptersInfo().
Credits to Brad Prendergast original post updated by Markus Humm final version
I have added the subnet mask reporting to make clear to newbies like me where the information is stored:
uses IpHlpApi, IpTypes;
procedure RetrieveLocalAdapterInformation(strings: TStrings);
var
pAdapterInfo, pTempAdapterInfo: PIP_ADAPTER_INFO;
AdapterInfo: IP_ADAPTER_INFO;
BufLen: DWORD;
Status: DWORD;
strMAC: String;
i: Integer;
begin
strings.Clear;
BufLen:= sizeof(AdapterInfo);
pAdapterInfo:= #AdapterInfo;
Status:= GetAdaptersInfo(nil, BufLen);
pAdapterInfo:= AllocMem(BufLen);
try
Status:= GetAdaptersInfo(pAdapterInfo, BufLen);
if (Status <> ERROR_SUCCESS) then
begin
case Status of
ERROR_NOT_SUPPORTED:
strings.Add('GetAdaptersInfo is not supported by the operating ' +
'system running on the local computer.');
ERROR_NO_DATA:
strings.Add('No network adapter on the local computer.');
else
strings.Add('GetAdaptersInfo failed with error #' + IntToStr(Status));
end;
Dispose(pAdapterInfo);
Exit;
end;
while (pAdapterInfo <> nil) do
begin
strings.Add('Description: ' + pAdapterInfo^.Description);
strings.Add('Name: ' + pAdapterInfo^.AdapterName);
strMAC := '';
for I := 0 to pAdapterInfo^.AddressLength - 1 do
strMAC := strMAC + '-' + IntToHex(pAdapterInfo^.Address[I], 2);
Delete(strMAC, 1, 1);
strings.Add('MAC address: ' + strMAC);
strings.Add('IP address: ' + pAdapterInfo^.IpAddressList.IpAddress.S);
strings.Add('IP subnet mask: ' + pAdapterInfo^.IpAddressList.IpMask.S);
strings.Add('Gateway: ' + pAdapterInfo^.GatewayList.IpAddress.S);
strings.Add('DHCP enabled: ' + IntTOStr(pAdapterInfo^.DhcpEnabled));
strings.Add('DHCP: ' + pAdapterInfo^.DhcpServer.IpAddress.S);
strings.Add('Have WINS: ' + BoolToStr(pAdapterInfo^.HaveWins,True));
strings.Add('Primary WINS: ' + pAdapterInfo^.PrimaryWinsServer.IpAddress.S);
strings.Add('Secondary WINS: ' + pAdapterInfo^.SecondaryWinsServer.IpAddress.S);
pTempAdapterInfo := pAdapterInfo;
pAdapterInfo:= pAdapterInfo^.Next;
if assigned(pAdapterInfo) then Dispose(pTempAdapterInfo);
end;
finally
Dispose(pAdapterInfo);
end;
end;
Jan Schulz's code works fine when properly converted to unicode-friendly Delphi.
I've done some corrections:
As TOndrej has pointed, char must be converted to AnsiChar when needed. In this case, this only occurs in the Padding field of the SockAddr_Gen record, which was not only screwing the record, but also causing SizeOf(Interface_Info), and subsequently NoOfInterfaces, to return a wrong result. Since it's not really a character, it is better to define it as a byte.
Dropped PChars used to hold results of inet_ntoa calls, and assigning TNetworkInterface string fields directly.
Strings in TNetworkInterface are fine, because they are not passed to any api calls. Also, ComputerName is passed to GetComputerName api, which expects a PWideChar/PChar.
Unit USock;
Interface
Uses Windows, Winsock;
{ Unit to identify the network interfaces
This code requires at least Win98/ME/2K, 95 OSR 2 or NT service pack #3
as WinSock 2 is used (WS2_32.DLL) }
// Constants found in manual on non-officially documented M$ Winsock functions
Const SIO_GET_INTERFACE_LIST = $4004747F;
IFF_UP = $00000001;
IFF_BROADCAST = $00000002;
IFF_LOOPBACK = $00000004;
IFF_POINTTOPOINT = $00000008;
IFF_MULTICAST = $00000010;
Type SockAddr_Gen = Packed Record
AddressIn : SockAddr_In;
Padding : Packed Array [0..7] of Byte;
end;
Interface_Info = Record
iiFlags : u_Long;
iiAddress : SockAddr_Gen;
iiBroadcastAddress : SockAddr_Gen;
iiNetmask : SockAddr_Gen;
end;
tNetworkInterface = Record
ComputerName : String;
AddrIP : String;
SubnetMask : String;
AddrNet : String;
AddrLimitedBroadcast : String;
AddrDirectedBroadcast : String;
IsInterfaceUp : Boolean;
BroadcastSupport : Boolean;
IsLoopback : Boolean;
end;
tNetworkInterfaceList = Array of tNetworkInterface;
Function WSAIoctl (aSocket : TSocket;
aCommand : DWord;
lpInBuffer : Pointer;
dwInBufferLen : DWord;
lpOutBuffer : Pointer;
dwOutBufferLen : DWord;
lpdwOutBytesReturned : LPDWord;
lpOverLapped : Pointer;
lpOverLappedRoutine : Pointer) : Integer; stdcall; external 'WS2_32.DLL';
Function GetNetworkInterfaces (Var aNetworkInterfaceList : tNetworkInterfaceList): Boolean;
implementation
Function GetNetworkInterfaces (Var aNetworkInterfaceList : tNetworkInterfaceList): Boolean;
// Returns a complete list the of available network interfaces on a system (IPv4)
// Copyright by Dr. Jan Schulz, 23-26th March 2007
// This version can be used for free and non-profit projects. In any other case get in contact
// Written with information retrieved from MSDN
// www.code10.net
Var aSocket : TSocket;
aWSADataRecord : WSAData;
NoOfInterfaces : Integer;
NoOfBytesReturned : u_Long;
InterfaceFlags : u_Long;
NameLength : DWord;
pAddrIP : SockAddr_In;
pAddrSubnetMask : SockAddr_In;
pAddrBroadcast : Sockaddr_In;
DirBroadcastDummy : In_Addr;
NetAddrDummy : In_Addr;
Buffer : Array [0..30] of Interface_Info;
i : Integer;
Begin
Result := False;
SetLength (aNetworkInterfaceList, 0);
// Startup of old the WinSock
// WSAStartup ($0101, aWSADataRecord);
// Startup of WinSock2
WSAStartup(MAKEWORD(2, 0), aWSADataRecord);
// Open a socket
aSocket := Socket (AF_INET, SOCK_STREAM, 0);
// If impossible to open a socket, not worthy to go any further
If (aSocket = INVALID_SOCKET) THen Exit;
Try
If WSAIoCtl (aSocket, SIO_GET_INTERFACE_LIST, NIL, 0,
#Buffer, 1024, #NoOfBytesReturned, NIL, NIL) <> SOCKET_ERROR THen
Begin
NoOfInterfaces := NoOfBytesReturned Div SizeOf (Interface_Info);
SetLength (aNetworkInterfaceList, NoOfInterfaces);
// For each of the identified interfaces get:
For i := 0 to NoOfInterfaces - 1 do
Begin
With aNetworkInterfaceList[i] do
Begin
// Get the name of the machine
NameLength := MAX_COMPUTERNAME_LENGTH + 1;
SetLength (ComputerName, NameLength) ;
If Not GetComputerName (PChar (Computername), NameLength) THen ComputerName := '';
// Get the IP address
pAddrIP := Buffer[i].iiAddress.AddressIn;
AddrIP := string(inet_ntoa (pAddrIP.Sin_Addr));
// Get the subnet mask
pAddrSubnetMask := Buffer[i].iiNetMask.AddressIn;
SubnetMask := string(inet_ntoa (pAddrSubnetMask.Sin_Addr));
// Get the limited broadcast address
pAddrBroadcast := Buffer[i].iiBroadCastAddress.AddressIn;
AddrLimitedBroadcast := string(inet_ntoa (pAddrBroadcast.Sin_Addr));
// Calculate the net and the directed broadcast address
NetAddrDummy.S_addr := Buffer[i].iiAddress.AddressIn.Sin_Addr.S_Addr;
NetAddrDummy.S_addr := NetAddrDummy.S_addr And Buffer[i].iiNetMask.AddressIn.Sin_Addr.S_Addr;
DirBroadcastDummy.S_addr := NetAddrDummy.S_addr Or Not Buffer[i].iiNetMask.AddressIn.Sin_Addr.S_Addr;
AddrNet := string(inet_ntoa ((NetAddrDummy)));
AddrDirectedBroadcast := string(inet_ntoa ((DirBroadcastDummy)));
// From the evaluation of the Flags we receive more information
InterfaceFlags := Buffer[i].iiFlags;
// Is the network interface up or down ?
If (InterfaceFlags And IFF_UP) = IFF_UP THen IsInterfaceUp := True
Else IsInterfaceUp := False;
// Does the network interface support limited broadcasts ?
If (InterfaceFlags And IFF_BROADCAST) = IFF_BROADCAST THen BroadcastSupport := True
Else BroadcastSupport := False;
// Is the network interface a loopback interface ?
If (InterfaceFlags And IFF_LOOPBACK) = IFF_LOOPBACK THen IsLoopback := True
Else IsLoopback := False;
end;
end;
end;
Except
//Result := False;
end;
// Cleanup the mess
CloseSocket (aSocket);
WSACleanUp;
Result := True;
end;
end.
For what its worth, if you need the broadcast IP for a specific adapter, you can use SIO_GET_BROADCAST_ADDRESS instead.
With that said, a non-Winsock solution would be to use GetAdaptersInfo() or GetAdaptersAddresses() instead. This way, you don't have to create a SOCKET to get the info, you can enumerate both IPv4 and IPv6 adapters at the same time, as well as other adapters that Winsock does not recognize.
For GetAdaptersInfo(), the IP_ADAPTER_INFO.IpAddressList list contains IPv4 IPs and Subnet masks (on XP+, uni-directional adapters are included in the output, but you can use GetUniDirectionalAdapterInfo() to filter them out).
For GetAdaptersAddresses(), the IP_ADAPTER_ADDRESSES.FirstUnicastAddress list contains both IPv4 and IPv6 IPs, and IPv4 Subnet masks on Vista+. For XP and earlier, you can use GetIpAddrTable() to retrieve IPv4 Subnet masks and match them to the IPv4 IPs from GetAdaptersAddresses().
Once you have an IPv4 IP and Subnet mask, calculating its Broadcast IP is very simple:
BroadcastIP := (IP and SubnetMask) or (not SubnetMask);
As you have changed String declarations to AnsiString, also change Char declarations to AnsiChar.
Update for Delphi 10.2 Tokyo supported.
procedure TForm4.RetrieveLocalAdapterInformation;
var
pAdapterInfo: PIP_ADAPTER_INFO;
AdapterInfo: IP_ADAPTER_INFO;
BufLen: DWORD;
Status: DWORD;
strMAC: String;
i: Integer;
strings: TStrings;
begin
strings:= Tstringlist.create;
strings.Clear;
BufLen:= sizeof(AdapterInfo);
pAdapterInfo:= #AdapterInfo;
Status:= GetAdaptersInfo(nil, BufLen);
pAdapterInfo:= AllocMem(BufLen);
try
Status:= GetAdaptersInfo(pAdapterInfo, BufLen);
if (Status <> ERROR_SUCCESS) then
begin
case Status of
ERROR_NOT_SUPPORTED:
strings.Add('GetAdaptersInfo is not supported by the operating ' +
'system running on the local computer.');
ERROR_NO_DATA:
strings.Add('No network adapter on the local computer.');
else
strings.Add('GetAdaptersInfo failed with error #' + IntToStr(Status));
end;
Dispose(pAdapterInfo);
Exit;
end;
while (pAdapterInfo <> nil) do
begin
memo1.Lines.Add('');
memo1.Lines.Add('Description: ------------------------' + pAdapterInfo^.Description);
memo1.Lines.Add('Name: ' + pAdapterInfo^.AdapterName);
strMAC := '';
for I := 0 to pAdapterInfo^.AddressLength - 1 do
strMAC := strMAC + '-' + IntToHex(pAdapterInfo^.Address[I], 2);
Delete(strMAC, 1, 1);
memo1.Lines.Add('MAC address: ' + strMAC);
memo1.Lines.Add('IP address: ' + pAdapterInfo^.IpAddressList.IpAddress.S);
memo1.Lines.Add('IP subnet mask: ' + pAdapterInfo^.IpAddressList.IpMask.S);
memo1.Lines.Add('Gateway: ' + pAdapterInfo^.GatewayList.IpAddress.S);
memo1.Lines.Add('DHCP enabled: ' + IntTOStr(pAdapterInfo^.DhcpEnabled));
memo1.Lines.Add('DHCP: ' + pAdapterInfo^.DhcpServer.IpAddress.S);
memo1.Lines.Add('Have WINS: ' + BoolToStr(pAdapterInfo^.HaveWins,True));
memo1.Lines.Add('Primary WINS: ' + pAdapterInfo^.PrimaryWinsServer.IpAddress.S);
memo1.Lines.Add('Secondary WINS: ' + pAdapterInfo^.SecondaryWinsServer.IpAddress.S);
pAdapterInfo:= pAdapterInfo^.Next;
end;
finally
Dispose(pAdapterInfo);
strings.free;
end;
end;
procedure TForm4.Button1Click(Sender: TObject);
begin
RetrieveLocalAdapterInformation//
end;
Updated to fix overwrite of pAdapterInfo pointer while looping the linked list
procedure TForm4.RetrieveLocalAdapterInformation;
var
pAdapterInfo: PIP_ADAPTER_INFO; // Linked list of adapters
pAdapter: PIP_ADAPTER_INFO; // Single adapter
BufLen: DWORD;
Status: DWORD;
strMAC: String;
i: Integer;
begin
memo1.Clear;
// Make an initial call to GetAdaptersInfo to get the necessary size
// of the linked list
GetAdaptersInfo(nil, BufLen);
pAdapterInfo := AllocMem(BufLen);
try
Status := GetAdaptersInfo(pAdapterInfo, BufLen);
if (Status <> ERROR_SUCCESS) then
begin
case Status of
ERROR_NOT_SUPPORTED:
memo1.Lines.Add('GetAdaptersInfo is not supported by the operating ' +
'system running on the local computer.');
ERROR_NO_DATA:
memo1.Lines.Add('No network adapter on the local computer.');
else
memo1.Lines.Add('GetAdaptersInfo failed with error #' + IntToStr(Status));
end;
Exit;
end;
pAdapter := pAdapterInfo;
while (pAdapter <> nil) do
begin
memo1.Lines.Add('');
memo1.Lines.Add('Description: ------------------------' + pAdapter^.Description);
memo1.Lines.Add('Name: ' + pAdapter^.AdapterName);
strMAC := '';
for I := 0 to pAdapter^.AddressLength - 1 do
strMAC := strMAC + '-' + IntToHex(pAdapter^.Address[I], 2);
Delete(strMAC, 1, 1);
memo1.Lines.Add('MAC address: ' + strMAC);
memo1.Lines.Add('IP address: ' + pAdapter^.IpAddressList.IpAddress.S);
memo1.Lines.Add('IP subnet mask: ' + pAdapter^.IpAddressList.IpMask.S);
memo1.Lines.Add('Gateway: ' + pAdapter^.GatewayList.IpAddress.S);
memo1.Lines.Add('DHCP enabled: ' + IntToStr(pAdapter^.DhcpEnabled));
memo1.Lines.Add('DHCP: ' + pAdapter^.DhcpServer.IpAddress.S);
memo1.Lines.Add('Have WINS: ' + BoolToStr(pAdapter^.HaveWins,True));
memo1.Lines.Add('Primary WINS: ' + pAdapter^.PrimaryWinsServer.IpAddress.S);
memo1.Lines.Add('Secondary WINS: ' + pAdapter^.SecondaryWinsServer.IpAddress.S);
pAdapter := pAdapter^.Next;
end;
finally
FreeMem(pAdapterInfo);
end;
end
;
Related
I'm trying to send a Wake-On-Lan packet to a PC in my Office using an application on my Mobile device at home.
This code works for me when I'm connected to the Office's network:
procedure WakeOnLan(const AMacAddress: string);
type
TMacAddress = array [1..6] of Byte;
TWakeRecord = packed record
Waker : TMACAddress;
MAC : array [0..15] of TMacAddress;
end;
var
I : Integer;
WR : TWakeRecord;
MacAddress : TMacAddress;
UDPClient : TIdUDPClient;
sData : string;
begin
FillChar(MacAddress, SizeOf(TMacAddress), 0);
sData := Trim(AMacAddress);
if Length(sData) = 17 then begin
for I := 1 to 6 do begin
MacAddress[I] := StrToIntDef('$' + Copy(sData, 1, 2), 0);
sData := Copy(sData, 4, 17);
end;
end;
for I := 1 to 6 do WR.Waker[I] := $FF;
for I := 0 to 15 do WR.MAC[I] := MacAddress;
UDPClient := TIdUDPClient.Create(nil);
try
UDPClient.Host := '255.255.255.255';
UDPClient.Port := 32767;
UDPClient.BroadCastEnabled := True;
UDPClient.Broadcast(RawToBytes(WR, SizeOf(TWakeRecord)), 7);
UDPClient.SendBuffer(RawToBytes(WR, SizeOf(TWakeRecord)));
UDPClient.BroadcastEnabled := False;
finally
UDPClient.Free;
end;
end;
But, if I'm connected to my Home network, the code does not work.
How do I connect to the Office Modem/PC before sending the Magic Packets?
Do I need to use TSocket instead of TIdUDPClient?
I am trying to "reproduce" netstat for Delphi and came across some questions:
This is my code so far:
program NetstatExample;
{$APPTYPE CONSOLE}
uses
Windows,
Winsock2;
const
TCP_TABLE_OWNER_PID_ALL = 5;
ANY_SIZE = 1;
type
TCP_TABLE_CLASS = Integer;
in6_addr = record
case Integer of
0: (Byte: array [0..15] of u_char);
1: (Word: array[0..7] of u_short);
2: (s6_bytes: array [0..15] of u_char);
3: (s6_addr: array [0..15] of u_char);
4: (s6_words: array[0..7] of u_short);
end;
TIn6Addr = in6_addr;
PIn6Addr = ^in6_addr;
PTMib_TCP6Row = ^TMib_TCP6Row;
TMib_TCP6Row = packed record
LocalAddr : IN6_ADDR ;
dwLocalScopeId : DWORD ;
dwLocalPort : DWORD ;
RemoteAddr : IN6_ADDR ;
dwRemoteScopeId : DWORD ;
dwRemotePort : DWORD ;
dwState : DWORD ;
dwProcessId : DWORD ;
end;
PTMIB_TCP6TABLE = ^TMIB_TCP6TABLE;
TMIB_TCP6TABLE = record
dwNumEntries : DWORD;
Table: array[0..ANY_SIZE - 1] of TMib_TCP6Row;
end;
var
GetExtendedTcpTable : function (pTcpTable: Pointer; dwSize: PDWORD; bOrder: BOOL; lAf: ULONG; TableClass: TCP_TABLE_CLASS; Reserved: ULONG): DWord; stdcall;
iphHandle : HMODULE;
TableSize : DWORD;
TCPTable : PTMIB_TCP6TABLE;
I : Integer;
begin
try
iphHandle := LoadLibrary('iphlpapi.dll');
if iphHandle = 0 then Exit;
GetExtendedTcpTable := GetProcAddress(iphHandle, 'GetExtendedTcpTable');
if #GetExtendedTcpTable = NIL then Exit;
if GetExtendedTcpTable(nil, #TableSize, False, AF_INET6, TCP_TABLE_OWNER_PID_ALL, 0) <> ERROR_INSUFFICIENT_BUFFER then Exit;
GetMem(TCPTable, TableSize);
try
if GetExtendedTcpTable(TCPTable, #TableSize, False, AF_INET6, TCP_TABLE_OWNER_PID_ALL, 0) <> NO_ERROR then Exit;
for I := 0 to TCPTable^.dwNumEntries - 1 do
begin
// Detect AF_INET6 and/or AF_INET4 family
// Display Remote Address in proper format for each family - XP compatible?!
end;
finally
FreeMem(TCPTable, TableSize);
end;
finally
readln;
end;
end.
Here, I am using AF_INET6 so I can also get the ipv6 connections as well.
Questions are:
How can I safely distinguish ipv4 from ipv6?
How can I display the remote address in the proper format for both families and still make it XP compatible as well? (InetNtop did not yet exist in Windows XP)
Q1: Your GetExtendedTcpTable call returns addresses in the specified address family, ie. if you pass it AF_INET6 it returns IPv6 addresses only, if you pass it AF_INET it returns IPv4 addresses only. So there is no need to distinguish, you just cast the returned table to the right table type, as described in the Remarks section of the documentation (linked above).
Q2: Here's my implementation (I hope it's correct):
function AddrStr(Addr: Cardinal): string;
var
P: PAnsiChar;
begin
P := inet_ntoa(PInAddr(#Addr)^);
SetString(Result, P, StrLen(P));
end;
function Addr6Str(const Addr: IN6_ADDR): string;
var
I: Integer;
begin
Result := '';
for I := 0 to 7 do
begin
if Result <> '' then
Result := Result + ':';
Result := Result + LowerCase(IntToHex(ntohs(Addr.Word[I]), 1));
end;
Result := '[' + Result + ']';
end;
...or have a look at Free Pascal's Sockets unit, NetAddrToStr and NetAddrToStr6.
Say I have two NIC or adapter card on my system and also I found their IP address through the following code:
procedure TForm4.RetrieveLocalAdapterInformation(strings: Tmemo);
var
pAdapterInfo, pTempAdapterInfo: PIP_ADAPTER_INFO;
AdapterInfo: IP_ADAPTER_INFO;
BufLen: DWORD;
Status: DWORD;
strMAC: String;
i: Integer;
begin
strings.Clear;
BufLen:= sizeof(AdapterInfo);
pAdapterInfo:= #AdapterInfo;
Status:= GetAdaptersInfo(nil, BufLen);
pAdapterInfo:= AllocMem(BufLen);
try
Status:= GetAdaptersInfo(pAdapterInfo, BufLen);
if (Status <> ERROR_SUCCESS) then
begin
case Status of
ERROR_NOT_SUPPORTED:
strings.lines.Add('GetAdaptersInfo is not supported by the operating ' +
'system running on the local computer.');
ERROR_NO_DATA:
strings.lines.Add('No network adapter on the local computer.');
else
strings.Lines.Add('GetAdaptersInfo failed with error #' + IntToStr(Status));
end;
Dispose(pAdapterInfo);
Exit;
end;
while (pAdapterInfo <> nil) do
begin
strings.Lines.Add('Description: ' + pAdapterInfo^.Description);
strings.lines.Add('Name: ' + pAdapterInfo^.AdapterName);
strMAC := '';
for I := 0 to pAdapterInfo^.AddressLength - 1 do
strMAC := strMAC + '-' + IntToHex(pAdapterInfo^.Address[I], 2);
Delete(strMAC, 1, 1);
strings.lines.Add('MAC address: ' + strMAC);
strings.lines.Add('IP address: ' + pAdapterInfo^.IpAddressList.IpAddress.S);
strings.lines.Add('IP subnet mask: ' + pAdapterInfo^.IpAddressList.IpMask.S);
strings.lines.Add('Gateway: ' + pAdapterInfo^.GatewayList.IpAddress.S);
strings.lines.Add('DHCP enabled: ' + IntTOStr(pAdapterInfo^.DhcpEnabled));
strings.lines.Add('DHCP: ' + pAdapterInfo^.DhcpServer.IpAddress.S);
strings.lines.Add('Have WINS: ' + BoolToStr(pAdapterInfo^.HaveWins,True));
strings.lines.Add('Primary WINS: ' + pAdapterInfo^.PrimaryWinsServer.IpAddress.S);
strings.lines.Add('Secondary WINS: ' + pAdapterInfo^.SecondaryWinsServer.IpAddress.S);
pTempAdapterInfo := pAdapterInfo;
pAdapterInfo:= pAdapterInfo^.Next;
if assigned(pAdapterInfo) then Dispose(pTempAdapterInfo);
end;
finally
Dispose(pAdapterInfo);
end;
end;
How do I connect to or direct all of my network traffic through specific NIC or network adapter card?
I was able to accomplish this with the following code on Windows 7, but this code won't run on Windows 10. It keeps raising Access Denied message when the program is run as a user but not when it is run as administrator. However, as administrator my program won't run normally but only as a background process on Windows 10....
procedure TDXCommdlg.GetConnectionList(Strings,IdList: TStrings);
var
pEnum: IEnumVariant;
vNetCon: OleVARIANT;
dwRetrieved: Cardinal;
pUser: NETCONLib_TLB.PUserType1;
NetCon : INetConnection;
begin
Strings.Clear;
IdList.Clear;
pEnum := (NetSharingManager1.EnumEveryConnection._NewEnum as IEnumVariant);
while (pEnum.Next(1, vNetCon, dwRetrieved) = S_OK) do
begin
(IUnknown(vNetCon) as INetConnection).GetProperties(pUser);
NetCon := (IUnknown(vNetCon) as INetConnection);
if (pUser.Status in [NCS_CONNECTED,NCS_CONNECTING])//remove if you want disabled NIC cards also
and (pUser.MediaType in [NCM_LAN,NCM_SHAREDACCESSHOST_LAN,NCM_ISDN] )
and (GetMacAddress(GuidToString(pUser.guidId))<>'' ) then
begin
//we only want valid network cards that are enabled
Strings.Add(pUser.pszwName);
IdList.Add(GuidToString(pUser.guidId));
end;
end;
end;
function TDXCommdlg.GetMacAddress(CardID: string): String;
var
Reg: TRegistry;
KeyValues: TSTringList;
i: integer;
CardInstanceID,CardAddress: string;
begin
Result := '';
Reg := TRegistry.Create;
KeyValues := TStringList.Create;
try
Reg.RootKey:=HKEY_LOCAL_MACHINE;
if Reg.OpenKey(MacLocation,false) then
begin
Reg.GetKeyNames(KeyValues);
Reg.CloseKey;
for i := 0 to KeyValues.Count-1 do
if reg.OpenKey(MacLocation+'\'+KeyValues[i],false) then
begin
CardInstanceID := Reg.ReadString('NetCfgInstanceId');
CardAddress := Reg.ReadString('NetworkAddress');
Reg.CloseKey;
if CardInstanceID = CardId then
begin
if CardAddress='' then CardAddress := 'Hardware';
Result := CardAddress;
break;
end;
end;
end;
finally
Reg.Free;
KeyValues.Free;
end;
end;
procedure TDXCommdlg.ResetNIC(const aConnection: string);
var
pEnum: IEnumVariant;
vNetCon: OleVARIANT;
dwRetrieved: Cardinal;
pUser: NETCONLib_TLB.PUserType1;
begin
enabled := false;
try
pEnum := (NetSharingManager1.EnumEveryConnection._NewEnum as IEnumVariant);
while (pEnum.Next(1, vNetCon, dwRetrieved) = S_OK) do
begin
(IUnknown(vNetCon) as INetConnection).GetProperties(pUser);
if pUser.pszwName = aConnection then
begin
(IUnknown(vNetCon) as INetConnection).Disconnect;
(IUnknown(vNetCon) as INetConnection).Connect;
sleep(2000);
break;
end;
end;
finally
enabled := true;
end;
end;
UPDATE
Access Denied is raised by the following line from above and then this procedure quits. It doesn't go any further.
pEnum := (NetSharingManager1.EnumEveryConnection._NewEnum as IEnumVariant);
It sounds as though the library that you use requires elevated rights. Nothing significant has changed in Windows 10 regarding UAC. If your program is running elevated it will succeed. It fails when it is not elevated. So your problem would appear to be that you are failing to execute elevated.
Since your program requires elevation make sure that you manifest that. Add the requireAdministrator option to your application manifest.
You request write access to HKLM which will not be granted for standard user. Call OpenKeyReadOnly rather than OpenKey. There's no point asking for write access when you are only reading.
I'm trying to auto-detect and report on IPv6 availability for Delphi socket programming.
For "localhost", the following code is returning "1700::" for IPv6 and "2.0.0.0" for IPv4. This address is for simple testing, and should be returning ::1 or 127.0.0.1 for my machine. I'm not getting any socket API errors in the calling code, so I'm trying to figure out what I'm doing wrong when attempting to convert "localhost" to the various IP addresses. I'm using Indy headers.
The type declarations are:
TLSocketAddress = record
case Integer of
AF_INET:
(IPv4: TSockAddrIn);
AF_INET6:
(IPv6: TSockAddrIn6);
end;
TLIpInfo = record
private
function GetFamily: TProtocolFamily;
public
Address : TLSocketAddress;
HostName: string;
Machine: string;
IP6 : string;
IP4 : string;
Port : integer;
Error : integer;
property Family : TProtocolFamily read GetFamily;
end;
and the retrieval routine is:
function GetIpInfo(
const AHostName : string;
const APort : integer
): TLIpInfo;
var
nameRet : PAnsiChar;
ptr : Pointer;
Hints : TAddrInfoW;
AddrInfo : PAddrInfoW;
NextInfo : PAddrInfoW;
RetVal : Integer;
ip,
machine : string;
namelen : integer;
begin
ZeroMemory(#Result, SizeOf(Result));
FillChar(Hints, SizeOf(Hints), 0);
Hints.ai_family := AF_UNSPEC;
AddrInfo := nil;
RetVal := GetAddrInfo(PWideChar(AHostName), nil, #Hints, #AddrInfo);
if RetVal = 0 then
try
Result.HostName := AHostName;
Result.Port := APort;
NextInfo := AddrInfo;
while NextInfo <> nil do
begin
if (NextInfo.ai_family = AF_INET) or (NextInfo.ai_family = AF_INET6) then
begin
if (Result.Machine = '') then
begin
SetLength(machine, NI_MAXHOST);
RetVal := GetNameInfo(NextInfo.ai_addr, NextInfo.ai_addrlen,
PChar(machine), NI_MAXHOST, nil, 0, 0);
if (RetVal <> 0) then
begin
NextInfo := NextInfo.ai_next;
continue;
end;
Result.Machine := PChar(machine);
end;
if NextInfo.ai_family = AF_INET then
begin
ptr := PSockAddrIn(NextInfo.ai_addr);
namelen := INET_ADDRSTRLEN;
SetLength(ip, namelen);
end
else
begin
ptr := PSockAddrIn6(NextInfo.ai_addr);
namelen := INET6_ADDRSTRLEN;
SetLength(ip, namelen);
end;
nameRet := inet_ntop(NextInfo.ai_family, ptr, PChar(ip), namelen);
if (nameRet = nil) then
begin
NextInfo := NextInfo.ai_next;
continue;
end;
if (NextInfo.ai_family = AF_INET6) then
Result.IP6 := PChar(ip)
else
Result.IP4 := PChar(ip);
end;
NextInfo := NextInfo.ai_next;
end;
finally
FreeAddrInfo(AddrInfo);
end;
end;
I know it may be too late for the author, but i struggled today with the same problem and noticed that you pass a pointer to the entire ADDRINFO structure to inet_ntop, however you should only be passing the pointer to the binary address.
So call to intet_ntop for IPv4 addresses should be:
inet_ntop(NextInfo.ai_family, #PSockAddrIn(NextInfo.ai_addr).sin_addr, PChar(ip), namelen)
and for IPv6 should be:
inet_ntop(NextInfo.ai_family, #PSockAddrIn6(NextInfo.ai_addr).sin6_addr, PChar(ip), namelen)
I am currently trying to develop an application for displaying IPv6 traffic. I am confused as to how to extract the site local and the link local addresses of the local machine . Any guidance would be appreciated.
The structure of the IPv6 packet in delphi i am using is :
type
PIPV6HeaderPtr = ^TIPV6Header;
TIPV6Header = packed record
ip6_flow : DWORD; // 4 bits = version #,// 8 bits = Trafic class,// 20 bits = flow label
ip6_len : Word;//Cardinal; // Payload length
//ip6_next : Cardinal; // Next Header
ip6_next : Byte; // Next Header
ip6_hops : Byte; // Hop Limit
h_source : IN6_ADDR;
h_dest : IN6_ADDR;
end;
//
// IPv6 extension header format
//
type
PIPV6EXTPTR = ^TIPV6EXT;
TIPV6EXT = packed record
ip6_next : Byte;
ip6_len : Byte;
ip6_data : array[0..1] of Byte;
End;
type
PIPV6EXT_FRAGPTR = ^TIPV6EXT_FRAG;
TIPV6EXT_FRAG = packed record
ip6_next : Byte;
ip6_reserved : Byte;
ip6_offlg : Word;
ip6_ident : DWORD;
End;
Thanks in advance.
See the following explanation of what site local addresses and link local addresses are and how they work:
IPv6 tutorial – Part 6: Site-local addresses and link-local addresses
You can use the Win32 API GetAdapterAddresses() function to get the local machine's IPv6 addresses.
I have found another method to get the addresses using WSAIoctl . I am adding my code below .
uses WinSock2; // Widely available on Net
function TForm1.GetIPUsingIoctlMethod(var sInt: string): Boolean;
var
s: TSocket;
wsaD: TWSADATA;
NumInterfaces: Integer;
BytesReturned, SetFlags: u_long;
pAddrInet: SOCKADDR_IN;
pAddrString: PCHAR;
PtrA: pointer;
Buffer: Array[0..20] Of INTERFACE_INFO_EX;
i: Integer;
Local_IpList : TStringList ;
addrList : LPSOCKET_ADDRESS_LIST ;
in6 : PSockAddr;
protoInfo : WSAProtocol_Info;
text : Array[1..46] Of Char;
Buffer1 : DWORD;
Str : String;
begin
result := False; // Initialize
sInt := '';
Try
WSAStartup($0101, wsaD); // Start WinSock
// You should normally check
// for errors here :)
{Create a WSA Socket}
//s := WSASocketA(AF_INET6,SOCK_STREAM, IPPROTO_IP, nil, 0, 0);
s:= Socket(AF_INET6,SOCK_STREAM,IPPROTO_IP);
//s := Socket(AF_INET6, SOCK_STREAM, 0); // Open a socket
if (s = INVALID_SOCKET) then exit;
try // Call WSAIoCtl
PtrA := #bytesReturned;
if (WSAIoCtl(s, SIO_ADDRESS_LIST_QUERY, nil, 0, #Buffer, SizeOf(Buffer), PtrA, nil, nil)<> SOCKET_ERROR)
then
begin // If ok, find out how
// many interfaces exist
Result := True;
addrList := LPSOCKET_ADDRESS_LIST(#Buffer);
DebugLog(' i = ' + IntToStr(addrList.iAddressCount),0);
// NumInterfaces := BytesReturned div SizeOf(INTERFACE_INFO);
Local_IpList := TStringList.Create ;
for i := 0 to addrList.iAddressCount - 1 do // For every interface
begin
If ( addrList.Address[i].lpSockaddr.sin_family = AF_Inet6) Then
Begin
in6 := PSockaddr(#addrList.Address[i].lpSockaddr);
Buffer1 := SizeOf(Text);
//protoInfo.
FillChar(Text,SizeOf(Text),#0);
If WSAAddressToString(addrList.Address[i].lpSockaddr,addrList.Address[i].iSockaddrLength,
nil,#text,Buffer1) <> 0 Then
Begin
debuglog('err1 = ' + SysErrorMessage(WSAGetLastError),0);
end;
Str := Text;
DebugLog(' Addr cnt =' + IntToStr(i) + ' = ' + Str,0);
Buffer1 := 0;
FillChar(Text,SizeOf(Text),#0);
//in6.
//DebugLog('ip = ' + );
//IN6_IS_ADDR_LINKLOCAL
end;
end;
end
Else
sInt := SysErrorMessage(WSAGetLastError);
except
end;
//
// Close sockets
//
CloseSocket(s);
WSACleanUp;
Except
End;
end;
debugLog is simply a method to write in a text file.