| GetIpStatistics, GetTcpStatistics, Netstat 2000 |
|
|
| Dim pUdpTable As MIB_UDPTABLE |
| Dim pTcpTable As MIB_TCPTABLE |
| Dim tcp As MIB_TCPSTATS |
| Dim udp As MIB_UDPSTATS |
| Dim icmp As MIBICMPINFO |
| Dim ip As MIB_IPSTATS |
| Dim i As Integer |
| Dim x As Integer |
| Dim pdwSize As Long |
| Dim bOrder As Long |
| Dim nRet As Long |
| Dim s As String |
|
| Const punkte$ = ".................." |
| Dim einfueg$ |
| Dim umwandl$ |
| Dim laenge1% |
| Dim laenge2% |
|
| Sub IP_Connection() |
| txtIP = "" |
|
| If GetIpStatistics(ip) <> 0 Then |
| txtIP = txtIP & " Unable to retrieve IP Statistics" |
| Else |
| txtIP = txtIP & " IP Statistics" & vbCrLf & " " & String(52, "=") & vbCrLf |
| txtIP = txtIP & " datagrams received..........................." & ip.dwInReceives & vbCrLf |
| txtIP = txtIP & " received datagrams delivered................." & ip.dwInDelivers & vbCrLf |
| txtIP = txtIP & " outgoing datagrams requested................." & ip.dwOutRequests & vbCrLf |
| txtIP = txtIP & " default time-to-live........................." & ip.dwDefaultTTL & vbCrLf |
| txtIP = txtIP & " number of routes in routing table............" & ip.dwNumRoutes & vbCrLf |
| txtIP = txtIP & " number of interfaces on computer............." & ip.dwNumIf & vbCrLf |
| txtIP = txtIP & " number of IP address on computer............." & ip.dwNumAddr & vbCrLf |
| txtIP = txtIP & " IP forwarding enabled or disabled............" & ip.dwForwarding & vbCrLf |
| txtIP = txtIP & " received header errors......................." & ip.dwInHdrErrors & vbCrLf |
| txtIP = txtIP & " received address errors......................" & ip.dwInAddrErrors & vbCrLf |
| txtIP = txtIP & " datagrams forwarded.........................." & ip.dwForwDatagrams & vbCrLf |
| txtIP = txtIP & " datagrams with unknown protocol.............." & ip.dwInUnknownProtos & vbCrLf |
| txtIP = txtIP & " received datagrams discarded................." & ip.dwInDiscards & vbCrLf |
| txtIP = txtIP & " outgoing datagrams discarded................." & ip.dwRoutingDiscards & vbCrLf |
| txtIP = txtIP & " sent datagrams discarded....................." & ip.dwOutDiscards & vbCrLf |
| txtIP = txtIP & " datagrams for which no route................." & ip.dwOutNoRoutes & vbCrLf |
| txtIP = txtIP & " datagrams for which all frags didn't arrive.." & ip.dwReasmTimeout & vbCrLf |
| txtIP = txtIP & " datagrams requiring reassembly..............." & ip.dwReasmReqds & vbCrLf |
| txtIP = txtIP & " successful reassemblies......................" & ip.dwReasmOks & vbCrLf |
| txtIP = txtIP & " failed reassemblies.........................." & ip.dwReasmFails & vbCrLf |
| txtIP = txtIP & " successful fragmentations...................." & ip.dwFragOks & vbCrLf |
| txtIP = txtIP & " failed fragmentations........................" & ip.dwFragFails & vbCrLf |
| txtIP = txtIP & " datagrams fragmented........................." & ip.dwFragCreates & vbCrLf |
| txtIP = txtIP & vbCrLf |
| End If |
|
| '--- UDP --- |
| If GetUdpStatistics(udp) <> 0 Then |
| txtIP = txtIP & " Unable to retrieve UDP Statistics" |
| Else |
| txtIP = txtIP & " UDP Statistics" & vbCrLf & " " & String(52, "=") & vbCrLf |
| txtIP = txtIP & " received datagrams..........................." & udp.dwInDatagrams & vbCrLf |
| txtIP = txtIP & " datagrams for which no port.................." & udp.dwNoPorts & vbCrLf |
| txtIP = txtIP & " errors on received datagrams................." & udp.dwInErrors & vbCrLf |
| txtIP = txtIP & " sent datagrams..............................." & udp.dwOutDatagrams & vbCrLf |
| txtIP = txtIP & " number of entries in listener table.........." & udp.dwNumAddrs & vbCrLf |
| txtIP = txtIP & vbCrLf |
|
| txtIP = txtIP & " UDP Connections" & vbCrLf & " " & String(52, "=") & vbCrLf |
| nRet = GetUdpTable(pUdpTable, pdwSize, bOrder) |
| nRet = GetUdpTable(pUdpTable, pdwSize, bOrder) |
| For i = 0 To pUdpTable.dwNumEntries - 1 |
| txtIP = txtIP & " " & c_ip(pUdpTable.table(i).dwLocalAddr) & ":" & _ |
| c_port(pUdpTable.table(i).dwLocalPort) & vbCrLf |
| Next |
|
| txtIP = txtIP & vbCrLf |
| End If |
|
| '--- ICMP --- |
| If GetIcmpStatistics(icmp) <> 0 Then |
| txtIP = txtIP & " Unable to retrieve ICMP Statistics" |
| Else |
| txtIP = txtIP & " ICMP Statistics" & vbCrLf & " " & String(52, "=") & vbCrLf |
| txtIP = txtIP & " ***** ICMP In *****" & vbCrLf |
| txtIP = txtIP & " number of messages..........................." & icmp.icmpInStats.dwMsgs & vbCrLf |
| txtIP = txtIP & " number of errors............................." & icmp.icmpInStats.dwErrors & vbCrLf |
| txtIP = txtIP & " destination unreachable messages............." & icmp.icmpInStats.dwDestUnreachs & vbCrLf |
| txtIP = txtIP & " time-to-live exceeded messages..............." & icmp.icmpInStats.dwTimeExcds & vbCrLf |
| txtIP = txtIP & " parameter problem messages..................." & icmp.icmpInStats.dwParmProbs & vbCrLf |
| txtIP = txtIP & " source quench messages......................." & icmp.icmpInStats.dwSrcQuenchs & vbCrLf |
| txtIP = txtIP & " redirection messages........................." & icmp.icmpInStats.dwRedirects & vbCrLf |
| txtIP = txtIP & " echo requests................................" & icmp.icmpInStats.dwEchos & vbCrLf |
| txtIP = txtIP & " echo replies................................." & icmp.icmpInStats.dwEchoReps & vbCrLf |
| txtIP = txtIP & " timestamp requests..........................." & icmp.icmpInStats.dwTimestamps & vbCrLf |
| txtIP = txtIP & " timestamp replies............................" & icmp.icmpInStats.dwTimestampReps & vbCrLf |
| txtIP = txtIP & " address mask requests........................" & icmp.icmpInStats.dwAddrMasks & vbCrLf |
| txtIP = txtIP & " address mask replies........................." & icmp.icmpInStats.dwAddrMaskReps & vbCrLf |
|
| txtIP = txtIP & vbCrLf |
| txtIP = txtIP & " ***** ICMP Out *****" & vbCrLf |
| txtIP = txtIP & " number of messages..........................." & icmp.icmpOutStats.dwMsgs & vbCrLf |
| txtIP = txtIP & " number of errors............................." & icmp.icmpOutStats.dwErrors & vbCrLf |
| txtIP = txtIP & " destination unreachable messages............." & icmp.icmpOutStats.dwDestUnreachs & vbCrLf |
| txtIP = txtIP & " time-to-live exceeded messages..............." & icmp.icmpOutStats.dwTimeExcds & vbCrLf |
| txtIP = txtIP & " parameter problem messages..................." & icmp.icmpOutStats.dwParmProbs & vbCrLf |
| txtIP = txtIP & " source quench messages......................." & icmp.icmpOutStats.dwSrcQuenchs & vbCrLf |
| txtIP = txtIP & " redirection messages........................." & icmp.icmpOutStats.dwRedirects & vbCrLf |
| txtIP = txtIP & " echo requests................................" & icmp.icmpOutStats.dwEchos & vbCrLf |
| txtIP = txtIP & " echo replies................................." & icmp.icmpOutStats.dwEchoReps & vbCrLf |
| txtIP = txtIP & " timestamp requests..........................." & icmp.icmpOutStats.dwTimestamps & vbCrLf |
| txtIP = txtIP & " timestamp replies............................" & icmp.icmpOutStats.dwTimestampReps & vbCrLf |
| txtIP = txtIP & " address mask requests........................" & icmp.icmpOutStats.dwAddrMasks & vbCrLf |
| txtIP = txtIP & " address mask replies........................." & icmp.icmpOutStats.dwAddrMaskReps & vbCrLf |
| End If |
| End Sub |
|
| Sub TCP_Connection() |
| txtTCP = "" |
| |
| If GetTcpStatistics(tcp) <> 0 Then |
| txtTCP = txtTCP & " Unable to retrieve TCP Statistics" |
| Else |
| txtTCP = txtTCP & " TCP Statistics" & vbCrLf & " " & String(40, "=") & vbCrLf |
| txtTCP = txtTCP & " segments received............." & tcp.dwInSegs & vbCrLf |
| txtTCP = txtTCP & " segments sent................." & tcp.dwOutSegs & vbCrLf |
| txtTCP = txtTCP & " maximum timeout..............." & tcp.dwRtoMax & vbCrLf |
| txtTCP = txtTCP & " minimum timeout..............." & tcp.dwRtoMin & vbCrLf |
| txtTCP = txtTCP & " maximum connections..........." & tcp.dwMaxConn & vbCrLf |
| txtTCP = txtTCP & " timeout algorithm............." & tcp.dwRtoAlgorithm & vbCrLf |
| txtTCP = txtTCP & " active opens.................." & tcp.dwActiveOpens & vbCrLf |
| txtTCP = txtTCP & " passive opens................." & tcp.dwPassiveOpens & vbCrLf |
| txtTCP = txtTCP & " failed attempts..............." & tcp.dwAttemptFails & vbCrLf |
| txtTCP = txtTCP & " establised connections reset.." & tcp.dwEstabResets & vbCrLf |
| txtTCP = txtTCP & " established connections......." & tcp.dwCurrEstab & vbCrLf |
| txtTCP = txtTCP & " segments retransmitted........" & tcp.dwRetransSegs & vbCrLf |
| txtTCP = txtTCP & " incoming errors..............." & tcp.dwInErrs & vbCrLf |
| txtTCP = txtTCP & " outgoing resets..............." & tcp.dwOutRsts & vbCrLf |
| txtTCP = txtTCP & " cumulative connections........" & tcp.dwNumConns & vbCrLf |
| txtTCP = txtTCP & vbCrLf |
| |
| nRet = GetTcpTable(pTcpTable, pdwSize, bOrder) |
| nRet = GetTcpTable(pTcpTable, pdwSize, bOrder) |
| |
| txtTCP = txtTCP & " TCP Connections" & vbCrLf & " " & String(40, "=") & vbCrLf |
| txtTCP = txtTCP & " LocalAddress / RemoteAdress / State " |
| txtTCP = txtTCP & vbCrLf & " " & String(40, "-") & vbCrLf |
| For x = 0 To pTcpTable.dwNumEntries - 1 |
| If pTcpTable.table(x).dwState - 1 <> MIB_TCP_STATE_LISTEN Then |
|
| laenge1 = Len(c_ip(pTcpTable.table(x).dwLocalAddr)) |
| umwandl = c_port(pTcpTable.table(x).dwLocalPort) |
| laenge1 = laenge1 + Len(umwandl) |
| laenge2 = Len(punkte) - laenge1 |
| einfueg = Left(punkte, laenge2) |
| |
| txtTCP = txtTCP & " " & c_ip(pTcpTable.table(x).dwLocalAddr) & ":" |
| txtTCP = txtTCP & c_port(pTcpTable.table(x).dwLocalPort) & einfueg |
|
| laenge1 = Len(c_ip(pTcpTable.table(x).dwRemoteAddr)) |
| umwandl = c_port(pTcpTable.table(x).dwRemotePort) |
| laenge1 = laenge1 + Len(umwandl) |
| laenge2 = Len(punkte) - laenge1 |
| einfueg = Left(punkte, laenge2) |
| |
| txtTCP = txtTCP & c_ip(pTcpTable.table(x).dwRemoteAddr) & ":" |
| txtTCP = txtTCP & c_port(pTcpTable.table(x).dwRemotePort) & einfueg |
| txtTCP = txtTCP & c_state(pTcpTable.table(x).dwState - 1) & vbCrLf |
| Else |
| |
| laenge1 = Len(c_ip(pTcpTable.table(x).dwLocalAddr)) |
| umwandl = c_port(pTcpTable.table(x).dwLocalPort) |
| laenge1 = laenge1 + Len(umwandl) |
| laenge2 = Len(punkte) - laenge1 |
| einfueg = Left(punkte, laenge2) |
| |
| txtTCP = txtTCP & " " & c_ip(pTcpTable.table(x).dwLocalAddr) & ":" |
| txtTCP = txtTCP & c_port(pTcpTable.table(x).dwLocalPort) & einfueg |
| |
| laenge1 = Len(c_ip(pTcpTable.table(x).dwRemoteAddr)) |
| umwandl = c_state(pTcpTable.table(x).dwState - 1) |
| laenge1 = laenge1 + Len(umwandl) |
| laenge2 = Len(punkte) - laenge1 |
| einfueg = Left(punkte, laenge2) |
| |
| txtTCP = txtTCP & c_ip(pTcpTable.table(x).dwRemoteAddr) & ":0" & einfueg |
| txtTCP = txtTCP & c_state(pTcpTable.table(x).dwState - 1) & vbCrLf |
| End If |
| Next |
| End If |
| End Sub |
|
| Sub cmdStat_Click() |
| If cmdStat.Caption = "Stop Update" Then |
| cmdStat.Caption = "Start Update" |
| Timer1.Enabled = False |
| Else |
| cmdStat.Caption = "Stop Update" |
| Timer1.Enabled = True |
| End If |
| End Sub |
|
| Sub Form_Load() |
| IP_Connection |
| TCP_Connection |
| cmdStat.Caption = "Stop Update" |
| End Sub |
|
| Sub Timer1_Timer() |
| IP_Connection |
| TCP_Connection |
| End Sub |
 |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
| Das steht im Modul: |
|
| '================= TCP ==================== |
| 'state of the connection |
| Public Const MIB_TCP_STATE_CLOSED = 0 |
| Public Const MIB_TCP_STATE_LISTEN = 1 |
| Public Const MIB_TCP_STATE_SYN_SENT = 2 |
| Public Const MIB_TCP_STATE_SYN_RCVD = 3 |
| Public Const MIB_TCP_STATE_ESTAB = 4 |
| Public Const MIB_TCP_STATE_FIN_WAIT1 = 5 |
| Public Const MIB_TCP_STATE_FIN_WAIT2 = 6 |
| Public Const MIB_TCP_STATE_CLOSE_WAIT = 7 |
| Public Const MIB_TCP_STATE_CLOSING = 8 |
| Public Const MIB_TCP_STATE_LAST_ACK = 9 |
| Public Const MIB_TCP_STATE_TIME_WAIT = 10 |
| Public Const MIB_TCP_STATE_DELETE_TCB = 11 |
|
| Type MIB_TCPROW |
| dwState As Long 'state of the connection |
| dwLocalAddr As String * 4 'address on local computer |
| dwLocalPort As String * 4 'port number on local computer |
| dwRemoteAddr As String * 4 'address on remote computer |
| dwRemotePort As String * 4 'port number on remote computer |
| End Type |
|
| Type MIB_TCPTABLE |
| dwNumEntries As Long 'number of entries in the table |
| table(100) As MIB_TCPROW 'array of TCP connections |
| End Type |
|
| Declare Function GetTcpTable Lib "IPhlpAPI" _ |
| (pTcpTable As MIB_TCPTABLE, pdwSize As Long, bOrder As Long) As Long |
|
| '================= UDP ==================== |
| Type MIB_UDPROW |
| dwLocalAddr As String * 4 'address on local computer |
| dwLocalPort As String * 4 'port number on local computer |
| End Type |
|
| Type MIB_UDPTABLE |
| dwNumEntries As Long 'number of entries in the table |
| table(100) As MIB_UDPROW 'table of MIB_UDPROW structs |
| End Type |
|
| Declare Function GetUdpTable Lib "IPhlpAPI" _ |
| (pUdpTable As MIB_UDPTABLE, pdwSize As Long, bOrder As Long) As Long |
|
| '=============== Statistics ================== |
| Type MIB_IPSTATS |
| dwForwarding As Long ' IP forwarding enabled or disabled |
| dwDefaultTTL As Long ' default time-to-live |
| dwInReceives As Long ' datagrams received |
| dwInHdrErrors As Long ' received header errors |
| dwInAddrErrors As Long ' received address errors |
| dwForwDatagrams As Long ' datagrams forwarded |
| dwInUnknownProtos As Long ' datagrams with unknown protocol |
| dwInDiscards As Long ' received datagrams discarded |
| dwInDelivers As Long ' received datagrams delivered |
| dwOutRequests As Long ' |
| dwRoutingDiscards As Long ' |
| dwOutDiscards As Long ' sent datagrams discarded |
| dwOutNoRoutes As Long ' datagrams for which no route |
| dwReasmTimeout As Long ' datagrams for which all frags didn't arrive |
| dwReasmReqds As Long ' datagrams requiring reassembly |
| dwReasmOks As Long ' successful reassemblies |
| dwReasmFails As Long ' failed reassemblies |
| dwFragOks As Long ' successful fragmentations |
| dwFragFails As Long ' failed fragmentations |
| dwFragCreates As Long ' datagrams fragmented |
| dwNumIf As Long ' number of interfaces on computer |
| dwNumAddr As Long ' number of IP address on computer |
| dwNumRoutes As Long ' number of routes in routing table |
| End Type |
|
| Declare Function GetIpStatistics Lib "IPhlpAPI" (pStats As MIB_IPSTATS) As Long |
|
| Type MIBICMPSTATS |
| dwMsgs As Long ' number of messages |
| dwErrors As Long ' number of errors |
| dwDestUnreachs As Long ' destination unreachable messages |
| dwTimeExcds As Long ' time-to-live exceeded messages |
| dwParmProbs As Long ' parameter problem messages |
| dwSrcQuenchs As Long ' source quench messages |
| dwRedirects As Long ' redirection messages |
| dwEchos As Long ' echo requests |
| dwEchoReps As Long ' echo replies |
| dwTimestamps As Long ' timestamp requests |
| dwTimestampReps As Long ' timestamp replies |
| dwAddrMasks As Long ' address mask requests |
| dwAddrMaskReps As Long ' address mask replies |
| End Type |
|
| Type MIBICMPINFO |
| icmpInStats As MIBICMPSTATS ' stats for incoming messages |
| icmpOutStats As MIBICMPSTATS ' stats for outgoing messages |
| End Type |
|
| Declare Function GetIcmpStatistics Lib "IPhlpAPI" _ |
| (pStats As MIBICMPINFO) As Long |
|
| Type MIB_TCPSTATS |
| dwRtoAlgorithm As Long ' timeout algorithm |
| dwRtoMin As Long ' minimum timeout |
| dwRtoMax As Long ' maximum timeout |
| dwMaxConn As Long ' maximum connections |
| dwActiveOpens As Long ' active opens |
| dwPassiveOpens As Long ' passive opens |
| dwAttemptFails As Long ' failed attempts |
| dwEstabResets As Long ' establised connections reset |
| dwCurrEstab As Long ' established connections |
| dwInSegs As Long ' segments received |
| dwOutSegs As Long ' segment sent |
| dwRetransSegs As Long ' segments retransmitted |
| dwInErrs As Long ' incoming errors |
| dwOutRsts As Long ' outgoing resets |
| dwNumConns As Long ' cumulative connections |
| End Type |
|
| Declare Function GetTcpStatistics Lib "IPhlpAPI" (pStats As MIB_TCPSTATS) As Long |
|
| Type MIB_UDPSTATS |
| dwInDatagrams As Long ' received datagrams |
| dwNoPorts As Long ' datagrams for which no port |
| dwInErrors As Long ' errors on received datagrams |
| dwOutDatagrams As Long ' sent datagrams |
| dwNumAddrs As Long ' number of entries in UDP listener table |
| End Type |
|
| Declare Function GetUdpStatistics Lib "IPhlpAPI" (pStats As MIB_UDPSTATS) As Long |
|
| '================= Conversion ==================== |
| Function c_port(s) As Long |
| c_port = Asc(Mid(s, 1, 1)) * 256 + Asc(Mid(s, 2, 1)) |
| End Function |
|
| Function c_ip(s) As String |
| c_ip = Asc(Mid(s, 1, 1)) & "." & Asc(Mid(s, 2, 1)) & "." & Asc(Mid(s, 3, 1)) & "." & Asc(Mid(s, 4, 1)) |
| End Function |
|
| Function c_state(s) As String |
| Select Case s |
| Case MIB_TCP_STATE_CLOSED: c_state = "CLOSED" |
| Case MIB_TCP_STATE_LISTEN: c_state = "LISTEN" |
| Case MIB_TCP_STATE_SYN_SENT: c_state = "SYN_SENT" |
| Case MIB_TCP_STATE_SYN_RCVD: c_state = "SYN_RCVD" |
| Case MIB_TCP_STATE_ESTAB: c_state = "ESTAB" |
| Case MIB_TCP_STATE_FIN_WAIT1: c_state = "FIN_WAIT1" |
| Case MIB_TCP_STATE_FIN_WAIT2: c_state = "FIN_WAIT2" |
| Case MIB_TCP_STATE_CLOSE_WAIT: c_state = "CLOSE_WAIT" |
| Case MIB_TCP_STATE_CLOSING: c_state = "CLOSING" |
| Case MIB_TCP_STATE_LAST_ACK: c_state = "LAST_ACK" |
| Case MIB_TCP_STATE_TIME_WAIT: c_state = "TIME_WAIT" |
| Case MIB_TCP_STATE_DELETE_TCB: c_state = "DELETE_TCB" |
| Case Else: c_state = "UNDEFINED" |
| End Select |
| End Function |
|
zurück