带宽计算(互联网数据传输)

发布于 2024-10-12 01:13:27 字数 6261 浏览 2 评论 0原文

我使用以下代码来获取带宽

它可以工作,但我有以下疑问

1.我需要以MB为单位传输的总互联网数据,我如何转换?,总数据传输(下载+上传)因其他带宽监控应用程序而异。我如何获得准确的数据传输?

2.数据传输中需要排除本地局域网内的文件传输,以下方法包括互联网数据传输+本地文件传输

Option Explicit

Public Enum OperationalStates
  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
End Enum
Public Enum InterfaceTypes  
  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  
End Enum

Public Enum AdminStatuses
  MIB_IF_ADMIN_STATUS_UP = 1
  MIB_IF_ADMIN_STATUS_DOWN = 2
  MIB_IF_ADMIN_STATUS_TESTING = 3
End Enum

Private Const MAXLEN_IFDESCR         As Integer = 256
Private Const MAXLEN_PHYSADDR        As Integer = 8
Private Const MAX_INTERFACE_NAME_LEN As Integer = 256
Private Const ERROR_NOT_SUPPORTED    As Long = 50
Private Const ERROR_SUCCESS          As Long = 0

Private Type MIB_IFROW  
  wszName(0 To 511)                        As Byte  
  dwIndex                                  As Long    '// index of the interface  
  dwType                                   As Long    '// type of interface  
  dwMtu                                    As Long    '// max transmission unit  
  dwSpeed                                  As Long    '// speed of the interface  
  dwPhysAddrLen                            As Long    '// length of physical address  
  bPhysAddr(0 To 7)                        As Byte    '// physical address of adapter  
  dwAdminStatus                            As Long    '// administrative status  
  dwOperStatus                             As Long    '// operational status  
  dwLastChange                             As Long  
  dwInOctets                               As Long      '// octets received  
  dwInUcastPkts                            As Long    '// unicast packets received  
  dwInNUcastPkts                           As Long    '// non-unicast packets received  
  dwInDiscards                             As Long    '// received packets discarded  
  dwInErrors                               As Long    '// erroneous packets received  
  dwInUnknownProtos                        As Long  
  dwOutOctets                              As Long     '// octets sent  
  dwOutUcastPkts                           As Long    '// unicast packets sent  
  dwOutNUcastPkts                          As Long    '// non-unicast packets sent  
  dwOutDiscards                            As Long    '// outgoing packets discarded  
  dwOutErrors                              As Long    '// erroneous packets sent  
  dwOutQLen                                As Long    '// output queue length  
  dwDescrLen                               As Long    '// length of bDescr member  
  bDescr(0 To 255)                         As Byte    '// interface description  
 End Type  

Private m_lngBytesReceived As Long  
Private m_lngBytesSent     As Long  

Private Declare Function GetIfTable _
            Lib "IPhlpAPI" (ByRef pIfRowTable As Any, _
                            ByRef pdwSize As Long, _
                            ByVal bOrder As Long) As Long  

Private Declare Sub CopyMemory _
            Lib "kernel32" _
            Alias "RtlMoveMemory" (ByRef pDest As Any, _
                                   ByRef pSource As Any, _
                                   ByVal Length As Long)  

Private Declare Function FreeResource Lib "kernel32" (ByVal hResData As Long) As Long  

Public Property Get BytesReceived() As Long  
 BytesReceived = m_lngBytesReceived  
End Property  

Public Property Get BytesSent() As Long
  BytesSent = m_lngBytesSent
End Property

Public Function InitInterfaces() As Boolean  
 Dim arrBuffer() As Byte  
 Dim lngSize     As Long  
 Dim lngRetVal   As Long  
 Dim Name        As String  
 Dim lngRows     As Long  
 Dim lngRow      As Long  
 Dim i           As Integer  
 Dim j           As Integer  
 Dim IfRowTable  As MIB_IFROW  
 On Error GoTo err  

 lngSize = 0
 m_lngBytesReceived = 0
 m_lngBytesSent = 0
 lngRetVal = GetIfTable(ByVal 0&, lngSize, 0)

 If lngRetVal = ERROR_NOT_SUPPORTED Then
    Exit Function
 End If

 ReDim arrBuffer(0 To lngSize - 1) As Byte
 lngRetVal = GetIfTable(arrBuffer(0), lngSize, 0)

 If lngRetVal = ERROR_SUCCESS Then
    CopyMemory lngRows, arrBuffer(0), 4

    If lngRows >= 1 Then

        For lngRow = 1 To lngRows
            CopyMemory IfRowTable, arrBuffer(4 + (lngRow - 1) * Len(IfRowTable)), Len(IfRowTable)

            For i = 0 To 25
                Name = Name & Chr(IfRowTable.bDescr(i))

                If IfRowTable.bDescr(i) = Chr(0) Then GoTo ok
            Next

ok:

            If Not InStr(1, Name, "loop", vbTextCompare) > 0 Then

                With IfRowTable
                    m_lngBytesReceived = m_lngBytesReceived + .dwInOctets
                    m_lngBytesSent = m_lngBytesSent + .dwOutOctets

                End With 'IFROWTABLE

                'Set IfRowTable = Nothing
                InitInterfaces = True
            End If

            Name = vbNullString
        Next

        Erase arrBuffer
    End If

End If

On Error GoTo 0
Exit Function

err:

Call GErrorHandler(err.Number, err.Description, "CIPHelper:InitInterfaces:" & err.Source, True)
End Function

Private Sub GetBandwidth()  
 Dim c As New CIpHelper, R As Double, s As Double  
 Dim r1 As Double, c1 As Double, SendBytes1 As Double, ReceivedBytes1 As Double  

    On Error GoTo errh:
    c.InitInterfaces
    If FirstTime Then
        FirstTime = False
        SendBytes = Format(c.BytesSent / 1024, ".0")
        ReceivedBytes = Format(c.BytesReceived / 1024, ".0")
        SendBytes1 = c.BytesSent
        ReceivedBytes1 = c.BytesReceived
    Else 'FIRSTTIME = FALSE/0
        R = ((c.BytesReceived / 1024) - ReceivedBytes)
        s = ((c.BytesSent / 1024) - SendBytes)
    End If     


    lblBandwidthUsed = R+s

    OldR = R
    OldS = s
    On Error GoTo 0
    Exit Sub
 errh:

    Call GErrorHandler(err.Number, err.Description, "ScreenBlock:GetBandwidth:" & err.Source, True)
End Sub

I have used the following code to get bandwidth

It works but i have following doubts

1.I need Total Internet Data transferred in MB, how do i convert?, total data transferred (download+upload) varies with other bandwidth monitoring applications. how do i get exact data transferred?

2.I need to exclude file transfer in local LAN in Data Transfer, The follwoing method includes internet data transfer + Local file transfer

Option Explicit

Public Enum OperationalStates
  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
End Enum
Public Enum InterfaceTypes  
  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  
End Enum

Public Enum AdminStatuses
  MIB_IF_ADMIN_STATUS_UP = 1
  MIB_IF_ADMIN_STATUS_DOWN = 2
  MIB_IF_ADMIN_STATUS_TESTING = 3
End Enum

Private Const MAXLEN_IFDESCR         As Integer = 256
Private Const MAXLEN_PHYSADDR        As Integer = 8
Private Const MAX_INTERFACE_NAME_LEN As Integer = 256
Private Const ERROR_NOT_SUPPORTED    As Long = 50
Private Const ERROR_SUCCESS          As Long = 0

Private Type MIB_IFROW  
  wszName(0 To 511)                        As Byte  
  dwIndex                                  As Long    '// index of the interface  
  dwType                                   As Long    '// type of interface  
  dwMtu                                    As Long    '// max transmission unit  
  dwSpeed                                  As Long    '// speed of the interface  
  dwPhysAddrLen                            As Long    '// length of physical address  
  bPhysAddr(0 To 7)                        As Byte    '// physical address of adapter  
  dwAdminStatus                            As Long    '// administrative status  
  dwOperStatus                             As Long    '// operational status  
  dwLastChange                             As Long  
  dwInOctets                               As Long      '// octets received  
  dwInUcastPkts                            As Long    '// unicast packets received  
  dwInNUcastPkts                           As Long    '// non-unicast packets received  
  dwInDiscards                             As Long    '// received packets discarded  
  dwInErrors                               As Long    '// erroneous packets received  
  dwInUnknownProtos                        As Long  
  dwOutOctets                              As Long     '// octets sent  
  dwOutUcastPkts                           As Long    '// unicast packets sent  
  dwOutNUcastPkts                          As Long    '// non-unicast packets sent  
  dwOutDiscards                            As Long    '// outgoing packets discarded  
  dwOutErrors                              As Long    '// erroneous packets sent  
  dwOutQLen                                As Long    '// output queue length  
  dwDescrLen                               As Long    '// length of bDescr member  
  bDescr(0 To 255)                         As Byte    '// interface description  
 End Type  

Private m_lngBytesReceived As Long  
Private m_lngBytesSent     As Long  

Private Declare Function GetIfTable _
            Lib "IPhlpAPI" (ByRef pIfRowTable As Any, _
                            ByRef pdwSize As Long, _
                            ByVal bOrder As Long) As Long  

Private Declare Sub CopyMemory _
            Lib "kernel32" _
            Alias "RtlMoveMemory" (ByRef pDest As Any, _
                                   ByRef pSource As Any, _
                                   ByVal Length As Long)  

Private Declare Function FreeResource Lib "kernel32" (ByVal hResData As Long) As Long  

Public Property Get BytesReceived() As Long  
 BytesReceived = m_lngBytesReceived  
End Property  

Public Property Get BytesSent() As Long
  BytesSent = m_lngBytesSent
End Property

Public Function InitInterfaces() As Boolean  
 Dim arrBuffer() As Byte  
 Dim lngSize     As Long  
 Dim lngRetVal   As Long  
 Dim Name        As String  
 Dim lngRows     As Long  
 Dim lngRow      As Long  
 Dim i           As Integer  
 Dim j           As Integer  
 Dim IfRowTable  As MIB_IFROW  
 On Error GoTo err  

 lngSize = 0
 m_lngBytesReceived = 0
 m_lngBytesSent = 0
 lngRetVal = GetIfTable(ByVal 0&, lngSize, 0)

 If lngRetVal = ERROR_NOT_SUPPORTED Then
    Exit Function
 End If

 ReDim arrBuffer(0 To lngSize - 1) As Byte
 lngRetVal = GetIfTable(arrBuffer(0), lngSize, 0)

 If lngRetVal = ERROR_SUCCESS Then
    CopyMemory lngRows, arrBuffer(0), 4

    If lngRows >= 1 Then

        For lngRow = 1 To lngRows
            CopyMemory IfRowTable, arrBuffer(4 + (lngRow - 1) * Len(IfRowTable)), Len(IfRowTable)

            For i = 0 To 25
                Name = Name & Chr(IfRowTable.bDescr(i))

                If IfRowTable.bDescr(i) = Chr(0) Then GoTo ok
            Next

ok:

            If Not InStr(1, Name, "loop", vbTextCompare) > 0 Then

                With IfRowTable
                    m_lngBytesReceived = m_lngBytesReceived + .dwInOctets
                    m_lngBytesSent = m_lngBytesSent + .dwOutOctets

                End With 'IFROWTABLE

                'Set IfRowTable = Nothing
                InitInterfaces = True
            End If

            Name = vbNullString
        Next

        Erase arrBuffer
    End If

End If

On Error GoTo 0
Exit Function

err:

Call GErrorHandler(err.Number, err.Description, "CIPHelper:InitInterfaces:" & err.Source, True)
End Function

Private Sub GetBandwidth()  
 Dim c As New CIpHelper, R As Double, s As Double  
 Dim r1 As Double, c1 As Double, SendBytes1 As Double, ReceivedBytes1 As Double  

    On Error GoTo errh:
    c.InitInterfaces
    If FirstTime Then
        FirstTime = False
        SendBytes = Format(c.BytesSent / 1024, ".0")
        ReceivedBytes = Format(c.BytesReceived / 1024, ".0")
        SendBytes1 = c.BytesSent
        ReceivedBytes1 = c.BytesReceived
    Else 'FIRSTTIME = FALSE/0
        R = ((c.BytesReceived / 1024) - ReceivedBytes)
        s = ((c.BytesSent / 1024) - SendBytes)
    End If     


    lblBandwidthUsed = R+s

    OldR = R
    OldS = s
    On Error GoTo 0
    Exit Sub
 errh:

    Call GErrorHandler(err.Number, err.Description, "ScreenBlock:GetBandwidth:" & err.Source, True)
End Sub

如果你对这篇内容有疑问,欢迎到本站社区发帖提问 参与讨论,获取更多帮助,或者扫码二维码加入 Web 技术交流群。

扫码二维码加入Web技术交流群

发布评论

需要 登录 才能够评论, 你可以免费 注册 一个本站的账号。

评论(1

橘和柠 2024-10-19 01:13:27

1) 1024 字节 = 1 kB,1024 kB = 1 MB。换句话说,将千字节数除以 1024。

2) 我假设如果您不想监视 LAN 流量,那么您想监视无线流量。作为通用解决方案,这可能有点棘手,但如果您知道 LAN 网卡的 MAC 地址,则可以将其排除在计算中,对我来说,它看起来像“bPhysAddr”变量。

您可以在命令行中获取执行命令的PC的MAC地址:

ipconfig /all 

1) 1024 bytes = 1 kB and 1024 kB = 1 MB. In other words, divide the number of kilobytes by 1024.

2) I assume if you don't want to monitor LAN traffic, you want to monitor Wireless traffic. That might be a little tricky to do as a generic solution, but if you know the MAC address of your lan network card, you can exclude it in the calculations which looks like the "bPhysAddr" variable to me.

You can get the MAC address of a PC executing the command in the command line:

ipconfig /all 
~没有更多了~
我们使用 Cookies 和其他技术来定制您的体验包括您的登录状态等。通过阅读我们的 隐私政策 了解更多相关信息。 单击 接受 或继续使用网站,即表示您同意使用 Cookies 和您的相关数据。
原文