渴望漂泊的人惟一不飘的是那颗心.

Delphi编写获取内网IP,外网IP,网关及网卡MAC地址

上一篇 / 下一篇 2006-09-09 16:26:20 / 天气: 晴朗 / 心情: 平静 / 个人分类：Delphi编程

Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;
Const
  MAX_ADAPTER_NAME_LENGTH        = 256;
  MAX_ADAPTER_DESCRIPTION_LENGTH = 128;
  MAX_ADAPTER_ADDRESS_LENGTH     = 8;
type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
Type
  TIPAddressString = Array[0..4*4-1] of Char;

  PIPAddrString = ^TIPAddrString;
  TIPAddrString = Record
    Next      : PIPAddrString;
    IPAddress : TIPAddressString;
    IPMask    : TIPAddressString;
    Context   : Integer;
  End;

PIPAdapterInfo = ^TIPAdapterInfo;
  TIPAdapterInfo = Record { IP_ADAPTER_INFO }
    Next                : PIPAdapterInfo;
    ComboIndex          : Integer;
    AdapterName         : Array[0..MAX_ADAPTER_NAME_LENGTH+3] of Char;
    Description         : Array[0..MAX_ADAPTER_DESCRIPTION_LENGTH+3] of Char;
    AddressLength       : Integer;
    Address             : Array[1..MAX_ADAPTER_ADDRESS_LENGTH] of Byte;
    Index               : Integer;
    _Type               : Integer;
    DHCPEnabled         : Integer;
    CurrentIPAddress    : PIPAddrString;
    IPAddressList       : TIPAddrString;
    GatewayList         : TIPAddrString;
  End;
var
  Form1: TForm1;

implementation

{$R *.dfm}
Function GetAdaptersInfo(AI : PIPAdapterInfo; Var BufLen : Integer) : Integer;
         StdCall; External 'iphlpapi.dll' Name 'GetAdaptersInfo';

Function MACToStr(ByteArr : PByte; Len : Integer) : String;
  Begin
    Result := '';
    While (Len > 0) do Begin
      Result := Result+IntToHex(ByteArr^,2)+'-';
      ByteArr := Pointer(Integer(ByteArr)+SizeOf(Byte));
      Dec(Len);
    End;
    SetLength(Result,Length(Result)-1); { remove last dash }
End;

Function GetAddrString(Addr : PIPAddrString) : String;
  Begin
    Result := '';
    While (Addr <> nil) do Begin
      Result := Result+'A: '+Addr^.IPAddress+' M: '+Addr^.IPMask+#13;
      Addr := Addr^.Next;
    End;
  End;

procedure TForm1.Button1Click(Sender: TObject);
var
  AI,Work : PIPAdapterInfo;
  Size    : Integer;
  Res     : Integer;
begin
  Size := 5120;
  GetMem(AI,Size);
  work:=ai;
  Res := GetAdaptersInfo(AI,Size);
  If (Res <> ERROR_SUCCESS) Then Begin
    SetLastError(Res);
    RaiseLastWin32Error;
  End;
  memo1.Lines.Add ('Adapter address: '+MACToStr(@Work^.Address,Work^.AddressLength));
  repeat
    memo1.Lines.add('  IP addresses: '+GetAddrString(@Work^.IPAddressList));
    work:=work^.Next ;
  until (work=nil);
end;

end.