type TForm1 = class(TForm) Button1: TButton; Memo1: TMemo; procedure Button1Click(Sender: TObject); private { Private declarations } procedure GetAdapterInformation; public { Public declarations } end;
var Form1: TForm1;
Function sendarp(ipaddr:ulong; temp:dword; ulmacaddr:pointer; ulmacaddrleng:pointer) : DWord; StdCall;
implementation
{$R *.dfm}
Function sendarp; External 'Iphlpapi.dll' Name 'SendARP'; Function GetAdaptersInfo(AI : PIPAdapterInfo; Var BufLen : Integer) : Integer; StdCall; External 'iphlpapi.dll' Name 'GetAdaptersInfo';
procedure TForm1.GetAdapterInformation; Var AI,Work : PIPAdapterInfo; Size : Integer; Res : Integer; I : Integer;
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;
Function TimeTToDateTimeStr(TimeT : Integer) : String; Const UnixDateDelta = 25569; { days between 12/31/1899 and 1/1/1970 } Var DT : TDateTime; TZ : TTimeZoneInformation; Res : DWord;
Begin If (TimeT = 0) Then Result := '' Else Begin { Unix TIME_T is secs since 1/1/1970 } DT := UnixDateDelta+(TimeT / (24*60*60)); { in UTC } { calculate bias } Res := GetTimeZoneInformation(TZ); If (Res = TIME_ZONE_ID_INVALID) Then RaiseLastWin32Error; If (Res = TIME_ZONE_ID_STANDARD) Then Begin DT := DT-((TZ.Bias+TZ.StandardBias) / (24*60)); Result := DateTimeToStr(DT)+' '+WideCharToString(TZ.StandardName); End Else Begin { daylight saving time } DT := DT-((TZ.Bias+TZ.DaylightBias) / (24*60)); Result := DateTimeToStr(DT)+' '+WideCharToString(TZ.DaylightName); End; End; End;
begin Memo1.Lines.Clear; Size := 5120; GetMem(AI,Size); Res := GetAdaptersInfo(AI,Size); If (Res <> ERROR_SUCCESS) Then Begin SetLastError(Res); RaiseLastWin32Error; End; With Memo1,Lines do Begin Work := AI; I := 1; Repeat Add(''); Add('Adapter ' + IntToStr(I)); Add(' ComboIndex: '+IntToStr(Work^.ComboIndex)); Add(' Adapter name: '+Work^.AdapterName); Add(' Description: '+Work^.Description); Add(' Adapter address: '+MACToStr(@Work^.Address,Work^.AddressLength)); Add(' Index: '+IntToStr(Work^.Index)); Add(' Type: '+IntToStr(Work^._Type)); Add(' DHCP: '+IntToStr(Work^.DHCPEnabled)); Add(' Current IP: '+GetAddrString(Work^.CurrentIPAddress)); Add(' IP addresses: '+GetAddrString(@Work^.IPAddressList)); Add(' Gateways: '+GetAddrString(@Work^.GatewayList)); Add(' DHCP servers: '+GetAddrString(@Work^.DHCPServer)); Add(' Has WINS: '+IntToStr(Integer(Work^.HaveWINS))); Add(' Primary WINS: '+GetAddrString(@Work^.PrimaryWINSServer)); Add(' Secondary WINS: '+GetAddrString(@Work^.SecondaryWINSServer)); Add(' Lease obtained: '+TimeTToDateTimeStr(Work^.LeaseObtained)); Add(' Lease expires: '+TimeTToDateTimeStr(Work^.LeaseExpires)); Inc(I); Work := Work^.Next; Until (Work = nil); End; FreeMem(AI); end;
procedure TForm1.Button1Click(Sender: TObject); begin GetAdapterInformation; end;
end.
方法2
uses nb30;
function NBGetAdapterAddress(a: Integer): string; var NCB: TNCB; // Netbios control block //NetBios控制块 ADAPTER: TADAPTERSTATUS; // Netbios adapter status//取网卡状态 LANAENUM: TLANAENUM; // Netbios lana intIdx: Integer; // Temporary work value//临时变量 cRC: Char; // Netbios return code//NetBios返回值 strTemp: string; // Temporary string//临时变量 begin Result := '';
try ZeroMemory(@NCB, SizeOf(NCB)); // Zero control blocl
strTemp := ''; // Convert it to string for intIdx := 0 to 5 do strTemp := strTemp + InttoHex(Integer(ADAPTER.adapter_address[intIdx]), 2); Result := strTemp; finally end; end;