您所在位置：主题：[讨论]VB获取本地网络信息问题
Temiral
[专家分：50] 发布于 2009-08-02 01:15:00
怎么判断本地是否已经连接并显示于Label控件上呢？
Declare Function GetNetworkParams Lib "iphlpapi.dll" (FixedInfo As Any, pOutBufLen As Long) As Long
Declare Function GetIfTable Lib "iphlpapi.dll" (ByRef pIfTable As MIB_IFTABLE, ByRef pdwSize As Long, _
ByVal bOrder As Long) As Long
Declare Function GetIfEntry Lib "iphlpapi.dll" (pIfRow As MIB_IFROW) As Long
Type MIB_IFROW '保存結果信息
wszName(0 To 511) As Byte '接口名稱的Unicode字符串，必須為512字節
dwIndex As Long '接口編號
dwType As Long '接口類型，參看IP_ADAPTER_INFO類型的Type成員
dwMtu As Long '最大傳輸單元
dwSpeed As Long '接口速度(字節)
dwPhysAddrLen As Long '由bPhysAddr獲得的物理地址有效長度
bPhysAddr(0 To 7) As Byte '物理地址
dwAdminStatus As Long '接口管理狀態
dwOperStatus As Long '操作狀態，以下值之一:
dwLastChange As Long '操作狀態最后改變的時間
dwInOctets As Long '總共收到(字節)
dwInUcastPkts As Long '總共收到(unicast包)
dwInNUcastPkts As Long '總共收到(non-unicast包)，包括廣播包和多點傳送包
dwInDiscards As Long '收到后丟棄包總數(即使沒有錯誤)
dwInErrors As Long '收到出錯包總數
dwInUnknownProtos As Long '收到后因協議不明而丟棄的包總數
dwOutOctets As Long '總共發送(字節)
dwOutUcastPkts As Long '總共發送(unicast包)
dwOutNUcastPkts As Long '總共發送(non-unicast包)，包括廣播包和多點傳送包
dwOutDiscards As Long '發送丟棄包總數(即使沒有錯誤)
dwOutErrors As Long '發送出錯包總數
dwOutQLen As Long '發送隊列長度
dwDescrLen As Long 'bDescr部分有效長度
bDescr(0 To 255) As Byte '接口描述
End Type
Type MIB_IFTABLE '包含結果表
dwNumEntries As Long '當前网絡接口的總數
MIB_Table(9) As MIB_IFROW '指向一個包含MIB_IFROW類型的指針
End Type
Sub Test()
Dim Net As MIB_IFTABLE
LenIfT = Len(Net)
RValue = GetIfTable(Net, LenIfT, True)
'由Net.dwNumEntries獲得接口數量，然后用for…next循環獲取每個接口信息:
For I = 1 To Net.dwNumEntries - 1
With Net.MIB_Table(I)
Debug.Print
Debug.Print "----" & Time & "----"
Debug.Print "接口編號:" & .dwIndex
Debug.Print "接口速度:" & .dwSpeed
Debug.Print "接口狀態:" & .dwAdminStatus
Debug.Print "操作狀態:" & .dwOperStatus
Debug.Print "收到字節:" & .dwInOctets
For XI = 1 To .dwPhysAddrLen - 1
TXX = TXX & Format(Hex(.bPhysAddr(XI)), "00")
Next
If TXX <> "" Then Debug.Print "网卡地址:"; TXX
End With
Next
End Sub
Declare Function GetNetworkParams Lib "iphlpapi.dll" (FixedInfo As Any, pOutBufLen As Long) As Long
Declare Function GetIfTable Lib "iphlpapi.dll" (ByRef pIfTable As MIB_IFTABLE, ByRef pdwSize As Long, _
ByVal bOrder As Long) As Long
Declare Function GetIfEntry Lib "iphlpapi.dll" (pIfRow As MIB_IFROW) As Long
Type MIB_IFROW '保存結果信息
wszName(0 To 511) As Byte '接口名稱的Unicode字符串，必須為512字節
dwIndex As Long '接口編號
dwType As Long '接口類型，參看IP_ADAPTER_INFO類型的Type成員
dwMtu As Long '最大傳輸單元
dwSpeed As Long '接口速度(字節)
dwPhysAddrLen As Long '由bPhysAddr獲得的物理地址有效長度
bPhysAddr(0 To 7) As Byte '物理地址
dwAdminStatus As Long '接口管理狀態
dwOperStatus As Long '操作狀態，以下值之一:
dwLastChange As Long '操作狀態最后改變的時間
dwInOctets As Long '總共收到(字節)
dwInUcastPkts As Long '總共收到(unicast包)
dwInNUcastPkts As Long '總共收到(non-unicast包)，包括廣播包和多點傳送包
dwInDiscards As Long '收到后丟棄包總數(即使沒有錯誤)
dwInErrors As Long '收到出錯包總數
dwInUnknownProtos As Long '收到后因協議不明而丟棄的包總數
dwOutOctets As Long '總共發送(字節)
dwOutUcastPkts As Long '總共發送(unicast包)
dwOutNUcastPkts As Long '總共發送(non-unicast包)，包括廣播包和多點傳送包
dwOutDiscards As Long '發送丟棄包總數(即使沒有錯誤)
dwOutErrors As Long '發送出錯包總數
dwOutQLen As Long '發送隊列長度
dwDescrLen As Long 'bDescr部分有效長度
bDescr(0 To 255) As Byte '接口描述
End Type
Type MIB_IFTABLE '包含結果表
dwNumEntries As Long '當前网絡接口的總數
MIB_Table(9) As MIB_IFROW '指向一個包含MIB_IFROW類型的指針
End Type
Sub Test()
Dim Net As MIB_IFTABLE
LenIfT = Len(Net)
RValue = GetIfTable(Net, LenIfT, True)
'由Net.dwNumEntries獲得接口數量，然后用for…next循環獲取每個接口信息:
For I = 1 To Net.dwNumEntries - 1
With Net.MIB_Table(I)
Debug.Print
Debug.Print "----" & Time & "----"
Debug.Print "接口編號:" & .dwIndex
Debug.Print "接口速度:" & .dwSpeed
Debug.Print "接口狀態:" & .dwAdminStatus
Debug.Print "操作狀態:" & .dwOperStatus
Debug.Print "收到字節:" & .dwInOctets
For XI = 1 To .dwPhysAddrLen - 1
TXX = TXX & Format(Hex(.bPhysAddr(XI)), "00")
Next
If TXX <> "" Then Debug.Print "网卡地址:"; TXX
End With
Next
End Sub