frmstats.frm

vb网络变成

      BeginProperty Font 
         Name            =   "Times New Roman"
         Size            =   15.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00000000&
      Height          =   345
      Left            =   120
      TabIndex        =   1
      Tag             =   "TitleColor"
      Top             =   0
      Width           =   1155
   End
End
Attribute VB_Name = "FrmStats"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function SetWindowRgn Lib "User32" (ByVal hwnd As Long, ByVal hrgn As Long, ByVal bRedraw As Boolean) As Long
Private Declare Function ReleaseCapture Lib "User32" () As Long
Dim IP As MIB_IPSTATS
Dim tcp As MIB_TCPSTATS
Dim udp As MIB_UDPSTATS
Dim icmp As MIBICMPINFO
Dim tStats As MIB_TCPSTATS

Dim sControlSelected As String

Private Sub Form_Load()

sControlSelected = "tcp"
Call imgSelected_Click(0)

Call LoadColors
Call SetColors(Me)

Me.Width = 4560

    With ListView1.ListItems
        '
        .Add , , "Timeout algorithm"
        .Add , , "Minimum timeout"
        .Add , , "Maximum timeout"
        .Add , , "Maximum connections"
        .Add , , "Active opens"
        .Add , , "Passive opens"
        .Add , , "Failed attempts"
        .Add , , "Establised connections reset"
        .Add , , "Established connections"
        .Add , , "Segments received"
        .Add , , "Segment sent"
        .Add , , "Segments retransmitted"
        .Add , , "Incoming errors"
        .Add , , "Outgoing resets"
        .Add , , "Cumulative connections"
        '
    End With
    
    With ListView2.ListItems
    .Add , , "IP forwarding enabled or disabled"
    .Add , , "Default time-to-live"
    .Add , , "Datagrams received"
    .Add , , "Received header errors"
    .Add , , "Received address errors"
    .Add , , "datagrams forwarded"
    .Add , , "datagrams with unknown protocol"
    .Add , , "received datagrams discarded"
    .Add , , "received datagrams delivered"
    .Add , , "outgoing datagrams requested"
    .Add , , "outgoing datagrams discarded"
    .Add , , "sent datagrams discarded"
    .Add , , "datagrams for which no route"
    .Add , , "datagrams for which all frags didn't arrive"
    .Add , , "datagrams requiring reassembly"
    .Add , , "successful reassemblies"
    .Add , , "failed reassemblies"
    .Add , , "successful fragmentations"
    .Add , , "failed fragmentations"
    .Add , , "datagrams fragmented"
    .Add , , "number of interfaces on computer"
    .Add , , "number of IP address on computer"
    .Add , , "number of routes in routing table"
    End With

    With ListView3.ListItems
    .Add , , "received datagrams"
    .Add , , "datagrams for which no port"
    .Add , , "errors on received datagrams"
    .Add , , "sent datagrams"
    .Add , , "number of entries in UDP listener table"
    End With
    
    With ListView4.ListItems
    .Add , , "number of messages"
    .Add , , "number of errors"
    .Add , , "destination unreachable messages"
    .Add , , "time-to-live exceeded messages"
    .Add , , "parameter problem messages"
    .Add , , "source quench messages"
    .Add , , "redirection messages"
    .Add , , "echo requests"
    .Add , , "echo replies"
    .Add , , "timestamp requests"
    .Add , , "timestamp replies"
    .Add , , "address mask requests"
    .Add , , "address mask replies"
    End With
    
    With ListView5.ListItems
    .Add , , "number of messages"
    .Add , , "number of errors"
    .Add , , "destination unreachable messages"
    .Add , , "time-to-live exceeded messages"
    .Add , , "parameter problem messages"
    .Add , , "source quench messages"
    .Add , , "redirection messages"
    .Add , , "echo requests"
    .Add , , "echo replies"
    .Add , , "timestamp requests"
    .Add , , "timestamp replies"
    .Add , , "address mask requests"
    .Add , , "address mask replies"
    End With

Call GetTcpStatistics(tStats)

With tStats
ListView1.ListItems(1).SubItems(1) = .dwRtoAlgorithm
ListView1.ListItems(2).SubItems(1) = .dwRtoMin
ListView1.ListItems(3).SubItems(1) = .dwRtoMax
ListView1.ListItems(4).SubItems(1) = .dwMaxConn
ListView1.ListItems(5).SubItems(1) = .dwActiveOpens
ListView1.ListItems(6).SubItems(1) = .dwPassiveOpens
ListView1.ListItems(7).SubItems(1) = .dwAttemptFails
ListView1.ListItems(8).SubItems(1) = .dwEstabResets
ListView1.ListItems(9).SubItems(1) = .dwCurrEstab
ListView1.ListItems(10).SubItems(1) = .dwInSegs
ListView1.ListItems(11).SubItems(1) = .dwOutSegs
ListView1.ListItems(12).SubItems(1) = .dwRetransSegs
ListView1.ListItems(13).SubItems(1) = .dwInErrs
ListView1.ListItems(14).SubItems(1) = .dwOutRsts
ListView1.ListItems(15).SubItems(1) = .dwNumConns
End With
DoEvents

Call GetIpStatistics(IP)

With IP
ListView2.ListItems(1).SubItems(1) = .dwForwarding
ListView2.ListItems(2).SubItems(1) = .dwDefaultTTL
ListView2.ListItems(3).SubItems(1) = .dwInReceives
ListView2.ListItems(4).SubItems(1) = .dwInHdrErrors
ListView2.ListItems(5).SubItems(1) = .dwInAddrErrors
ListView2.ListItems(6).SubItems(1) = .dwForwDatagrams
ListView2.ListItems(7).SubItems(1) = .dwInUnknownProtos
ListView2.ListItems(8).SubItems(1) = .dwInDiscards
ListView2.ListItems(9).SubItems(1) = .dwInDelivers
ListView2.ListItems(10).SubItems(1) = .dwOutRequests
ListView2.ListItems(11).SubItems(1) = .dwRoutingDiscards
ListView2.ListItems(12).SubItems(1) = .dwOutDiscards
ListView2.ListItems(13).SubItems(1) = .dwOutNoRoutes
ListView2.ListItems(14).SubItems(1) = .dwReasmTimeout
ListView2.ListItems(15).SubItems(1) = .dwReasmReqds
ListView2.ListItems(16).SubItems(1) = .dwReasmOks
ListView2.ListItems(17).SubItems(1) = .dwReasmFails
ListView2.ListItems(18).SubItems(1) = .dwFragOks
ListView2.ListItems(19).SubItems(1) = .dwFragFails
ListView2.ListItems(20).SubItems(1) = .dwFragCreates
ListView2.ListItems(21).SubItems(1) = .dwNumIf
ListView2.ListItems(22).SubItems(1) = .dwNumAddr
ListView2.ListItems(23).SubItems(1) = .dwNumRoutes
End With
DoEvents

Call GetUdpStatistics(udp)

With udp
ListView3.ListItems(1).SubItems(1) = .dwInDatagrams
ListView3.ListItems(2).SubItems(1) = .dwNoPorts
ListView3.ListItems(3).SubItems(1) = .dwInErrors
ListView3.ListItems(4).SubItems(1) = .dwOutDatagrams
ListView3.ListItems(5).SubItems(1) = .dwNumAddrs
End With
DoEvents

Call GetIcmpStatistics(icmp)

With icmp
ListView4.ListItems(1).SubItems(1) = .icmpInStats.dwMsgs
ListView4.ListItems(2).SubItems(1) = .icmpInStats.dwErrors
ListView4.ListItems(3).SubItems(1) = .icmpInStats.dwDestUnreachs
ListView4.ListItems(4).SubItems(1) = .icmpInStats.dwTimeExcds
ListView4.ListItems(5).SubItems(1) = .icmpInStats.dwParmProbs
ListView4.ListItems(6).SubItems(1) = .icmpInStats.dwSrcQuenchs
ListView4.ListItems(7).SubItems(1) = .icmpInStats.dwRedirects
ListView4.ListItems(8).SubItems(1) = .icmpInStats.dwEchos
ListView4.ListItems(9).SubItems(1) = .icmpInStats.dwEchoReps
ListView4.ListItems(10).SubItems(1) = .icmpInStats.dwTimestamps
ListView4.ListItems(11).SubItems(1) = .icmpInStats.dwTimestampReps
ListView4.ListItems(12).SubItems(1) = .icmpInStats.dwAddrMasks
ListView4.ListItems(13).SubItems(1) = .icmpInStats.dwAddrMaskReps
DoEvents
ListView5.ListItems(1).SubItems(1) = .icmpOutStats.dwMsgs
ListView5.ListItems(2).SubItems(1) = .icmpOutStats.dwErrors
ListView5.ListItems(3).SubItems(1) = .icmpOutStats.dwDestUnreachs
ListView5.ListItems(4).SubItems(1) = .icmpOutStats.dwTimeExcds
ListView5.ListItems(5).SubItems(1) = .icmpOutStats.dwParmProbs
ListView5.ListItems(6).SubItems(1) = .icmpOutStats.dwSrcQuenchs
ListView5.ListItems(7).SubItems(1) = .icmpOutStats.dwRedirects
ListView5.ListItems(8).SubItems(1) = .icmpOutStats.dwEchos
ListView5.ListItems(9).SubItems(1) = .icmpOutStats.dwEchoReps
ListView5.ListItems(10).SubItems(1) = .icmpOutStats.dwTimestamps
ListView5.ListItems(11).SubItems(1) = .icmpOutStats.dwTimestampReps
ListView5.ListItems(12).SubItems(1) = .icmpOutStats.dwAddrMasks
ListView5.ListItems(13).SubItems(1) = .icmpOutStats.dwAddrMaskReps
End With
DoEvents
End Sub
Private Sub imgClose_Click()
    ' only do this if we are slid out
    If bBottomOut = True Then
        ' reset the target offest ...
        iRelBottomTrayOffset = FrmMain.Top
        ' and reel her in
        Do While FrmStats.Top > iRelBottomTrayOffset
            ' in two pixels
            FrmStats.Top = FrmStats.Top - 30
            ' and make sure the main form stays on top
            FrmMain.ZOrder
            DoEvents
        Loop
        ' now hide the tray and set the bBottomOut flag false to allow sliding down
        Unload FrmStats
        bBottomOut = False
    End If

End Sub

Private Sub imgClose_MouseDown(Button As Integer, Shift As Integer, x As Single, Y As Single)

If Button = vbLeftButton Then
    imgClose.Picture = Image5.Picture
End If

End Sub
Private Sub imgClose_MouseUp(Button As Integer, Shift As Integer, x As Single, Y As Single)

If Button = vbLeftButton Then
    imgClose.Picture = Image8.Picture
End If

End Sub
Private Sub UpdateStats1()
On Error Resume Next

    Dim tStats          As MIB_TCPSTATS
    Static tStaticStats As MIB_TCPSTATS
    '
    Dim lRetValue       As Long
    '
    Dim blnIsSent       As Boolean
    Dim blnIsRecv       As Boolean
    '
    lRetValue = GetTcpStatistics(tStats)
    '
    With tStats
        '
        If Not tStaticStats.dwRtoAlgorithm = .dwRtoAlgorithm Then _
            ListView1.ListItems(1).SubItems(1) = .dwRtoAlgorithm
        If Not tStaticStats.dwRtoMin = .dwRtoMin Then _
            ListView1.ListItems(2).SubItems(1) = .dwRtoMin
        If Not tStaticStats.dwRtoMax = .dwRtoMax Then _
            ListView1.ListItems(3).SubItems(1) = .dwRtoMax
        If Not tStaticStats.dwMaxConn = .dwMaxConn Then _
            ListView1.ListItems(4).SubItems(1) = .dwMaxConn
        If Not tStaticStats.dwActiveOpens = .dwActiveOpens Then _
            ListView1.ListItems(5).SubItems(1) = .dwActiveOpens
        If Not tStaticStats.dwPassiveOpens = .dwPassiveOpens Then _
            ListView1.ListItems(6).SubItems(1) = .dwPassiveOpens
        If Not tStaticStats.dwAttemptFails = .dwAttemptFails Then _
            ListView1.ListItems(7).SubItems(1) = .dwAttemptFails
        If Not tStaticStats.dwEstabResets = .dwEstabResets Then _
            ListView1.ListItems(8).SubItems(1) = .dwEstabResets
        If Not tStaticStats.dwCurrEstab = .dwCurrEstab Then _
            ListView1.ListItems(9).SubItems(1) = .dwCurrEstab
        If Not tStaticStats.dwInSegs = .dwInSegs Then _
            ListView1.ListItems(10).SubItems(1) = .dwInSegs
        If Not tStaticStats.dwOutSegs = .dwOutSegs Then _
            ListView1.ListItems(11).SubItems(1) = .dwOutSegs
        If Not tStaticStats.dwRetransSegs = .dwRetransSegs Then _
            ListView1.ListItems(12).SubItems(1) = .dwRetransSegs
        If Not tStaticStats.dwInErrs = .dwInErrs Then _
            ListView1.ListItems(13).SubItems(1) = .dwInErrs
        If Not tStaticStats.dwOutRsts = .dwOutRsts Then _
            ListView1.ListItems(14).SubItems(1) = .dwOutRsts
        If Not tStaticStats.dwNumConns = .dwNumConns Then _
            ListView1.ListItems(15).SubItems(1) = .dwNumConns
        '
    End With

    tStaticStats = tStats

End Sub
Private Sub UpdateStats2()

On Error Resume Next
Static ip2 As MIB_IPSTATS
Dim lRetValue       As Long

lRetValue = GetIpStatistics(IP)

With IP