auxmoney - Geld leihen für das Studiumauxmoney - Geld leihen für das Studium

auxmoney - Geld leihen für den Umzugauxmoney - Geld leihen für den Umzug

Internet: TCP- und IP-Statistik

Internet: TCP- und IP-Statistik via 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
Sponsoren und Investoren

Sponsoren und Investoren sind jederzeit herzlich willkommen!
Wenn Sie die Information(en) auf dieser Seite interessant fanden, freuen wir uns über eine kleine Spende. Empfehlen Sie uns bitte auch in Ihren Netzwerken (z. B. Twitter, Facebook oder Google+). Herzlichen Dank!

Nach oben Sitemap
Impressum & Kontakt