取得本機所有 IP-MAC (一對一)  (Delphi 7, Delphi 2009 )


[code delphi]
// Delphi 7 , Delphi 2009
//
// 取得所有 IP-MAC
//
// Ref: https://forums.codegear.com/thread.jspa?threadID=16953&tstart=0
//
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;

function GetIPMAC: String;

const
ANY_SIZE = 1;
MAX_ADAPTER_ADDRESS_LENGTH = 8; // arb.

MAX_INTERFACE_NAME_LEN = 256; { mrapi.h }
MAXLEN_PHYSADDR = 8; { iprtrmib.h }
MAXLEN_IFDESCR = 256; { --"--- }

type

//----------- MibIf STRUCTURES------------------------------------------------------

PTMibIfRow = ^TMibIfRow;
TMibIfRow = packed record
wszName: array[1..MAX_INTERFACE_NAME_LEN] of WCHAR;
dwIndex: DWORD;
dwType: DWORD;
dwMTU: DWORD;
dwSpeed: DWORD;
dwPhysAddrLen: DWORD;
bPhysAddr: array[1..MAXLEN_PHYSADDR] of byte;
dwAdminStatus: DWORD;
dwOperStatus: DWORD;
dwLastChange: DWORD;
dwInOctets: DWORD;
dwInUcastPkts: DWORD;
dwInNUCastPkts: DWORD;
dwInDiscards: DWORD;
dwInErrors: DWORD;
dwInUnknownProtos: DWORD;
dwOutOctets: DWORD;
dwOutUCastPkts: DWORD;
dwOutNUCastPkts: DWORD;
dwOutDiscards: DWORD;
dwOutErrors: DWORD;
dwOutQLen: DWORD;
dwDescrLen: DWORD;
// bDescr: array[1..MAXLEN_IFDESCR] of char; //byte;
bDescr: array[1..MAXLEN_IFDESCR] of AnsiChar; //byte;
end;

TMIBIfArray = array of TMIBIFRow;

PTMibIfTable = ^TMIBIfTable;

TMibIfTable = packed record
dwNumEntries: DWORD;
Table: array[0..ANY_SIZE - 1] of TMibIfRow;
end;

//----------- MibIPAddr STRUCTURES------------------------------------------------------

TMacAddress = array[1..MAX_ADAPTER_ADDRESS_LENGTH] of byte;

PTMibIPAddrRow = ^TMibIPAddrRow;
TMibIPAddrRow = packed record
dwAddr: DWORD;
dwIndex: DWORD;
dwMask: DWORD;
dwBCastAddr: DWORD;
dwReasmSize: DWORD;
Unused1,
Unused2: WORD;
end;

TMibIPAddrArray = array of TMIBIPAddrRow;

PTMibIPAddrTable = ^TMibIPAddrTable;
TMibIPAddrTable = packed record
dwNumEntries: DWORD;
Table: array[0..ANY_SIZE - 1] of TMibIPAddrRow;
end;

TForm1 = class(TForm)
Memo1: TMemo;
procedure FormCreate(Sender: TObject);

{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

function GetIfTable( pIfTable: PTMibIfTable; pdwSize: PULONG; bOrder: boolean ): DWORD; stdCall; external 'IPHLPAPI.DLL';
function GetIpAddrTable( pIpAddrTable: PTMibIPAddrTable; pdwSize: PULONG; bOrder: BOOL ): DWORD; stdcall; external 'IPHLPAPI.DLL';


procedure Get_IfTableMIB( var MIBIfArray: TMIBIfArray ; var NumEntries: DWORD );
var
i,
Error,
TableSize : integer;
// pBuf : PChar;
pBuf : PAnsiChar;
// NumEntries : DWORD;
// sDescr, Temp : string;
sDescr, Temp : Ansistring;
begin
TableSize := 0;
// first call: get memsize needed
Error := GetIfTable( PTMibIfTable( pBuf ), @TableSize, false );
if Error <> ERROR_INSUFFICIENT_BUFFER then
EXIT;
GetMem( pBuf, TableSize );

// get table pointer
Error := GetIfTable( PTMibIfTable( pBuf ), @TableSize, false );
if Error = NO_ERROR then
begin
NumEntries := PTMibIfTable( pBuf )^.dwNumEntries;
if NumEntries > 0 then
begin
SetLength( MIBIfArray, NumEntries );
inc( pBuf, SizeOf( NumEntries ) );
for i := 0 to pred(NumEntries) do
begin
MIBIfArray[i] := PTMibIfRow( pBuf )^;
inc( pBuf, SizeOf( TMIBIfRow ) );
end;
end
end;
dec( pBuf, SizeOf( DWORD ) NumEntries * SizeOf( TMIBIfRow ) );
FreeMem( pBuf );
end;

procedure Get_IPAddrTableMIB( var IPAddrTable:TMibIPAddrArray );
var
IPAddrRow : TMibIPAddrRow;
TableSize : DWORD;
ErrorCode : DWORD;
i : integer;
// pBuf : PChar;
pBuf : PAnsiChar;
NumEntries : DWORD;
begin
TableSize := 0; ;
// first call: get table length
ErrorCode := GetIpAddrTable( PTMibIPAddrTable( pBuf ), @TableSize, true );
if Errorcode <> ERROR_INSUFFICIENT_BUFFER then
EXIT;

GetMem( pBuf, TableSize );
// get table
ErrorCode := GetIpAddrTable( PTMibIPAddrTable( pBuf ), @TableSize, true );
if ErrorCode = NO_ERROR then
begin
NumEntries := PTMibIPAddrTable( pBuf )^.dwNumEntries;
if NumEntries > 0 then
begin
SetLength( IPAddrTable, NumEntries);
inc( pBuf, SizeOf( DWORD ) );
for i := 1 to NumEntries do
begin
IPAddrTable[ i-1 ] := PTMIBIPAddrRow( pBuf )^;
inc( pBuf, SizeOf( TMIBIPAddrRow ) );
end;
end;
end;

// we must restore pointer!
dec( pBuf, SizeOf( DWORD ) NumEntries * SizeOf( IPAddrRow ) );
FreeMem( pBuf );
end;

function IpAddr2Str( IPAddr: DWORD ): string;
var
i : integer;
begin
Result := '';
for i := 1 to 4 do
begin
Result := Result Format( '=.', [IPAddr and $FF] );
IPAddr := IPAddr shr 8;
end;
Delete( Result, Length( Result ), 1 );
end; {*IpAddr2Str*}

function GetIPFromIFIndex(InterfaceIndex: Cardinal): string;
var
i: integer;
IPArr : TMIBIPAddrArray;
begin
Result := '!not_found!'; // shouldn't happen...
Get_IPAddrTableMIB( IpArr ); // get IP-address table
if Length(IPArr) > 0 then
for i := low(IPArr) to High(IPArr) do // look for matching index...
if IPArr[i].dwIndex = InterfaceIndex then
begin
Result := IPAddr2Str(IParr[i].dwAddr);
BREAK;
end;
end; (*GetIPFromIFIndex*)


function MacAddr2Str( MacAddr: TMacAddress; size: integer ): string;
{ converts numerical MAC-address to ww-xx-yy-zz string }
var
i : integer;
begin
if Size = 0 then
begin
Result := '00-00-00-00-00-00';
EXIT;
end
else Result := '';
//
for i := 1 to Size do
Result := Result IntToHex( MacAddr[i], 2 ) '-';
Delete( Result, Length( Result ), 1 );
end; {*MacAddr2Str*}

function GetIPMAC: String;
var
MibArr : TMIBIfArray;
// IP : String;
// Mac : String;
IP : AnsiString;
Mac : AnsiString;
i,Num : Integer;
NumEntries : DWORD;

begin

Get_IfTableMIB(MibArr, NumEntries); // get current MIB data
Num:=StrToInt(IntToStr(NumEntries))-1;
Result :='';
for i:=0 to Num do
begin
IP := GetIPFromIFIndex(MibArr[i].dwIndex);
Mac := MacAddr2Str(TMacAddress(MibArr[i].bPhysAddr), MibArr[i].dwPhysAddrLen);

// Memo1.Lines.Add('bDescr : ' MibArr[i].bDescr);
Result := Result IP ' (' MAC ') ' #13#10;
end;
end;


procedure TForm1.FormCreate(Sender: TObject);
begin
Memo1.Lines.Add(GetIPMAC);
end;

end.


[/code]

------
能力不足，求助於人；有能力時，幫幫別人；如果您滿意答覆，請適時結案！

子曰：問有三種，不懂則問，雖懂有疑則問，雖懂而想知更多則問！

編輯記錄

另一種方法
( Delphi 7 和 Delphi 2009 對 IdStack 用法有些不同 )


[code delphi]
// Delphi 2009
// Get All IP-Mac Pairs

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls,
IdStack, WinSock; // need IdStack, WinSock

type
TForm1 = class(TForm)
Memo1: TMemo;
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

{* // Delphi 7

function GetAllIP:String;
var // Delphi 7
IdStack: TIdStack; // Delphi 7
begin
IdStack := TIdStack.CreateStack; // Delphi 7
try
Result := IdStack.LocalAddresses.Text; // Delphi 7
finally
IdStack.Free; // Delphi 7
end;
end;
*}

function GetAllIP:String;
begin
TIdStack.IncUsage; // Delphi 2009
try
Result := GStack.LocalAddresses.Text; // Delphi 2009
finally
TIdStack.DecUsage; // Delphi 2009
end;
end;


function GetAllIP2: String;
var
List: TStringList;
begin

List := TStringList.Create;
try
TIdStack.IncUsage;
try
GStack.AddLocalAddressesToList(List);
finally
TIdStack.DecUsage;
end;
Result := List.Text;
finally
List.Free;
end;
end;

function SendARP(Destip,scrip:DWORD;pmacaddr:PDWORD;VAR phyAddrlen:DWORD):DWORD; stdcall ;external 'iphlpapi.dll' ;

function GetMacFromIP(IP: String): String;
type
Tinfo = array[0..7] of byte;
var
dwTargetIP: dword;
dwMacAddress: array[0..1] of DWORD;
dwMacLen: DWORD;
dwResult: DWORD;
X: Tinfo;
stemp:string;
iloop:integer;
begin

// dwTargetIP := Inet_Addr(PChar(ip)); // Delphi 7 only
dwTargetIP := Inet_Addr(PAnsiChar(AnsiString(ip))); // Delphi 7, Delphi 2008

dwMacLen:= 6;
dwResult:= sendarp(dwtargetip,0,@dwmacaddress[0], dwMaclen);
if dwResult= NO_ERROR then
begin
x:= tinfo(dwMacAddress);

for iloop:= 0 to 5 do
begin
stemp:= stemp inttohex(x[iloop],2);
end;
Result:= stemp;
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
i : Integer;
ip : String;
mac : String;
begin
Memo1.Clear;
Memo1.Lines.Add(GetAllIP);
for i:=0 to Memo1.Lines.Count -1 do
begin
ip := Memo1.Lines[i];
mac := GetMacFromIP(ip);
if ip='' then ip:='127.0.0.1';
Memo1.Lines.Add(ip ' : ' mac);
end;
end;

end.


[/code]

------
能力不足，求助於人；有能力時，幫幫別人；如果您滿意答覆，請適時結案！

子曰：問有三種，不懂則問，雖懂有疑則問，雖懂而想知更多則問！

感謝分享

------
不論是否我發的文，在能力範圍皆很樂意為大家回答問題。
為了補我的能力不足之處，以及讓答案可以被重複的使用，希望大家能儘量以公開的方式問問題。
在引述到我的文時自然會儘量替各位想辦法，謝謝大家！

推推推‧感謝‧‧‧

------
{"name":{["賈氏柏"]}}

請問版主~這個程式碼支援Delphi6嗎?

不知道，小弟手上也沒有 Delphi 6
等您測試過後再分享心得給大家
===================引 用 marsking 文 章===================
請問版主~這個程式碼支援Delphi6嗎?

------
能力不足，求助於人；有能力時，幫幫別人；如果您滿意答覆，請適時結案！

子曰：問有三種，不懂則問，雖懂有疑則問，雖懂而想知更多則問！

剛剛測試了一下...果然不行~
基本的Function也有差異..看來D6果然太老舊了Orz....
而且小弟程式底子太差~所以也沒能將它改寫成D6可用的...
太多地方不知道該抓什麼值了>"<~SRY

===================引 用 pcboy 文 章===================
不知道，小弟手上也沒有 Delphi 6
等您測試過後再分享心得給大家
===================引 用 marsking 文 章===================
請問版主~這個程式碼支援Delphi6嗎?

經小弟測試
第一種方法OK 完全不用修改
第二種方法 GetAllIP 及 GetAllIP2 比照Delphi 7的宣告方式即可

[code delphi]
function GetAllIP:String;
var
IdStack: TIdStack;
begin
IdStack := TIdStack.CreateStack;
try
Result := IdStack.LocalAddresses.Text;
finally
IdStack.Free;
end;
end;

function GetAllIP2: String;
var
List: TStringList;
IdStack: TIdStack;
begin
List := TStringList.Create;
try
IdStack := TIdStack.CreateStack;
try
List.AddStrings(IdStack.LocalAddresses);
finally
IdStack.Free;
end;
Result := List.Text;
finally
List.Free;
end;
end;
[/code]

------
先查HELP
再查GOOGLE
最後才發問

沒人有義務替你解答問題
在標題或文章中標明很急
並不會增加網友回答速度

Developing Tool:
1.Delphi 6
2.Visual Studio 2005
3.Visual Studio 2008
DBMS:
MS-SQL

編輯記錄