Find all our projects in development below.
All source code is GNU General Public License (GPL)
Browsing frmMain.vb (14.60 KB)
Option Explicit On
Imports System.IO
Imports System.Net
Imports System.Text.ASCIIEncoding
Imports SOAPSpy.clsPacketMonitor
Public Class frmMain
Private packetsTotal As Integer = 0
Private packetsSize As Double = 0
Private allowedList As New ArrayList
Private SOAP_BEGIN As String() = New String() {"<?xml", "<soap:"}
Private SOAP_END As String() = New String() {"</soap:Envelope>"}
Private Const FILTER_PROTOCOL As String = "Tcp"
Private Delegate Sub UpdatePacketList(ByVal p As clsPacket)
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
Public Overloads Function ReadParsedPacket(ByVal p As clsPacket) As String
Return ReadParsedPacket(ASCII.GetString(p.Raw))
End Function
Public Overloads Function ReadParsedPacket(ByVal data As String) As String
Dim ret As String = data
If ret.Contains(vbNullChar + vbNullChar) Then _
ret = ret.Substring(ret.IndexOf(vbNullChar + vbNullChar) + 2)
For Each thisBegin As String In SOAP_BEGIN
If ret.Contains(thisBegin) Then
ret = ret.Substring(ret.IndexOf(thisBegin))
Exit For
End If
Next
Return ret
End Function
Private Sub frmMain_Activated(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Activated
splitMain.BackColor = Color.FromKnownColor(KnownColor.ControlDark)
End Sub
Private Sub frmMain_Deactivate(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Deactivate
splitMain.BackColor = Color.FromKnownColor(KnownColor.InactiveBorder)
End Sub
Private Sub frmMain_FormClosing(ByVal sender As Object, ByVal e As System.Windows.Forms.FormClosingEventArgs) Handles Me.FormClosing
If mnuStopMonitoring.Enabled Then mnuStopMonitoring.PerformClick()
End Sub
Private Sub frmMain_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
Try
Dim hosts() As IPAddress = Dns.GetHostEntry(Dns.GetHostName()).AddressList
If hosts.Length = 0 Then _
Throw New NotSupportedException("This computer does not have non-loopback interfaces installed!")
For i As Integer = 0 To hosts.Length - 1
If hosts(i).AddressFamily = Sockets.AddressFamily.InterNetwork Then
Dim newMonitor As New clsPacketMonitor(hosts(i))
newMonitor.NewPacket = New NewPacketEventHandler(AddressOf Me.OnNewPacket)
Dim newItem As New ToolStripMenuItem(hosts(i).ToString(), Nothing, New EventHandler(AddressOf Me.OnHostsClick))
newItem.Tag = newMonitor
mnuMonitor.DropDown.Items.Add(newItem)
End If
Next
Catch ex As Exception
mnuMonitor.Enabled = False
lblStatus.Text = "Error: " + ex.Message
End Try
End Sub
Private Sub frmMain_Shown(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Shown
' auto start monitoring all interfaces
For Each thisItem As Object In mnuMonitor.DropDown.Items
If TypeOf thisItem Is ToolStripMenuItem AndAlso _
Not (thisItem.Tag Is Nothing) AndAlso _
TypeOf thisItem.Tag Is clsPacketMonitor Then
thisItem.PerformClick()
End If
Next
End Sub
Private Sub mnuStopMonitoring_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mnuStopMonitoring.Click
mnuStopMonitoring.Enabled = False
Me.Text = "SOAP Spy"
For Each thisItem As Object In mnuMonitor.DropDown.Items
If TypeOf thisItem Is ToolStripMenuItem AndAlso _
Not (thisItem.Tag Is Nothing) AndAlso _
TypeOf thisItem.Tag Is clsPacketMonitor Then
If thisItem.Checked Then
Dim thisMonitor As clsPacketMonitor = thisItem.Tag
thisMonitor.Stop()
thisItem.Checked = False
End If
End If
Next
allowedList.Clear()
If lblStatus.Text = "Monitoring" Then lblStatus.Text = "Ready"
End Sub
Private Sub mnuClearPackets_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mnuClearPackets.Click
SyncLock lvPacketSpy
lvPacketSpy.Items.Clear()
packetsTotal = 0
packetsSize = 0
txtPacket.Text = ""
lblStatus.Text = "Ready"
End SyncLock
End Sub
Private Sub mnuExit_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mnuExit.Click
Me.Close()
End Sub
Private Sub mnuCopyPacket_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mnuCopyPacket.Click
If lvPacketSpy.SelectedItems.Count > 0 Then
Clipboard.SetText(txtPacket.Text)
End If
End Sub
Private Sub mnuSavePacket_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mnuSavePacket.Click
If lvPacketSpy.SelectedItems.Count > 0 Then
If fileSavePacket.ShowDialog() = Windows.Forms.DialogResult.OK Then
Try
File.WriteAllText(fileSavePacket.FileName, txtPacket.Text)
Catch ex As Exception
MessageBox.Show("Unable to save the packet to file." + vbCrLf + vbCrLf + _
"Reason: " + ex.Message, Application.ProductName, MessageBoxButtons.OK, MessageBoxIcon.Error)
End Try
End If
End If
End Sub
Private Sub mnuSendRequest_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mnuSendRequest.Click
With New frmSendRequest()
.Show(Me)
End With
End Sub
Private Sub lvPacketSpy_DoubleClick(ByVal sender As Object, ByVal e As System.EventArgs) Handles lvPacketSpy.DoubleClick
mnuPopupSendRequest.PerformClick()
End Sub
Private Sub lvPacketSpy_SelectedIndexChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles lvPacketSpy.SelectedIndexChanged
If lvPacketSpy.SelectedItems.Count > 0 Then
txtPacket.Text = ReadParsedPacket(CType(lvPacketSpy.SelectedItems(0).Tag, clsPacket))
Else
txtPacket.Text = ""
End If
End Sub
Private Sub mnuPopupSendRequest_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mnuPopupSendRequest.Click
If lvPacketSpy.SelectedItems.Count > 0 Then
Dim packet As clsPacket = CType(lvPacketSpy.SelectedItems(0).Tag, clsPacket)
With New frmSendRequest(packet.DestinationAddress.ToString(), packet.DestinationPort)
.Show(Me)
End With
End If
End Sub
Private Sub mnuPopupCopyItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mnuPopupCopyItem.Click
If lvPacketSpy.SelectedItems.Count > 0 Then
Try
Dim copyData As String = lvPacketSpy.SelectedItems(0).Text + vbTab
For i As Integer = 1 To lvPacketSpy.SelectedItems(0).SubItems.Count - 1
copyData += lvPacketSpy.SelectedItems(0).SubItems(i).Text
If i < lvPacketSpy.SelectedItems(0).SubItems.Count - 1 Then _
copyData += vbTab
Next
Clipboard.SetText(copyData, TextDataFormat.Text)
Catch
End Try
End If
End Sub
Private Sub mnuPopupCopyPacket_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mnuPopupCopyPacket.Click
mnuCopyPacket.PerformClick()
End Sub
Private Sub OnHostsClick(ByVal sender As Object, ByVal e As EventArgs)
' start or stop listening on the specified interface
Dim item As ToolStripMenuItem = DirectCast(sender, ToolStripMenuItem)
Dim monitor As clsPacketMonitor = item.Tag
Dim activeCount As Integer = 0
item.Checked = Not item.Checked
For Each thisItem As Object In mnuMonitor.DropDown.Items
If TypeOf thisItem Is ToolStripMenuItem AndAlso _
Not (thisItem.Tag Is Nothing) AndAlso _
TypeOf thisItem.Tag Is clsPacketMonitor Then
If thisItem.Checked Then activeCount += 1
End If
Next
If item.Checked Then
Try
monitor.Start()
mnuStopMonitoring.Enabled = True
If activeCount = 1 Then
Me.Text = "SOAP Spy - Monitoring " + monitor.IP.ToString()
Else
Me.Text = "SOAP Spy - Monitoring multiple interfaces"
End If
lblStatus.Text = "Monitoring"
Catch ex As Exception
item.Checked = False
MessageBox.Show("Error: " + ex.Message, Application.ProductName, _
MessageBoxButtons.OK, MessageBoxIcon.Error)
End Try
Else
monitor.Stop()
If activeCount = 0 Then
mnuStopMonitoring.Enabled = False
Me.Text = "SOAP Spy"
If lblStatus.Text = "Monitoring" Then _
lblStatus.Text = "Ready"
ElseIf activeCount = 1 Then
Dim monitoringIP As String = ""
For Each thisItem As ToolStripMenuItem In mnuMonitor.DropDown.Items
If thisItem.Checked Then
Dim thisMonitor As clsPacketMonitor = thisItem.Tag
monitoringIP = thisMonitor.IP.ToString()
Exit For
End If
Next
Me.Text = "SOAP Spy - Monitoring " + monitoringIP
Else
Me.Text = "SOAP Spy - Monitoring multiple interfaces"
End If
End If
End Sub
Private Sub OnNewPacket(ByVal pm As clsPacketMonitor, ByVal p As clsPacket)
If Me.InvokeRequired Then
Me.Invoke(New NewPacketEventHandler(AddressOf OnNewPacket), pm, p)
Else
' check packet against any filters
If p.Protocol.ToString() = FILTER_PROTOCOL Then
Dim thisPacket As String = ReadParsedPacket(p)
Dim thisSource As String = p.Source
Dim bAllowed As Boolean = False
If Not thisPacket.Contains(vbNullChar) Then
If Not allowedList.Contains(thisSource) Then
For Each thisBegin As String In SOAP_BEGIN
If thisPacket.Contains(thisBegin) Then
bAllowed = True
Exit For
End If
Next
Else
bAllowed = True
End If
End If
If bAllowed Then
SyncLock lvPacketSpy
' add the new packet to the list
packetsTotal += 1
packetsSize += p.TotalLength
With lvPacketSpy.Items.Add(New ListViewItem(New String() {p.Time.ToString(), p.Source, p.Destination, p.TotalLength.ToString()}))
.Tag = p
End With
lblStatus.Text = String.Format("Intercepted {0} packet(s) [{1} byte(s)]", packetsTotal.ToString("###,##0"), packetsSize.ToString("###,##0"))
Application.DoEvents()
End SyncLock
For Each thisEnd As String In SOAP_END
If thisPacket.Contains(thisEnd) Then
bAllowed = False
Exit For
End If
Next
If bAllowed AndAlso Not allowedList.Contains(thisSource) Then
allowedList.Add(thisSource)
ElseIf Not bAllowed AndAlso allowedList.Contains(thisSource) Then
allowedList.Remove(thisSource)
End If
End If
End If
End If
End Sub
Private Sub lblFind_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles lblFind.Click
Static lastFindText As String = ""
Dim findText As String = ""
If e Is Nothing And lastFindText <> "" Then
findText = lastFindText
Else
findText = InputBox("Enter the text to find:", Application.ProductName, lastFindText)
End If
If findText <> "" Then
_showWaitCursor(True)
Dim startItem As ListViewItem = Nothing
Dim findItem As ListViewItem = Nothing
If lvPacketSpy.SelectedItems.Count > 0 Then startItem = lvPacketSpy.SelectedItems(0)
For Each thisItem As ListViewItem In lvPacketSpy.Items
If startItem Is Nothing Then
Dim thisPacket As clsPacket = thisItem.Tag
If ReadParsedPacket(thisPacket).Contains(findText) Then
findItem = thisItem
Exit For
End If
ElseIf thisItem.Equals(startItem) Then
startItem = Nothing
End If
Next
_showWaitCursor(False)
If Not (findItem Is Nothing) Then
findItem.EnsureVisible()
findItem.Selected = True
findItem.Focused = True
Else
MessageBox.Show("Cannot find """ + findText + """", Application.ProductName, _
MessageBoxButtons.OK, MessageBoxIcon.Information)
findText = ""
End If
End If
lastFindText = findText
End Sub
End Class