网卡工作状态检测，效果如图（Windows XP/2000/2003下测试通过）：
在这一实例中，计算机中有两块网卡，其中一块为无线网卡，另一块为8139的100M以太网卡，无线网卡已连接可上网，有线网卡我故意把网线拔了。从图中可以看出检测完全正确，而且更难能可贵的是检测速度非常快，几乎不占任何资源（CPU负荷几乎没有）。
实现单元
unit AdpUtils; interface uses Windows; const MAX_INTERFACE_NAME_LEN = 256; MAXLEN_PHYSADDR = 8; MAXLEN_IFDESCR = 256; MIB_IF_TYPE_OTHER = 1; MIB_IF_TYPE_ETHERNET = 6; MIB_IF_TYPE_TOKENRING = 9; MIB_IF_TYPE_FDDI = 15; MIB_IF_TYPE_PPP = 23; MIB_IF_TYPE_LOOPBACK = 24; MIB_IF_TYPE_SLIP = 28; MIB_IF_ADMIN_STATUS_UP = 1; MIB_IF_ADMIN_STATUS_DOWN = 2; MIB_IF_ADMIN_STATUS_TESTING = 3; MIB_IF_OPER_STATUS_NON_OPERATIONAL = 0; MIB_IF_OPER_STATUS_UNREACHABLE = 1; MIB_IF_OPER_STATUS_DISCONNECTED = 2; MIB_IF_OPER_STATUS_CONNECTING = 3; MIB_IF_OPER_STATUS_CONNECTED = 4; MIB_IF_OPER_STATUS_OPERATIONAL = 5; type MIB_PHYSADDR = array[0..MAXLEN_PHYSADDR - 1] of Byte; MIB_IFDESCR = array[0..MAXLEN_IFDESCR - 1] of Char; PMIB_IFROW = ^MIB_IFROW; MIB_IFROW = packed record wszName: array[0..MAX_INTERFACE_NAME_LEN - 1] of WCHAR; dwIndex, dwType, dwMtu, dwSpeed, dwPhysAddrLen: DWORD; bPhysAddr: MIB_PHYSADDR; dwAdminStatus, dwOperStatus, dwLastChange, dwInOctets, dwInUcastPkts, dwInNUcastPkts, dwInDiscards, dwInErrors, dwInUnknownProtos, dwOutOctets, dwOutUcastPkts, dwOutNUcastPkts, dwOutDiscards, dwOutErrors, dwOutQLen, dwDescrLen: DWORD; bDescr: MIB_IFDESCR; end; PMIB_IFTABLE = ^MIB_IFTABLE; MIB_IFTABLE = packed record dwNumEntries: DWORD; table: array[0..0] of MIB_IFROW; end; TAdapterStatus = record dwType, dwOperStatus: DWORD; bDescr: MIB_IFDESCR; end; TAdapterStatuses = array of TAdapterStatus; function GetIfTable(pIfTable: PMIB_IFTABLE; pdwSize: PULONG; bOrder: BOOL): DWORD; stdcall; external 'iphlpapi.dll'; function GetAdapterTypeString(const dwType: DWORD): string; function GetGetAdapterStatusString(const dwOperStatus: DWORD): string; procedure ScanAdapters(var AdapterStatuses: TAdapterStatuses); implementation var dwSize: DWORD; pMibIfTable: PMIB_IFTABLE; function GetAdapterTypeString(const dwType: DWORD): string; begin case dwType of MIB_IF_TYPE_OTHER: Result := '其他'; MIB_IF_TYPE_ETHERNET: Result := '以太网'; MIB_IF_TYPE_TOKENRING: Result := '令牌环'; MIB_IF_TYPE_FDDI: Result := 'FDDI'; MIB_IF_TYPE_PPP: Result := 'PPP'; MIB_IF_TYPE_LOOPBACK: Result := '回路'; MIB_IF_TYPE_SLIP: Result := 'SLIP'; end; end; function GetGetAdapterStatusString(const dwOperStatus: DWORD): string; begin case dwOperStatus of MIB_IF_OPER_STATUS_NON_OPERATIONAL: Result := '掉线'; MIB_IF_OPER_STATUS_UNREACHABLE: Result := '不可达'; MIB_IF_OPER_STATUS_DISCONNECTED: Result := '断开'; MIB_IF_OPER_STATUS_CONNECTING: Result := '连接中'; MIB_IF_OPER_STATUS_CONNECTED: Result := '已连接'; MIB_IF_OPER_STATUS_OPERATIONAL: Result := '连通'; end; end; procedure ScanAdapters(var AdapterStatuses: TAdapterStatuses); var dwRetVal: DWORD; num, i: Longint; begin dwRetVal := GetIfTable(pMibIfTable, @dwSize, False); if dwRetVal = NO_ERROR then begin num := pMibIfTable^.dwNumEntries; if Length(AdapterStatuses) <> num then SetLength(AdapterStatuses, num); for i := Low(AdapterStatuses) to High(AdapterStatuses) do begin AdapterStatuses[i].dwType := pMibIfTable^.table[i].dwType; AdapterStatuses[i].dwOperStatus := pMibIfTable^.table[i].dwOperStatus; AdapterStatuses[i].bDescr := pMibIfTable^.table[i].bDescr; end; end; end; initialization GetIfTable(nil, @dwSize, False); GetMem(pMibIfTable, dwSize); finalization FreeMem(pMibIfTable); end.
调用实例
unit MainForm; interface uses Classes, Controls, Forms, ExtCtrls, ComCtrls, AdpUtils; type TfrmMain = class(TForm) tmRefresh: TTimer; lvAdapters: TListView; procedure tmRefreshTimer(Sender: TObject); private FAdapterStatuses: TAdapterStatuses; FAdapterNum: Integer; procedure RefreshAdapterStatuses; public { Public declarations } end; var frmMain: TfrmMain; implementation {$R *.dfm} procedure TfrmMain.RefreshAdapterStatuses; var num, i: Integer; begin ScanAdapters(FAdapterStatuses); num := Length(FAdapterStatuses); if num = FAdapterNum then begin for i := 0 to num - 1 do lvAdapters.Items[i].SubItems[1] := GetGetAdapterStatusString(FAdapterStatuses[i].dwOperStatus); end else begin lvAdapters.Items.BeginUpdate; lvAdapters.Items.Clear; for i := 0 to num - 1 do begin lvAdapters.Items.Add; lvAdapters.Items[i].Caption := GetAdapterTypeString(FAdapterStatuses[i].dwType); lvAdapters.Items[i].SubItems.Add(FAdapterStatuses[i].bDescr); lvAdapters.Items[i].SubItems.Add(GetGetAdapterStatusString(FAdapterStatuses[i].dwOperStatus)); end; lvAdapters.Items.EndUpdate; FAdapterNum := num; end; end; procedure TfrmMain.tmRefreshTimer(Sender: TObject); begin RefreshAdapterStatuses; end; end.
