2010年7月21日

ネットワークアダプタの情報を取得する(IPv4)

ネットワークアダプタの情報を取得するにはGetAdaptersInfoを使用します。取得した情報はIP_ADAPTER_INFO構造体に格納されますが、複数のネットワークアダプタが存在する場合は戻値がERROR_BUFFER_OVERFLOWになり、第2パラメータのpOutBufLenに必要なサイズがバイト単位で返されるので、領域を再確保して再びGetAdaptersInfoを呼び出す必要があります。この場合はIP_ADAPTER_INFO構造体のNextがNULLになるまでたどっていくことになります。
まずこれらのIPヘルパAPIや構造体を定義します。
uses
  Windows, SysUtils;

const
  MAX_ADAPTER_DESCRIPTION_LENGTH = 128;
  {$EXTERNALSYM MAX_ADAPTER_DESCRIPTION_LENGTH}
  MAX_ADAPTER_NAME_LENGTH        = 256;
  {$EXTERNALSYM MAX_ADAPTER_NAME_LENGTH}
  MAX_ADAPTER_ADDRESS_LENGTH     = 8;
  {$EXTERNALSYM MAX_ADAPTER_ADDRESS_LENGTH}

  MIB_IF_TYPE_OTHER     = 1;
  {$EXTERNALSYM MIB_IF_TYPE_OTHER}
  MIB_IF_TYPE_ETHERNET  = 6;
  {$EXTERNALSYM MIB_IF_TYPE_ETHERNET}
  MIB_IF_TYPE_TOKENRING = 9;
  {$EXTERNALSYM MIB_IF_TYPE_TOKENRING}
  MIB_IF_TYPE_FDDI      = 15;
  {$EXTERNALSYM MIB_IF_TYPE_FDDI}
  MIB_IF_TYPE_PPP       = 23;
  {$EXTERNALSYM MIB_IF_TYPE_PPP}
  MIB_IF_TYPE_LOOPBACK  = 24;
  {$EXTERNALSYM MIB_IF_TYPE_LOOPBACK}
  MIB_IF_TYPE_SLIP      = 28;
  {$EXTERNALSYM MIB_IF_TYPE_SLIP}

type
  time_t = Longint;
  {$EXTERNALSYM time_t}

  PIP_MASK_STRING = ^IP_MASK_STRING;
  {$EXTERNALSYM PIP_MASK_STRING}
  IP_ADDRESS_STRING = record
    S: array [0..15] of AnsiChar;
  end;
  {$EXTERNALSYM IP_ADDRESS_STRING}
  PIP_ADDRESS_STRING = ^IP_ADDRESS_STRING;
  {$EXTERNALSYM PIP_ADDRESS_STRING}
  IP_MASK_STRING = IP_ADDRESS_STRING;
  {$EXTERNALSYM IP_MASK_STRING}

  PIP_ADDR_STRING = ^IP_ADDR_STRING;
  {$EXTERNALSYM PIP_ADDR_STRING}
  _IP_ADDR_STRING = record
    Next: PIP_ADDR_STRING;
    IpAddress: IP_ADDRESS_STRING;
    IpMask: IP_MASK_STRING;
    Context: DWORD;
  end;
  {$EXTERNALSYM _IP_ADDR_STRING}
  IP_ADDR_STRING = _IP_ADDR_STRING;
  {$EXTERNALSYM IP_ADDR_STRING}

  PIP_ADAPTER_INFO = ^IP_ADAPTER_INFO;
  {$EXTERNALSYM PIP_ADAPTER_INFO}
  _IP_ADAPTER_INFO = record
    Next: PIP_ADAPTER_INFO;
    ComboIndex: DWORD;
    AdapterName: array [0..MAX_ADAPTER_NAME_LENGTH + 3] of AnsiChar;
    Description: array [0..MAX_ADAPTER_DESCRIPTION_LENGTH + 3] of AnsiChar;
    AddressLength: UINT;
    Address: array [0..MAX_ADAPTER_ADDRESS_LENGTH - 1] of BYTE;
    Index: DWORD;
    Type_: UINT;
    DhcpEnabled: UINT;
    CurrentIpAddress: PIP_ADDR_STRING;
    IpAddressList: IP_ADDR_STRING;
    GatewayList: IP_ADDR_STRING;
    DhcpServer: IP_ADDR_STRING;
    HaveWins: BOOL;
    PrimaryWinsServer: IP_ADDR_STRING;
    SecondaryWinsServer: IP_ADDR_STRING;
    LeaseObtained: time_t;
    LeaseExpires: time_t;
  end;
  {$EXTERNALSYM _IP_ADAPTER_INFO}
  IP_ADAPTER_INFO = _IP_ADAPTER_INFO;
  {$EXTERNALSYM IP_ADAPTER_INFO}

function GetAdaptersInfo(pAdapterInfo: PIP_ADAPTER_INFO;
                         var pOutBufLen: ULONG): DWORD; stdcall;
  external 'iphlpapi.dll' Name 'GetAdaptersInfo';
  {$EXTERNALSYM GetAdaptersInfo}

そして
type
  TAdapterType = (atUnknown,
                  atOther,
                  atEthernet,
                  atTokenRing,
                  atFDDI,
                  atPPP,
                  atLoopback,
                  atSLIP,
                  atWLAN);

  TEnumAdapterInfoFunc = function (const AdapterName: String;
                                   const Description: String;
                                   const HardwareAddress: String;
                                   AdapterIndex: Integer;
                                   AdapterType: TAdapterType;
                                   DhcpEnabled: Boolean;
                                   const IPAddress: String;
                                   const Mask: String;
                                   const Gateway: String;
                                   const DHCPServer: String;
                                   Data: Pointer): Boolean;

procedure EnumAdapterInfo(Func: TEnumAdapterInfoFunc; Data: Pointer);

  function FormatHardwareAddress(Ptr: PIP_ADAPTER_INFO): String;
  var
    Index: Integer;
  begin

    Result := '';

    for Index := 0 to Ptr^.AddressLength - 1 do
    begin
      Result := Result + Format('%02.2X-',[Ptr^.Address[Index]]);
    end;

    if Result <> '' then
    begin
      Delete(Result,Length(Result),1);
    end;

  end;

var
  pAdapterInfo: PIP_ADAPTER_INFO;
  Ptr: PIP_ADAPTER_INFO;
  pOutBufLen: ULONG;
  RetVal: DWORD;
  AdapterIndex: Integer;
  AdapterName: String;
  Description: String;
  HardwareAddress: String;
  AdapterType: TAdapterType;
  IPAddress: String;
  NetMask: String;
  Gateway: String;
  DHCPServer: String;
begin

  pOutBufLen := SizeOf(IP_ADAPTER_INFO);
  pAdapterInfo := AllocMem(pOutBufLen);
  try
    RetVal := GetAdaptersInfo(pAdapterInfo,pOutBufLen);
    if RetVal = ERROR_BUFFER_OVERFLOW then
    begin
      FreeMem(pAdapterInfo);
      pAdapterInfo := AllocMem(pOutBufLen);
      RetVal := GetAdaptersInfo(pAdapterInfo,pOutBufLen);
    end;

    if RetVal <> NO_ERROR then
    begin
      Exit;
    end;

    Ptr := pAdapterInfo;
    while Ptr <> nil do
    begin
      AdapterName := Trim(String(Ptr^.AdapterName));
      Description := Trim(String(Ptr^.Description));
      HardwareAddress := FormatHardwareAddress(Ptr);
      AdapterIndex := Ptr^.Index;
      case Ptr^.Type_ of
        MIB_IF_TYPE_OTHER:
        begin
          AdapterType := atOther;
        end;

        MIB_IF_TYPE_ETHERNET:
        begin
          AdapterType := atEthernet;
        end;

        MIB_IF_TYPE_TOKENRING:
        begin
          AdapterType := atTokenRing;
        end;

        MIB_IF_TYPE_FDDI:
        begin
          AdapterType := atFDDI;
        end;

        MIB_IF_TYPE_PPP:
        begin
          AdapterType := atPPP;
        end;

        MIB_IF_TYPE_LOOPBACK:
        begin
          AdapterType := atLoopback;
        end;

        MIB_IF_TYPE_SLIP:
        begin
          AdapterType := atSLIP;
        end;

        71:
        begin
          AdapterType := atWLAN;
        end;

        else
        begin
          AdapterType := atUnknown;
        end;
      end;

      IPAddress  := String(Ptr^.IpAddressList.IpAddress.S);
      NetMask    := String(Ptr^.IpAddressList.IpMask.S);
      Gateway    := String(Ptr^.GatewayList.IpAddress.S);
      if Ptr^.DhcpEnabled = 0 then
      begin
        DHCPServer := '';
      end
      else
      begin
        DHCPServer := String(Ptr^.DhcpServer.IpAddress.S);
      end;

      if Assigned(Func) then
      begin
        if Func(AdapterName,Description,HardwareAddress,AdapterIndex,
                AdapterType,Ptr^.DhcpEnabled <> 0,IPAddress,NetMask,
                Gateway,DHCPServer,Data) = False then
        begin
          Break;
        end;
      end;

      Ptr := Ptr^.Next;
    end;

  finally
    FreeMem(pAdapterInfo);
  end;

end;

とします。Delphi 2009以降の無名メソッド(anonymous method)を使用する場合はこんな感じに。
type
  TAdapterType = (atUnknown,
                  atOther,
                  atEthernet,
                  atTokenRing,
                  atFDDI,
                  atPPP,
                  atLoopback,
                  atSLIP,
                  atWLAN);

  TEnumAdapterInfoFunc = reference to
    function (const AdapterName: String;
              const Description: String;
              const HardwareAddress: String;
              AdapterIndex: Integer;
              AdapterType: TAdapterType;
              DhcpEnabled: Boolean;
              const IPAddress: String;
              const Mask: String;
              const Gateway: String;
              const DHCPServer: String): Boolean;

procedure EnumAdapterInfo(Func: TEnumAdapterInfoFunc);

  function FormatHardwareAddress(Ptr: PIP_ADAPTER_INFO): String;
  var
    Index: Integer;
  begin

    Result := '';

    for Index := 0 to Ptr^.AddressLength - 1 do
    begin
      Result := Result + Format('%02.2X-',[Ptr^.Address[Index]]);
    end;

    if Result <> '' then
    begin
      Delete(Result,Length(Result),1);
    end;

  end;

var
  pAdapterInfo: PIP_ADAPTER_INFO;
  Ptr: PIP_ADAPTER_INFO;
  pOutBufLen: ULONG;
  RetVal: DWORD;
  AdapterIndex: Integer;
  AdapterName: String;
  Description: String;
  HardwareAddress: String;
  AdapterType: TAdapterType;
  IPAddress: String;
  NetMask: String;
  Gateway: String;
  DHCPServer: String;
begin

  pOutBufLen := SizeOf(IP_ADAPTER_INFO);
  pAdapterInfo := AllocMem(pOutBufLen);
  try
    RetVal := GetAdaptersInfo(pAdapterInfo,pOutBufLen);
    if RetVal = ERROR_BUFFER_OVERFLOW then
    begin
      FreeMem(pAdapterInfo);
      pAdapterInfo := AllocMem(pOutBufLen);
      RetVal := GetAdaptersInfo(pAdapterInfo,pOutBufLen);
    end;

    if RetVal <> NO_ERROR then
    begin
      Exit;
    end;

    Ptr := pAdapterInfo;
    while Ptr <> nil do
    begin
      AdapterName := Trim(String(Ptr^.AdapterName));
      Description := Trim(String(Ptr^.Description));
      HardwareAddress := FormatHardwareAddress(Ptr);
      AdapterIndex := Ptr^.Index;
      case Ptr^.Type_ of
        MIB_IF_TYPE_OTHER:
        begin
          AdapterType := atOther;
        end;

        MIB_IF_TYPE_ETHERNET:
        begin
          AdapterType := atEthernet;
        end;

        MIB_IF_TYPE_TOKENRING:
        begin
          AdapterType := atTokenRing;
        end;

        MIB_IF_TYPE_FDDI:
        begin
          AdapterType := atFDDI;
        end;

        MIB_IF_TYPE_PPP:
        begin
          AdapterType := atPPP;
        end;

        MIB_IF_TYPE_LOOPBACK:
        begin
          AdapterType := atLoopback;
        end;

        MIB_IF_TYPE_SLIP:
        begin
          AdapterType := atSLIP;
        end;

        71:
        begin
          AdapterType := atWLAN;
        end;

        else
        begin
          AdapterType := atUnknown;
        end;
      end;

      IPAddress  := String(Ptr^.IpAddressList.IpAddress.S);
      NetMask    := String(Ptr^.IpAddressList.IpMask.S);
      Gateway    := String(Ptr^.GatewayList.IpAddress.S);
      if Ptr^.DhcpEnabled = 0 then
      begin
        DHCPServer := '';
      end
      else
      begin
        DHCPServer := String(Ptr^.DhcpServer.IpAddress.S);
      end;

      if Assigned(Func) then
      begin
        if Func(AdapterName,Description,HardwareAddress,AdapterIndex,
                AdapterType,Ptr^.DhcpEnabled <> 0,IPAddress,NetMask,
                Gateway,DHCPServer) = False then
        begin
          Break;
        end;
      end;

      Ptr := Ptr^.Next;
    end;

  finally
    FreeMem(pAdapterInfo);
  end;

end;

なおIP_ADAPTER_INFO構造体のTypeの値として無線LANの場合の定義がMIB_IF_TYPE_...にはありませんが、実際には71が格納されるようです。
またIPv6(Windows XP以降)の場合はGetAdaptersAddressesを使用する必要があります。

11 件のコメント:

Mute さんのコメント...

初めまして、こんにちは。
Muteと申します。

こちらの記事に公開されているコードを試してみたいのですが、
恥ずかしい話ですがコードをどの位置に書き込めば良いのか、
検討がつかない状況です。

フォームアプリとして試すための大まかな流れを教えて頂けたら幸いです。
どうぞよろしくお願いいたします。

Mute さんのコメント...

追記です。
環境:Delphi 2010 Pro / Xp sp3

ふー さんのコメント...

Muteさん、こんにちは。確かにこれだけでは取っ掛かりがわかりにくいかもしれませんね。
まず新規にユニットを作成します。次に最初のコードのusesをinterface部に、それ以外をimplementation部に置いてください。2番目または3番目のコード(のどちらか、無名メソッドを使うかどうかですね)はimplementation部に置きますが、そのままでは外部の(例えばフォームのある)ユニットから呼び出せませんので、forward宣言に相当する"procedure EnumAdapterInfo(..."の1行をinterface部にもコピーしてください(本来ならその行の最後に"forward;"を書くのですが、この場合は省略可能です)。
これでフォームのあるユニットで新しいユニットをusesすることでEnumAdapterInfoを呼び出せるようになります。
Delphi 2010であれば無名メソッドのほうが試しやすい(フォームに表示したりするのに)かもしれませんね。

Mute さんのコメント...

ふーさん
早速のアドバイスをありがとうございました。
ご説明頂いた通りに並かえました所、
2箇所の「TEnumAdapterInfoFunc」にて[未定義の識別子]というエラーに
なってしまいました。
不慣れなため私の理解が正しいのかどうか自信が全くありません。
下記の通りで合っていますでしょうか?


//------------------------
unit GetAdapInfo;

interface
uses Windows, SysUtils;
procedure EnumAdapterInfo(Func: TEnumAdapterInfoFunc); //ここでエラー

implementation
const
MAX_ADAPTER_DESCRIPTION_LENGTH = 128;
{$EXTERNALSYM MAX_ADAPTER_DESCRIPTION_LENGTH}
MAX_ADAPTER_NAME_LENGTH = 256;
{$EXTERNALSYM MAX_ADAPTER_NAME_LENGTH}
MAX_ADAPTER_ADDRESS_LENGTH = 8;
{$EXTERNALSYM MAX_ADAPTER_ADDRESS_LENGTH}

....中略...

function GetAdaptersInfo(pAdapterInfo: PIP_ADAPTER_INFO;
var pOutBufLen: ULONG): DWORD; stdcall;
external 'iphlpapi.dll' Name 'GetAdaptersInfo';
{$EXTERNALSYM GetAdaptersInfo}
//-------------------------------
type
TAdapterType = (atUnknown,
atOther,
atEthernet,
atTokenRing,
atFDDI,

....中略...

Ptr := Ptr^.Next;
end;

finally
FreeMem(pAdapterInfo);
end;

end;
en

ふー さんのコメント...

おっと、EnumAdapterInfoのforward宣言をinterface部に置く場合はその前にあるtype宣言2つも一緒にinterface部に移動する必要がありますね。

Mute さんのコメント...

ボタン等にコードを書く以上の事が良く分かって無くて、お恥ずかしい限りです。
エラーが消えました。
ありがとうございました。

今、フォームから呼び出す方法がわからず困っていますが、
できあがったGetAdapInfo.pasを良~く見て、考えてみます。

ありがとうございました。

ふー さんのコメント...

フォームにButtonとListViewを置き、ListViewをReport形式にしてカラムを9個作っておき、

const
CAdapterType: array [TAdapterType] of String =
('Unknown', // atUnknown
'Other', // atOther
'Ethernet', // atEthernet
'TokenRing', // atTokenRing
'FDDI', // atFDDI
'PPP', // atPPP
'Loopback', // atLoopback
'SLIP', // atSLIP
'WLAN'); // atWLAN

procedure TForm1.Button1Click(Sender: TObject);
begin

ListView1.Items.Clear;
EnumAdapterInfo(
function(const AdapterName: String;
const Description: String;
const HardwareAddress: String;
AdapterIndex: Integer;
AdapterType: TAdapterType;
DhcpEnabled: Boolean;
const IPAddress: String;
const Mask: String;
const Gateway: String;
const DHCPServer: String): Boolean
begin
with ListView1 do
begin
with Items.Add do
begin
Caption := '0x' + IntToHex(AdapterIndex,8);
with SubItems do
begin
Clear;
Add(AdapterName);
Add(Description);
Add(HardwareAddress);
Add(CAdapterType[AdapterType]);
if DhcpEnabled = True then
begin
if DHCPServer <> '' then
begin
Add(DHCPServer);
end
else
begin
Add('N/A');
end;
end
else
begin
Add('Disabled');
end;
Add(IPAddress);
Add(Mask);
Add(Gateway);
end;
end;
end;

Result := True;
end);

end;

こんな感じでテストできます。

Mute さんのコメント...

あっ、ありがとうございます!!

引数にfunctionを渡すとか私には高度すぎて...(..;)
教えて頂いたコードの数%しか理解できていませんが、
じっくり読んで理解したいと思います。
ありがとうございました。

ふー さんのコメント...

インデントとか全く消えちゃって見づらいことこの上ない感じですが…。
無名メソッドのヘルプは
http://docwiki.embarcadero.com/RADStudio/2010/ja/%E7%84%A1%E5%90%8D%E3%83%A1%E3%82%BD%E3%83%83%E3%83%89
です…が、この説明でわかる人は最初から無名メソッドを理解している人だけでしょうね。
無名メソッドはこの場合いわゆるコールバックの進化形と考えればいいでしょう。EnumAdapterInfoはエントリを1件取得する毎に引数Funcで指定された関数を呼び出します。
普通のコールバックでは呼び出し元のコンテキスト(どのフォームクラスのどのインスタンスから呼び出されたのかなどの情報、このケースではForm1とかForm1.ListView1など)をコールバック先関数で取得するには一種のトリックが必要ですが、無名メソッドはコンテキストをクロージャとして渡してくれていますので(つまり上記のトリックを自動的にやってくれる)、コールバック先の関数では呼び出し元のコンテキストを自由に使える、ということになります。

Mute さんのコメント...

いえいえ、コードを教えて頂けただけでも大変助かりました。

無名メソッドに関しては漠然としたイメージは出来ました。
これの利点に関しては...残念ながらそこまで難しいコードを書けないので、
追々認識することになるかと思います...(苦笑

moontalk さんのコメント...

MACアドレスを取得するためにこちらのコードを使わせていただきました。
他のサイトにあった方法では、使われている(IPアドレスが割り振られている)
アダプターしか列挙されず、困っていました。

大変助かりました。ありがとうございました。