本文整理自网络，侵删。
网卡工作状态检测，效果如图（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.
相关阅读 >>
Delphi fmx 从app程序直接跳转到支付宝付款转帐页面
Delphi idhttp组件+idhttpserver组件实现文件下载服务
Delphi 按字符串长度对tstringlist的元素进行排序
Delphi xe 10.2.1 fmx平台 在图片上写字方法
更多相关阅读请进入《Delphi》频道 >>
