本帖最后由 yiweigang 于 2011-9-5 13:17 编辑
c++我还在努力学习ING 所以 用VB 代替了~~~
Public Declare Function GetNetworkParams Lib "iphlpapi.dll" (FixedInfo As Any, pOutBufLen As Long) As Long
Public Declare Function GetIfTable Lib "iphlpapi.dll" (ByRef pIfTable As MIB_IFTABLE, ByRef pdwSize As Long, ByVal bOrder As Long) As Long
Public Declare Function GetIfEntry Lib "iphlpapi.dll" (pIfRow As MIB_IFROW) As Long
Public Declare Function GetInterfaceInfo Lib "iphlpapi.dll" (pIfTable As IP_INTERFACE_INFO, dwOutBufLen As Long) As Long
Const MAX_ADAPTER_NAME_LENGTH = 260
Public 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
Public Type IP_ADAPTER_INDEX_MAP
Index As Long '和适配器关联的接口序号
Name As String * MAX_ADAPTER_NAME_LENGTH
'指向一个包含了适配器名称的Unicode字符串
End Type
Public Type MIB_IFTABLE '包含结果表
dwNumEntries As Long '当前网络接口的总数
MIB_Table(9) As MIB_IFROW '指向一个包含MIB_IFROW类型的指针
End Type
Public Type IP_INTERFACE_INFO
NumAdapters As Long '适配器编号
Adapter(1) As IP_ADAPTER_INDEX_MAP 'IP_ADAPTER_INDEX_MAP类型的数组
End Type
上面是模块的申明,参见MSDN
那么 这有什么用呢?
首先 我们 可以用iphlpapi.dl 获得当前计算机上安装的网络适配器:
Combo1.Clear
Combo1.AddItem "所有网络适配器"
Dim Net As MIB_IFTABLE
LenIfT = Len(Net)
RValue = GetIfTable(Net, LenIfT, True)
'由Net.dwNumEntries获得接口数量,然后用for…next循环获取每个接口信息:
For i = 0 To Net.dwNumEntries - 1
With Net.MIB_Table(i)
Combo1.AddItem StrConv(.bDescr, vbUnicode)
End With
Next
Combo1.ListIndex = 0
然后我们 就可以做一个简单的网络折线统计图啦~~
建一个定时器 代码如下:
Private Sub Nettext_Timer()
On Error Resume Next
Dim Net As MIB_IFTABLE
LenIfT = Len(Net)
RValue = GetIfTable(Net, LenIfT, True)
For i = 1 To Net.dwNumEntries
UpCache(i) = Up(i)
DownCache(i) = Down(i)
Down(i) = Net.MIB_Table(i - 1).dwInOctets
Up(i) = Net.MIB_Table(i - 1).dwOutOctets
If (UpCache(i) > 0) And (DownCache(i) > 0) Then
UpSpeed(i) = (Up(i) - UpCache(i)) / (Nettext.Interval / 1000)
DownSpeed(i) = (Down(i) - DownCache(i)) / (Nettext.Interval / 1000)
End If
If (UpSpeed(i) / 2) > UpSpeedMax(i) Then
UpSpeedMax(i) = UpSpeed(i) / 2
End If
If (DownSpeed(i) / 2) > DownSpeedMax(i) Then
DownSpeedMax(i) = DownSpeed(i) / 2
End If
For j = 1 To 20
Updata(i, j) = Updata(i, j + 1)
Downdata(i, j) = Downdata(i, j + 1)
Next j
Updata(i, 21) = UpSpeed(i) / 2
Downdata(i, 21) = DownSpeed(i) / 2
If (DownSpeedMax(i) > MaxSpeed(i)) Or (UpSpeedMax(i) > MaxSpeed(i)) Then
If DownSpeedMax(i) > UpSpeedMax(i) Then
MaxSpeedCache(i) = MaxSpeed(i)
MaxSpeed(i) = DownSpeedMax(i)
Else
MaxSpeedCache(i) = MaxSpeed(i)
MaxSpeed(i) = UpSpeedMax(i)
End If
End If
Next i
'--------------所有网络适配器---------------
Up(0) = 0
Down(0) = 0
DownSpeed(0) = 0
UpSpeed(0) = 0
For i = 1 To Net.dwNumEntries
Up(0) = Up(0) + Up(i)
Down(0) = Down(0) + Down(i)
DownSpeed(0) = DownSpeed(0) + DownSpeed(i)
UpSpeed(0) = UpSpeed(0) + UpSpeed(i)
Next i
For j = 1 To 20
Updata(0, j) = Updata(0, j + 1)
Downdata(0, j) = Downdata(0, j + 1)
Next j
Updata(0, 21) = UpSpeed(0) / 2
Downdata(0, 21) = DownSpeed(0) / 2
If (UpSpeed(0) / 2) > UpSpeedMax(0) Then
UpSpeedMax(0) = UpSpeed(0) / 2
End If
If (DownSpeed(0) / 2) > DownSpeedMax(0) Then
DownSpeedMax(0) = DownSpeed(0) / 2
End If
If (DownSpeedMax(0) > MaxSpeed(0)) Or (UpSpeedMax(0) > MaxSpeed(0)) Then
If DownSpeedMax(0) > UpSpeedMax(0) Then
MaxSpeedCache(0) = MaxSpeed(0)
MaxSpeed(0) = DownSpeedMax(0)
Else
MaxSpeedCache(0) = MaxSpeed(0)
MaxSpeed(0) = UpSpeedMax(0)
End If
End If
'-------------------------------------------
Label39.Caption = Up(ClickNow) & " Bytes"
Label41.Caption = Down(ClickNow) & " Bytes"
Label35.Caption = Format(DownSpeed(ClickNow) / 2 / 1024, "###,###,###,###,#0.#0 KB/S")
Label36.Caption = Format(UpSpeed(ClickNow) / 2 / 1024, "###,###,###,###,#0.#0 KB/S")
Label44.Caption = Format(DownSpeedMax(ClickNow) / 1024, "###,###,###,###,#0.#0 KB/S")
Label45.Caption = Format(UpSpeedMax(ClickNow) / 1024, "###,###,###,###,#0.#0 KB/S")
Label48.Caption = Int(MaxSpeed(ClickNow) / 1024) + 50
'画折线图
'下载(line1)
For i = 1 To 20
line1(i).Y1 = (Picture1.Height - 80) * (1 - Downdata((ClickNow), i) / 1024 / Val(Label48.Caption))
line1(i).Y2 = (Picture1.Height - 80) * (1 - Downdata((ClickNow), i + 1) / 1024 / Val(Label48.Caption))
Next i
'上传(line2)
For i = 1 To 20
line2(i).Y1 = (Picture1.Height - 80) * (1 - Updata((ClickNow), i) / 1024 / Val(Label48.Caption))
line2(i).Y2 = (Picture1.Height - 80) * (1 - Updata((ClickNow), i + 1) / 1024 / Val(Label48.Caption))
Next i
End Sub
。。。。。我忽然发现 我不知道 该说些什么。。。。
绝对是自己 写的啊~~
为证明自己 附上我为高中同学(现在我毕业啦~~)写的 Fan{过}{滤}Qiang程序(越过学校对教室电脑的网络封锁)
望转正啊~~~
Hi,Internet!.part13.rar
(60.26 KB, 下载次数: 52)
|