Projects

javaSpy

April 15, 2008 by Java

Browsing frmNetSpy.vb (15.70 KB)

Option Explicit On

Imports System.Net
Imports System.Runtime.InteropServices
Imports System.Xml

Public Class frmNetSpy

    Private portNames As XmlNode = Nothing

    Private Const ERROR_SUCCESS = 0
    Private Const MIB_TCP_STATE_CLOSED = 0
    Private Const MIB_TCP_STATE_LISTEN = 1
    Private Const MIB_TCP_STATE_SYN_SENT = 2
    Private Const MIB_TCP_STATE_SYN_RCVD = 3
    Private Const MIB_TCP_STATE_ESTAB = 4
    Private Const MIB_TCP_STATE_FIN_WAIT1 = 5
    Private Const MIB_TCP_STATE_FIN_WAIT2 = 6
    Private Const MIB_TCP_STATE_CLOSE_WAIT = 7
    Private Const MIB_TCP_STATE_CLOSING = 8
    Private Const MIB_TCP_STATE_LAST_ACK = 9
    Private Const MIB_TCP_STATE_TIME_WAIT = 10
    Private Const MIB_TCP_STATE_DELETE_TCB = 11

    <StructLayout(LayoutKind.Sequential)> Private Structure MIB_TCPROW
        Dim dwState As Integer        'state of the connection
        Dim dwLocalAddr As Integer    'address on local computer
        Dim dwLocalPort As Integer    'port number on local computer
        Dim dwRemoteAddr As Integer   'address on remote computer
        Dim dwRemotePort As Integer   'port number on remote computer
    End Structure

    Private Declare Function GetTcpTable Lib "IPhlpAPI" _
      (ByVal pTcpTable As Byte(), ByRef pdwSize As Integer, ByVal bOrder As Integer) As Integer

    <StructLayout(LayoutKind.Sequential)> Private Structure MIB_UDPROW
        Dim dwLocalAddr As Integer 'address on local computer
        Dim dwLocalPort As Integer 'port number on local computer
    End Structure

    Private Declare Function GetUdpTable Lib "IPhlpAPI" _
        (ByVal pUdpTable As Byte(), ByRef pdwSize As Integer, ByVal bOrder As Integer) As Integer

    Private Declare Function lstrcpyA Lib "kernel32" _
        (ByVal ret As String, ByVal ptr As Integer) As Integer

    Private Declare Function lstrlenA Lib "kernel32" _
        (ByVal ptr As Integer) As Integer

    Private Declare Function inet_ntoa Lib "wsock32" _
        (ByVal addr As Integer) As Integer

    Private Declare Function ntohs Lib "wsock32" _
        (ByVal addr As Integer) As Integer

    Private Function c_port(ByVal s As Integer) As Integer
        Try
            Return Asc(Mid(s, 1, 1)) * 256 + Asc(Mid(s, 2, 1))
        Catch
            Return 0
        End Try
    End Function

    Private Function c_ip(ByVal s As Integer) As String
        Return Asc(Mid(s, 1, 1)) & "." & Asc(Mid(s, 2, 1)) & "." & Asc(Mid(s, 3, 1)) & "." & Asc(Mid(s, 4, 1))
    End Function

    Private Function c_state(ByVal s As Integer) As String
        Select Case s
            Case MIB_TCP_STATE_CLOSED : Return "CLOSED"
            Case MIB_TCP_STATE_LISTEN : Return "LISTENING"
            Case MIB_TCP_STATE_SYN_SENT : Return "SYN_SENT"
            Case MIB_TCP_STATE_SYN_RCVD : Return "SYN_RCVD"
            Case MIB_TCP_STATE_ESTAB : Return "ESTABLISHED"
            Case MIB_TCP_STATE_FIN_WAIT1 : Return "FIN_WAIT1"
            Case MIB_TCP_STATE_FIN_WAIT2 : Return "FIN_WAIT2"
            Case MIB_TCP_STATE_CLOSE_WAIT : Return "CLOSE_WAIT"
            Case MIB_TCP_STATE_CLOSING : Return "CLOSING"
            Case MIB_TCP_STATE_LAST_ACK : Return "LAST_ACK"
            Case MIB_TCP_STATE_TIME_WAIT : Return "TIME_WAIT"
            Case MIB_TCP_STATE_DELETE_TCB : Return "DELETE_TCB"
            Case Else : Return "UNDEFINED"
        End Select
    End Function

    Private Function GetInetStrFromPtr(ByVal Address As Integer) As String
        Return GetStrFromPtrA(inet_ntoa(Address))
    End Function

    Private Function GetStrFromPtrA(ByVal lpszA As Integer) As String
        Dim ret As New String(vbNullChar, lstrlenA(lpszA))
        lstrcpyA(ret, lpszA)
        Return ret
    End Function

    Private Function IPToHostName(ByVal IPAddress As String) As String

        Dim ret As String = IPAddress

        Try
            Dim objEntry As IPHostEntry = Dns.GetHostEntry(IPAddress)
            ret = objEntry.HostName
        Catch
        End Try

        Return ret

    End Function

    Private Function HostNameToIP(ByVal HostName As String) As String

        Dim ret As String = HostName

        If Not IPAddress.TryParse(ret, Nothing) Then

            Try
                Dim objEntry As IPHostEntry = Dns.GetHostEntry(HostName)
                ret = objEntry.AddressList(0).ToString
            Catch
            End Try

        End If

        Return ret

    End Function

    Private Function FormatIPForDisplay(ByVal IPAddress As String) As String

        If mnuResolveAddresses.Checked Then

            If IPAddress = "0.0.0.0" Then
                Return IPToHostName("127.0.0.1")
            ElseIf IPAddress = "127.0.0.1" Then
                Return "localhost"
            End If

        End If

        If IPAddress = "" Then
            Return "0.0.0.0"
        Else
            Return IPAddress
        End If

    End Function

    Private Function FormatPortForDisplay(ByVal PortNum As String) As String

        If mnuResolvePortNames.Checked Then

            Dim portName As XmlNode = portNames.SelectSingleNode("port[@num='" + PortNum + "']")
            If Not (portName Is Nothing) Then Return portName.Attributes("name").Value

        End If

        Return PortNum

    End Function

    Private Function GetPortNumber(ByVal PortName As String) As String

        Dim portNum As XmlNode = portNames.SelectSingleNode("port[@name='" + PortName + "']")
        If Not (portNum Is Nothing) Then Return portNum.Attributes("num").Value

        Return PortName

    End Function

    Private Sub _showWaitCursor(ByVal bShow As Boolean)

        ' show/hide the hourglass
        If bShow Then
            Me.Cursor = Cursors.WaitCursor
            Me.UseWaitCursor = True
        Else
            Me.UseWaitCursor = False
            Me.Cursor = Cursors.Arrow
        End If

    End Sub

    Private Sub timerRefresh_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles timerRefresh.Tick

        _showWaitCursor(True)

        lvNetSpy.Items.Clear()
        lblStatus.Text = ""

        Dim totalEndpoints As Integer = 0
        Dim connectedEndpoints As Integer = 0

        Dim buff() As Byte = {}
        Dim pdwSize As Integer = 0
        Dim bOrder As Integer = 1 ' 1 for ordered list

        ' get size of tcp table
        GetTcpTable(Nothing, pdwSize, bOrder)
        ReDim buff(0 To pdwSize - 1)

        ' get tcp table
        If GetTcpTable(buff, pdwSize, bOrder) = ERROR_SUCCESS Then

            Dim nStructSize As Integer = Marshal.SizeOf(GetType(MIB_TCPROW))
            Dim nRows As Integer = Marshal.ReadInt32(buff, 0)

            For i As Integer = 0 To nRows - 1

                Dim p_objTarget As IntPtr = Marshal.AllocHGlobal(nStructSize)
                Marshal.Copy(buff, 4 + i * nStructSize, p_objTarget, nStructSize)
                Dim rowTCP As MIB_TCPROW = CType(Marshal.PtrToStructure(p_objTarget, GetType(MIB_TCPROW)), MIB_TCPROW)
                Marshal.FreeHGlobal(p_objTarget)

                If mnuShowUnconnectedEndpoints.Checked Or _
                    rowTCP.dwState - 1 = MIB_TCP_STATE_ESTAB Then

                    If rowTCP.dwState - 1 <> MIB_TCP_STATE_LISTEN Then

                        With lvNetSpy.Items.Add("Tcp")

                            .SubItems.Add(FormatIPForDisplay(GetInetStrFromPtr(rowTCP.dwLocalAddr)) + ": " + FormatPortForDisplay(ntohs(rowTCP.dwLocalPort).ToString))
                            .SubItems.Add(FormatIPForDisplay(GetInetStrFromPtr(rowTCP.dwRemoteAddr)) + ": " + FormatPortForDisplay(ntohs(rowTCP.dwRemotePort).ToString))
                            .SubItems.Add(c_state(rowTCP.dwState - 1))

                        End With

                        If rowTCP.dwState - 1 = MIB_TCP_STATE_ESTAB Then _
                            connectedEndpoints += 1

                    Else

                        With lvNetSpy.Items.Add("Tcp")

                            .SubItems.Add(FormatIPForDisplay(GetInetStrFromPtr(rowTCP.dwLocalAddr)) + ": " + FormatPortForDisplay(ntohs(rowTCP.dwLocalPort).ToString))
                            .SubItems.Add("0.0.0.0: 0")
                            .SubItems.Add(c_state(rowTCP.dwState - 1))

                        End With

                    End If

                End If

                totalEndpoints += 1

            Next

        End If

        pdwSize = 0

        ' get size of udp table
        GetUdpTable(Nothing, pdwSize, bOrder)
        ReDim buff(0 To pdwSize - 1)

        ' get udp table
        If GetUdpTable(buff, pdwSize, bOrder) = ERROR_SUCCESS Then

            Dim nStructSize As Integer = Marshal.SizeOf(GetType(MIB_UDPROW))
            Dim nRows As Integer = Marshal.ReadInt32(buff, 0)

            For i As Integer = 0 To nRows - 1

                Dim p_objTarget As IntPtr = Marshal.AllocHGlobal(nStructSize)
                Marshal.Copy(buff, 4 + i * nStructSize, p_objTarget, nStructSize)
                Dim rowUDP As MIB_UDPROW = CType(Marshal.PtrToStructure(p_objTarget, GetType(MIB_UDPROW)), MIB_UDPROW)
                Marshal.FreeHGlobal(p_objTarget)

                If mnuShowUnconnectedEndpoints.Checked Then

                    With lvNetSpy.Items.Add("Udp")

                        .SubItems.Add(FormatIPForDisplay(GetInetStrFromPtr(rowUDP.dwLocalAddr)) + ": " + FormatPortForDisplay(ntohs(rowUDP.dwLocalPort).ToString))
                        .SubItems.Add("*.*.*.*: *")
                        .SubItems.Add("")

                    End With

                End If

                totalEndpoints += 1

            Next

        End If

        lblStatus.Text = String.Format("{0} connected endpoint(s) out of {1} endpoint(s) found", _
            connectedEndpoints.ToString("###,##0"), totalEndpoints.ToString("###,##0"))

        _showWaitCursor(False)

    End Sub

    Private Sub mnuPacketSpy_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mnuPacketSpy.Click

        If lvNetSpy.SelectedItems.Count > 0 Then

            Dim selectedItem As ListViewItem = lvNetSpy.SelectedItems(0)
            Dim filterProtocol As String = selectedItem.Text
            Dim status As String = selectedItem.SubItems(3).Text

            If status = "ESTABLISHED" Then

                Dim filterDestPort As String = ""
                If selectedItem.SubItems(2).Text.Contains(":") Then _
                    filterDestPort = selectedItem.SubItems(2).Text.Split(":")(1).Trim

                Dim filterDestIP As String = ""
                If selectedItem.SubItems(2).Text.Contains(":") Then _
                    filterDestIP = selectedItem.SubItems(2).Text.Split(":")(0).Trim

                If mnuResolvePortNames.Checked Then _
                    filterDestPort = GetPortNumber(filterDestPort)

                If filterDestIP = "localhost" Then

                    filterDestIP = ""

                ElseIf mnuResolveAddresses.Checked Then

                    filterDestIP = HostNameToIP(filterDestIP)

                End If

                With New frmPacketSpy(filterProtocol, filterDestPort, filterDestIP)
                    .Show(Me)
                End With

            Else

                Dim filterSrcPort As String = ""
                If selectedItem.SubItems(1).Text.Contains(":") Then _
                    filterSrcPort = selectedItem.SubItems(1).Text.Split(":")(1).Trim

                If mnuResolvePortNames.Checked Then _
                    filterSrcPort = GetPortNumber(filterSrcPort)

                With New frmPacketSpy(filterProtocol, filterSrcPort, "")
                    .Show(Me)
                End With

            End If

        End If

    End Sub

    Private Sub mnuRefresh_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mnuRefresh.Click

        timerRefresh_Tick(Nothing, Nothing)

    End Sub

    Private Sub mnuCopy_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mnuCopy.Click

        If lvNetSpy.SelectedItems.Count > 0 Then

            Try

                Dim copyData As String = lvNetSpy.SelectedItems(0).Text + vbTab
                For i As Integer = 1 To lvNetSpy.SelectedItems(0).SubItems.Count - 1

                    copyData += lvNetSpy.SelectedItems(0).SubItems(i).Text

                    If i < lvNetSpy.SelectedItems(0).SubItems.Count - 1 Then _
                        copyData += vbTab

                Next

                Clipboard.SetText(copyData, TextDataFormat.Text)

            Catch
            End Try

        End If

    End Sub

    Private Sub mnuResolveAddresses_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mnuResolveAddresses.Click

        timerRefresh_Tick(Nothing, Nothing)

    End Sub

    Private Sub mnuResolvePortNames_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mnuResolvePortNames.Click

        timerRefresh_Tick(Nothing, Nothing)

    End Sub

    Private Sub mnuShowUnconnectedEndpoints_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mnuShowUnconnectedEndpoints.Click

        timerRefresh_Tick(Nothing, Nothing)

    End Sub

    Private Sub mnuAutoRefresh0_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mnuAutoRefresh0.Click

        timerRefresh.Stop()

        mnuAutoRefresh0.Checked = True
        mnuAutoRefresh5.Checked = False
        mnuAutoRefresh15.Checked = False
        mnuAutoRefresh30.Checked = False

    End Sub

    Private Sub mnuAutoRefresh5_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mnuAutoRefresh5.Click

        timerRefresh.Interval = 5000
        timerRefresh.Start()

        mnuAutoRefresh0.Checked = False
        mnuAutoRefresh5.Checked = True
        mnuAutoRefresh15.Checked = False
        mnuAutoRefresh30.Checked = False

    End Sub

    Private Sub mnuAutoRefresh15_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mnuAutoRefresh15.Click

        timerRefresh.Interval = 15000
        timerRefresh.Start()

        mnuAutoRefresh0.Checked = False
        mnuAutoRefresh5.Checked = False
        mnuAutoRefresh15.Checked = True
        mnuAutoRefresh30.Checked = False

    End Sub

    Private Sub mnuAutoRefresh30_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mnuAutoRefresh30.Click

        timerRefresh.Interval = 30000
        timerRefresh.Start()

        mnuAutoRefresh0.Checked = False
        mnuAutoRefresh5.Checked = False
        mnuAutoRefresh15.Checked = False
        mnuAutoRefresh30.Checked = True

    End Sub

    Private Sub frmNetSpy_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load

        Dim xmlDoc As New XmlDocument

        xmlDoc.LoadXml(GetResourceString("xml_ports"))
        portNames = xmlDoc.SelectSingleNode("/ports")

    End Sub

    Private Sub frmNetSpy_Shown(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Shown

        timerRefresh_Tick(Nothing, Nothing)

    End Sub

    Private Sub lblIcon_DoubleClick(ByVal sender As Object, ByVal e As System.EventArgs) Handles lblIcon.DoubleClick

        Static frmStats As frmNetStats = Nothing
        If Not (frmStats Is Nothing) AndAlso Not frmStats.IsDisposed Then

            frmStats.Focus()

        Else

            frmStats = New frmNetStats
            frmStats.Show(Me)

        End If

    End Sub

    Private Sub lvNetSpy_DoubleClick(ByVal sender As Object, ByVal e As System.EventArgs) Handles lvNetSpy.DoubleClick

        mnuPacketSpy.PerformClick()

    End Sub

End Class

Download frmNetSpy.vb

Back to file list

---

Back to project page