まずこれらの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;
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;
またIPv6(Windows XP以降)の場合はGetAdaptersAddressesを使用する必要があります。
11 件のコメント:
初めまして、こんにちは。
Muteと申します。
こちらの記事に公開されているコードを試してみたいのですが、
恥ずかしい話ですがコードをどの位置に書き込めば良いのか、
検討がつかない状況です。
フォームアプリとして試すための大まかな流れを教えて頂けたら幸いです。
どうぞよろしくお願いいたします。
追記です。
環境：Delphi 2010 Pro / Xp sp3
Muteさん、こんにちは。確かにこれだけでは取っ掛かりがわかりにくいかもしれませんね。
まず新規にユニットを作成します。次に最初のコードのusesをinterface部に、それ以外をimplementation部に置いてください。2番目または3番目のコード(のどちらか、無名メソッドを使うかどうかですね)はimplementation部に置きますが、そのままでは外部の(例えばフォームのある)ユニットから呼び出せませんので、forward宣言に相当する"procedure EnumAdapterInfo(..."の1行をinterface部にもコピーしてください(本来ならその行の最後に"forward;"を書くのですが、この場合は省略可能です)。
これでフォームのあるユニットで新しいユニットをusesすることでEnumAdapterInfoを呼び出せるようになります。
Delphi 2010であれば無名メソッドのほうが試しやすい(フォームに表示したりするのに)かもしれませんね。
ふーさん
早速のアドバイスをありがとうございました。
ご説明頂いた通りに並かえました所、
２箇所の「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部に移動する必要がありますね。
ボタン等にコードを書く以上の事が良く分かって無くて、お恥ずかしい限りです。
エラーが消えました。
ありがとうございました。
今、フォームから呼び出す方法がわからず困っていますが、
できあがった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;
こんな感じでテストできます。
あっ、ありがとうございます！！
引数に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など)をコールバック先関数で取得するには一種のトリックが必要ですが、無名メソッドはコンテキストをクロージャとして渡してくれていますので(つまり上記のトリックを自動的にやってくれる)、コールバック先の関数では呼び出し元のコンテキストを自由に使える、ということになります。
いえいえ、コードを教えて頂けただけでも大変助かりました。
無名メソッドに関しては漠然としたイメージは出来ました。
これの利点に関しては...残念ながらそこまで難しいコードを書けないので、
追々認識することになるかと思います...(苦笑
MACアドレスを取得するためにこちらのコードを使わせていただきました。
他のサイトにあった方法では、使われている(IPアドレスが割り振られている)
アダプターしか列挙されず、困っていました。
大変助かりました。ありがとうございました。
コメントを投稿