[fpc-pascal] How to list IP and MAC of network adapters on Windows?
Marco van de Voort
fpc at pascalprogramming.org
Fri Sep 10 12:19:19 CEST 2021
Op 10-9-2021 om 09:46 schreef Sven Barth via fpc-pascal:
> You can use the ipconfig command and parse its output (especially
> ipconfig /all).
Afaik netsh has more info.
I have several tests for this in Delphi, but they use the iphlp headers
that FPC doesn't have yet (a point on my todo list).
I was mainly looking for the core (IP + Mac) and jumbo frame status.
Some info can also be found in the wmi and registry, I attach the wmi
related units.
-------------- next part --------------
unit lstwmi;
interface
{$ifdef fpc}
{$mode delphi}
{$endif}
// example from MSDN Win32_NetworkAdapterConfiguration class.
// https://docs.microsoft.com/en-us/windows/win32/cimwin32prov/win32-networkadapterconfiguration
uses windows,variants,classes,sysutils,activex,comobj,wmiutil;
procedure PrintAll_NICAdapter_information(lines:tstrings);
implementation
Function GetMultiString_FromArray( ArrayString:OleVariant; separator:string):string;
begin
If varisnull ( ArrayString ) Then
result:= ''
else
result := OleVariantToText(arraystring); // arraystring.items[0]; // Join( ArrayString, Seprator )
end;
procedure PrintAll_NICAdapter_information(lines:tstrings);
procedure addifnonzero(const lab : string;vv:widestring);
//r value : string;
begin
// value:=vartostr(vv);
if trim(vv)<>'' then
lines.Add(lab+vv);
end;
var
objWMIService : OLEVariant;
colItems : OLEVariant;
colItem : OLEVariant;
strComputer : Widestring;
oEnum : oEnumIterator;
i : Integer;
strDefaultIPGateway,
strDefaultIPSubnet ,
strIPAddress,
strIPSecPermitUDPPorts,
strDNSDomainSuffixSearchOrder,
strIPSecPermitTCPPorts ,
strIPSecPermitIPProtocols,
strIPXFrameType,
strGatewayCostMetric,
strIPXNetworkNumber,
strDNSServerSearchOrder,
strIPSubnet: string;
v : olevariant;
Begin
strComputer := '.';
objWMIService := GetWMIObject('winmgmts:{impersonationLevel=impersonate}!\\'+strComputer+'\root\cimv2');
colItems := objWMIService.ExecQuery('Select * from Win32_NetworkAdapterConfiguration'); // 48 = wbemFlagReturnImmediately and wbemFlagForwardOnly
lines.add('ok');
//v:=GetWMIObject('Win32_NetworkAdapterConfiguration');
//v.SetPMTUDiscovery(winbool(1));
// vbscript FOR works with _NewEnum operator. FPC/Delphi is slightly more complicated, but we can stuff that in an iterator record so we can use FOR..IN
i:=0;
for colItem in oEnum.Enumerate(colItems) do
begin
i := i + 1;
lines.add('-----------------------------------');
lines.add('Win32_NetworkAdapterConfiguration instance: '+inttostr(i));
lines.add('-----------------------------------');
strDefaultIPGateway := GetMultiString_FromArray(ColItem.DefaultIPGateway,', ');
addifnonzero('MACAddress : '#9,vartostr(ColItem.MACAddress));
addifnonzero('Description : '#9,vartostr(ColItem.Description));
addifnonzero('DHCPEnabled : '#9,vartostr(ColItem.DHCPEnabled));
strIPAddress:=GetMultiString_FromArray(ColItem.IPAddress,', ');
addifnonzero('IPAddress : '#9,strIPAddress);
strIPSubnet:= GetMultiString_FromArray(ColItem.IPSubnet,', ');
addifnonzero('IPSubnet : '#9,strIPSubnet);
addifnonzero('IPConnectionMetric : '#9,vartostr(ColItem.IPConnectionMetric));
addifnonzero('DHCPLeaseExpires : '#9,vartostr(ColItem.DHCPLeaseExpires));
addifnonzero('DHCPLeaseObtained : '#9,vartostr(ColItem.DHCPLeaseObtained));
addifnonzero('DHCPServer : '#9,vartostr(ColItem.DHCPServer));
addifnonzero('DNSDomain : '#9,vartostr(ColItem.DNSDomain));
addifnonzero('IPEnabled : '#9,vartostr(ColItem.IPEnabled));
addifnonzero('DefaultIPGateway : '#9,strDefaultIPGateway);
strGatewayCostMetric := GetMultiString_FromArray(ColItem.GatewayCostMetric,', ');
addifnonzero('GatewayCostMetric : '#9,strGatewayCostMetric);
addifnonzero('IPFilterSecurityEnabled : '#9,vartostr(ColItem.IPFilterSecurityEnabled));
addifnonzero('IPPortSecurityEnabled : '#9,vartostr(ColItem.IPPortSecurityEnabled));
strDNSDomainSuffixSearchOrder := GetMultiString_FromArray(ColItem.DNSDomainSuffixSearchOrder,', ');
addifnonzero('DNSDomainSuffixSearchOrder : '#9,strDNSDomainSuffixSearchOrder);
addifnonzero('DNSEnabledForWINSResolution : '#9,vartostr(ColItem.DNSEnabledForWINSResolution));
addifnonzero('DNSHostName : '#9,vartostr(ColItem.DNSHostName));
strDNSServerSearchOrder := GetMultiString_FromArray(ColItem.DNSServerSearchOrder,', ');
addifnonzero('DNSServerSearchOrder : '#9,strDNSServerSearchOrder);
addifnonzero('DomainDNSRegistrationEnabled: '#9,vartostr(ColItem.DomainDNSRegistrationEnabled));
addifnonzero('ForwardBufferMemory : '#9,vartostr(ColItem.ForwardBufferMemory));
addifnonzero('FullDNSRegistrationEnabled : '#9,vartostr(ColItem.FullDNSRegistrationEnabled));
addifnonzero('IGMPLevel : '#9,vartostr(ColItem.IGMPLevel));
addifnonzero('Index : '#9,vartostr(ColItem.Index));
strIPSecPermitIPProtocols := GetMultiString_FromArray(ColItem.IPSecPermitIPProtocols,', ');
addifnonzero('IPSecPermitIPProtocols : '#9,strIPSecPermitIPProtocols);
strIPSecPermitTCPPorts :=GetMultiString_FromArray(ColItem.IPSecPermitTCPPorts,', ');
addifnonzero('IPSecPermitTCPPorts : '#9,strIPSecPermitTCPPorts);
strIPSecPermitUDPPorts := GetMultiString_FromArray(ColItem.IPSecPermitUDPPorts,', ');
addifnonzero('IPSecPermitUDPPorts : '#9,strIPSecPermitUDPPorts);
addifnonzero('IPUseZeroBroadcast : '#9,vartostr(ColItem.IPUseZeroBroadcast));
addifnonzero('IPXAddress : '#9,vartostr(ColItem.IPXAddress));
addifnonzero('IPXEnabled : '#9,vartostr(ColItem.IPXEnabled));
strIPXFrameType:=GetMultiString_FromArray(ColItem.IPXFrameType,', ');
addifnonzero('IPXFrameType : '#9,strIPXFrameType);
strIPXNetworkNumber:=GetMultiString_FromArray(ColItem.IPXNetworkNumber,', ');
addifnonzero('IPXNetworkNumber : '#9,strIPXNetworkNumber);
addifnonzero('IPXVirtualNetNumber : '#9,vartostr(ColItem.IPXVirtualNetNumber));
addifnonzero('KeepAliveInterval : '#9,vartostr(ColItem.KeepAliveInterval));
addifnonzero('KeepAliveTime : '#9,vartostr(ColItem.KeepAliveTime));
addifnonzero('MTU : '#9,OleVariantToText(ColItem.MTU));
addifnonzero('NumForwardPackets : '#9,vartostr(ColItem.NumForwardPackets));
addifnonzero('PMTUBHDetectEnabled : '#9,vartostr(ColItem.PMTUBHDetectEnabled));
addifnonzero('PMTUDiscoveryEnabled : '#9,vartostr(ColItem.PMTUDiscoveryEnabled));
addifnonzero('ServiceName : '#9,vartostr(ColItem.ServiceName));
addifnonzero('SettingID : '#9,vartostr(ColItem.SettingID));
addifnonzero('TcpipNetbiosOptions : '#9,vartostr(ColItem.TcpipNetbiosOptions));
addifnonzero('TcpMaxConnectRetransmissions: '#9,vartostr(ColItem.TcpMaxConnectRetransmissions));
addifnonzero('TcpMaxDataRetransmissions : '#9,vartostr(ColItem.TcpMaxDataRetransmissions));
addifnonzero('TcpNumConnections : '#9,vartostr(ColItem.TcpNumConnections));
addifnonzero('TcpUseRFC1122UrgentPointer : '#9,vartostr(ColItem.TcpUseRFC1122UrgentPointer));
addifnonzero('TcpWindowSize : '#9,vartostr(ColItem.TcpWindowSize));
addifnonzero('WINSEnableLMHostsLookup : '#9,vartostr(ColItem.WINSEnableLMHostsLookup));
addifnonzero('WINSHostLookupFile : '#9,vartostr(ColItem.WINSHostLookupFile));
addifnonzero('WINSPrimaryServer : '#9,vartostr(ColItem.WINSPrimaryServer));
addifnonzero('WINSScopeID : '#9,vartostr(ColItem.WINSScopeID));
addifnonzero('WINSSecondaryServer : '#9,vartostr(ColItem.WINSSecondaryServer));
addifnonzero('ArpAlwaysSourceRoute : '#9,vartostr(ColItem.ArpAlwaysSourceRoute));
addifnonzero('ArpUseEtherSNAP : '#9,vartostr(ColItem.ArpUseEtherSNAP));
addifnonzero('DatabasePath : '#9,vartostr(ColItem.DatabasePath));
addifnonzero('DeadGWDetectEnabled : '#9,vartostr(ColItem.DeadGWDetectEnabled));
addifnonzero('DefaultTOS : '#9,vartostr(ColItem.DefaultTOS));
addifnonzero('DefaultTTL : '#9,vartostr(ColItem.DefaultTTL));
end;
end;
end.
Script to get comprehensive nic info
sub appendCollection(msg, colctn, nm)
i=0
for each t in colctn
msg = msg & "nic." & nm & "["&i&"]: " & t & vbCRLF
i = i + 1
next
end sub
Function PrintOnlyEnabled_NICAdapter_information()
strComputer = "."
Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colNicConfigs = objWMIService.ExecQuery ("SELECT * FROM Win32_NetworkAdapterConfiguration WHERE IPEnabled = True")
for each nic in colNicConfigs
msg = "nic.ArpAlwaysSourceRoute: " & nic.ArpAlwaysSourceRoute & vbCRLF _
& "nic.ArpUseEtherSNAP: " & nic.ArpUseEtherSNAP & vbCRLF _
& "nic.Caption: " & nic.Caption & vbCRLF _
& "nic.DatabasePath: " & nic.DatabasePath & vbCRLF _
& "nic.DeadGWDetectEnabled: " & nic.DeadGWDetectEnabled & vbCRLF _
& "nic.DefaultTOS: " & nic.DefaultTOS & vbCRLF _
& "nic.DefaultTTL: " & nic.DefaultTTL & vbCRLF _
& "nic.Description: " & nic.Description & vbCRLF _
& "nic.DHCPEnabled: " & nic.DHCPEnabled & vbCRLF _
& "nic.DHCPLeaseExpires: " & nic.DHCPLeaseExpires & vbCRLF _
& "nic.DHCPLeaseObtained: " & nic.DHCPLeaseObtained & vbCRLF _
& "nic.DHCPServer: " & nic.DHCPServer & vbCRLF _
& "nic.DNSDomain: " & nic.DNSDomain & vbCRLF _
& "nic.DNSEnabledForWINSResolution: " & nic.DNSEnabledForWINSResolution & vbCRLF _
& "nic.DNSHostName: " & nic.DNSHostName & vbCRLF _
& "nic.DomainDNSRegistrationEnabled: " & nic.DomainDNSRegistrationEnabled & vbCRLF _
& "nic.DNSDomainSuffixSearchOrder: " & nic.DNSDomainSuffixSearchOrder & vbCRLF _
& "nic.ForwardBufferMemory: " & nic.ForwardBufferMemory & vbCRLF _
& "nic.FullDNSRegistrationEnabled: " & nic.FullDNSRegistrationEnabled & vbCRLF _
& "nic.IGMPLevel: " & nic.IGMPLevel & vbCRLF _
& "nic.Index: " & nic.Index & vbCRLF _
& "nic.IPConnectionMetric: " & nic.IPConnectionMetric & vbCRLF _
& "nic.IPEnabled: " & nic.IPEnabled & vbCRLF _
& "nic.IPFilterSecurityEnabled: " & nic.IPFilterSecurityEnabled & vbCRLF _
& "nic.IPPortSecurityEnabled: " & nic.IPPortSecurityEnabled & vbCRLF _
& "nic.IPUseZeroBroadcast: " & nic.IPUseZeroBroadcast & vbCRLF _
& "nic.IPXAddress: " & nic.IPXAddress & vbCRLF _
& "nic.IPXEnabled: " & nic.IPXEnabled & vbCRLF _
& "nic.IPXFrameType: " & nic.IPXFrameType & vbCRLF _
& "nic.IPXMediaType: " & nic.IPXMediaType & vbCRLF _
& "nic.IPXNetworkNumber: " & nic.IPXNetworkNumber & vbCRLF _
& "nic.IPXVirtualNetNumber: " & nic.IPXVirtualNetNumber & vbCRLF _
& "nic.KeepAliveInterval: " & nic.KeepAliveInterval & vbCRLF _
& "nic.KeepAliveTime: " & nic.KeepAliveTime & vbCRLF _
& "nic.MACAddress: " & nic.MACAddress & vbCRLF _
& "nic.MTU: " & nic.MTU & vbCRLF _
& "nic.NumForwardPackets: " & nic.NumForwardPackets & vbCRLF _
& "nic.PMTUBHDetectEnabled: " & nic.PMTUBHDetectEnabled & vbCRLF _
& "nic.PMTUDiscoveryEnabled: " & nic.PMTUDiscoveryEnabled & vbCRLF _
& "nic.ServiceName: " & nic.ServiceName & vbCRLF _
& "nic.SettingID: " & nic.SettingID & vbCRLF _
& "nic.TcpipNetbiosOptions: " & nic.TcpipNetbiosOptions & vbCRLF _
& "nic.TcpMaxConnectRetransmissions: " & nic.TcpMaxConnectRetransmissions & vbCRLF _
& "nic.TcpMaxDataRetransmissions: " & nic.TcpMaxDataRetransmissions & vbCRLF _
& "nic.TcpNumConnections: " & nic.TcpNumConnections & vbCRLF _
& "nic.TcpUseRFC1122UrgentPointer: " & nic.TcpUseRFC1122UrgentPointer & vbCRLF _
& "nic.TcpWindowSize: " & nic.TcpWindowSize & vbCRLF _
& "nic.WINSEnableLMHostsLookup: " & nic.WINSEnableLMHostsLookup & vbCRLF _
& "nic.WINSHostLookupFile: " & nic.WINSHostLookupFile & vbCRLF _
& "nic.WINSPrimaryServer: " & nic.WINSPrimaryServer & vbCRLF _
& "nic.WINSScopeID: " & nic.WINSScopeID & vbCRLF _
& "nic.WINSSecondaryServer: " & nic.WINSSecondaryServer & vbCRLF _
'& "nic.InterfaceIndex: " & "|"&nic.InterfaceIndex & vbCRLF _
appendCollection msg, nic.DefaultIPGateway, "DefaultIPGateway"
appendCollection msg, nic.DNSServerSearchOrder, "DNSServerSearchOrder"
appendCollection msg, nic.GatewayCostMetric, "GatewayCostMetric"
appendCollection msg, nic.IPAddress, "IPAddress"
appendCollection msg, nic.IPSecPermitIPProtocols, "IPSecPermitIPProtocols"
appendCollection msg, nic.IPSecPermitTCPPorts, "IPSecPermitTCPPorts"
appendCollection msg, nic.IPSecPermitUDPPorts, "IPSecPermitUDPPorts"
appendCollection msg, nic.IPSubnet, "IPSubnet"
WScript.Echo msg
next
'Vista only code???
'Set colAdapters = objWMIService.Execquery ("SELECT * FROM Win32_NetworkAdapter WHERE NetEnabled = True")
'For Each nic in colAdapters
' msg = "nic.DeviceId: " & nic.DeviceId & vbCRLF _
' & "nic.Name: " & nic.Name & vbCRLF _
'
'Next
End Function 'Function PrintOnlyEnabled_NICAdapter_information()
Function GetMultiString_FromArray( ArrayString, Seprator)
If IsNull ( ArrayString ) Then
StrMultiArray = ArrayString
else
StrMultiArray = Join( ArrayString, Seprator )
end if
GetMultiString_FromArray = StrMultiArray
End Function
end.
-------------- next part --------------
unit wmiutil;
interface
{$ifdef fpc}
{$mode delphi}
{$endif}
uses
Windows,
SysUtils,
StrUtils,
ActiveX,
ComObj,
Variants;
Type
TEatenType = {$ifdef fpc} {$ifdef ver3_0}pulong{$else}Ulong{$endif}{$else}Integer{$endif}; // type for eaten parameter MkParseDisplayName
oEnumIterator = record
mainobj: OleVariant;
oEnum : IEnumVariant;
IterItem : OleVariant;
IterVal : LongWord;
function Enumerate(v:olevariant):oEnumIterator;
function GetEnumerator :oEnumIterator;
function MoveNext:Boolean;
property Current:OleVariant read iteritem;
end;
function OleVariantToText(aVar:OleVariant):string;
function GetWMIObject(const objectName: String): IDispatch;
Implementation
{ oEnumIterator}
function oEnumIterator.getenumerator :oEnumIterator;
begin
result:=self;
end;
Function oEnumIterator.Enumerate(v :olevariant):oEnumIterator;
begin
mainobj:=v;
oEnum := IUnknown(mainobj._NewEnum) as IEnumVariant;
result:=self;
end;
Function oEnumIterator.MoveNext:boolean;
begin
result:=(oEnum.Next(1, iteritem, iterval) = s_ok);
end;
function OleVariantToText(aVar:OleVariant):string;
// mostly quickdump for WMI researchpurposes
var
i : integer;
begin
Result:='';
if not VarIsNull(aVar) then
if VarIsArray(aVar) then
begin
result:='{';
for i :=VarArrayLowBound(aVar,1) to vararrayhighbound(aVar,1) do
begin
if i<>0 then
result:=result+',';
result:=result+OleVariantToText(vararrayget(aVar,[i]));
end;
result:=result+'}';
end
else
Result:=VarToStr(aVar);
end;
function GetWMIObject(const objectName: String): IDispatch;
var
chEaten: TEatenType;
BindCtx: IBindCtx;
Moniker: IMoniker;
begin
OleCheck(CreateBindCtx(0, bindCtx));
{$ifdef fpc}
OleCheck(MkParseDisplayName(BindCtx, StringToOleStr(objectName), pulong(@chEaten), Moniker));
{$else}
OleCheck(MkParseDisplayName(BindCtx, StringToOleStr(objectName), chEaten, Moniker));
{$endif}
OleCheck(Moniker.BindToObject(BindCtx, nil, IDispatch, Result));
end;
end.
More information about the fpc-pascal
mailing list