取得本機所有 IP-MAC (一對一) (Delphi 7, Delphi 2009 ) |
|
pcboy
版主 發表:177 回覆:1838 積分:1463 註冊:2004-01-13 發送簡訊給我 |
取得本機所有 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]
------
能力不足,求助於人;有能力時,幫幫別人;如果您滿意答覆,請適時結案! 子曰:問有三種,不懂則問,雖懂有疑則問,雖懂而想知更多則問! |
pcboy
版主 發表:177 回覆:1838 積分:1463 註冊:2004-01-13 發送簡訊給我 |
另一種方法
( 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]
------
能力不足,求助於人;有能力時,幫幫別人;如果您滿意答覆,請適時結案! 子曰:問有三種,不懂則問,雖懂有疑則問,雖懂而想知更多則問! |
Coffee
版主 發表:31 回覆:878 積分:561 註冊:2006-11-15 發送簡訊給我 |
|
jasper_dale
初階會員 發表:2 回覆:48 積分:35 註冊:2005-09-19 發送簡訊給我 |
|
marsking
一般會員 發表:6 回覆:6 積分:2 註冊:2004-06-14 發送簡訊給我 |
|
pcboy
版主 發表:177 回覆:1838 積分:1463 註冊:2004-01-13 發送簡訊給我 |
|
marsking
一般會員 發表:6 回覆:6 積分:2 註冊:2004-06-14 發送簡訊給我 |
|
eaglewolf
資深會員 發表:4 回覆:268 積分:429 註冊:2006-07-06 發送簡訊給我 |
經小弟測試
第一種方法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
編輯記錄
eaglewolf 重新編輯於 2010-02-09 15:32:15, 註解 無‧
|
本站聲明 |
1. 本論壇為無營利行為之開放平台,所有文章都是由網友自行張貼,如牽涉到法律糾紛一切與本站無關。 2. 假如網友發表之內容涉及侵權,而損及您的利益,請立即通知版主刪除。 3. 請勿批評中華民國元首及政府或批評各政黨,是藍是綠本站無權干涉,但這裡不是政治性論壇! |