[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