delphi 网卡工作状态检测


本文整理自网络,侵删。

 网卡工作状态检测,效果如图(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 获取cpuid的函数

Delphi 取得桌面文件夹的路径和取得我的文档的路径

Delphi启动屏幕保护

Delphi disable_uac_vista

Delphi 搭配hotkeyedit控件来解决问题

Delphi 使用edge browser浏览器组件

Delphi 金木水火土 生克用法

使用rad studio为安卓内置的java库

阻止删除文件(文件占坑)的Delphi代码

Delphi 判断 中文字符

更多相关阅读请进入《Delphi》频道 >>



打赏

取消

感谢您的支持,我会继续努力的!

扫码支持
扫码打赏,您说多少就多少

打开支付宝扫一扫,即可进行扫码打赏哦

分享从这里开始,精彩与您同在

评论

管理员已关闭评论功能...