Imports System
Imports System.Net
Imports System.Net.Sockets
Imports System.Threading
Imports System.Collections.Generic
 
'Installation:
'-----------------
'1.) Navigate to Windows Control Panel-> Device Manager.
'2.) Select the top most item (ex. Name-PC), right click, and Add Legacy Hardware.
'3.) When prompted choose to install the hardware you select from a list (Advanced).
'4.) Install Network Adapter-> Microsoft-> Microsoft Loopback Adapter.
 
'Configuration:
'-----------------
'1.) Navigate to Windows Control Panel-> Network and Sharing Center.
'2.) Find the option 'Change adapter settings', usually found on the top left.
'3.) Once in Network Connections, right click the Loopback Adapater and choose Properties.
'4.) (Optional) Disable everything but Internet Protocol Version 4 (TCP/IPv4).
'5.) Select Internet Protocol Version 4 and click on Properties.
'6.) Set the IP address to your target ip address and press OK.
 
'Important:
'-----------------
'Disable the adapter when not in use. Follow Configuration steps 1 to 3
'but instead of choosing Properties, click Enable/Disable instead.
 
 
'------------------
'Creator: aeonhack
'Site: elitevs.net
'Created: 7/10/2010
'Changed: 1/15/2012
'Version: 2.0.0
'------------------
Class Carrier
 
    Delegate Sub RecieveDG(ByVal connection As Interceptor, ByVal data As Byte())
    Delegate Sub ConnectionDG(ByVal connection As Interceptor)
    Delegate Sub StateChangeDG()
 
    Public ServerToClient As RecieveDG
    Public ClientToServer As RecieveDG
    Public ConnectEvent As ConnectionDG
    Public DisconnectEvent As ConnectionDG
    Public StateChange As StateChangeDG
 
    Private DisconnectFilter As ConnectionDG
 
    Private Master As Socket
    Private LocalEndPoint As IPEndPoint
    Private RemoteEndPoint As IPEndPoint
 
    Private ConnectionPool As Stack(Of Interceptor)
 
    Private _Connections As Dictionary(Of Guid, Interceptor)
    ReadOnly Property Connections As Dictionary(Of Guid, Interceptor)
        Get
            Return _Connections
        End Get
    End Property
 
    Private _Listening As Boolean
    ReadOnly Property Listening As Boolean
        Get
            Return _Listening
        End Get
    End Property
 
    Sub New()
        _Connections = New Dictionary(Of Guid, Interceptor)
        ConnectionPool = New Stack(Of Interceptor)
 
        ServerToClient = New RecieveDG(AddressOf RecieveHandler)
        ClientToServer = New RecieveDG(AddressOf RecieveHandler)
        ConnectEvent = New ConnectionDG(AddressOf ConnectionHandler)
        DisconnectEvent = New ConnectionDG(AddressOf ConnectionHandler)
        StateChange = New StateChangeDG(AddressOf StateChangeHandler)
 
        DisconnectFilter = New ConnectionDG(AddressOf DisconnectFilterHandler)
    End Sub
 
#Region " Handlers "
    Private Sub RecieveHandler(ByVal connection As Interceptor, ByVal data As Byte())
        Return
    End Sub
    Private Sub ConnectionHandler(ByVal connection As Interceptor)
        Return
    End Sub
    Private Sub StateChangeHandler()
        Return
    End Sub
 
    Private Sub DisconnectFilterHandler(ByVal connection As Interceptor)
        SyncLock Me
            _Connections.Remove(connection.GUID)
            ConnectionPool.Push(connection)
        End SyncLock
 
        DisconnectEvent(connection)
    End Sub
 
#End Region
 
    Private Function IPv4Addresses() As IPAddress()
        Dim T As New List(Of IPAddress)
 
        For Each I As IPAddress In Dns.GetHostEntry(Dns.GetHostName).AddressList
            If IsPrivateIPv4(I) Then T.Add(I)
        Next
 
        Return T.ToArray()
    End Function
    Private Function IsPrivateIPv4(ByVal address As IPAddress) As Boolean
        If Not address.AddressFamily = AddressFamily.InterNetwork Then Return False
 
        Dim I As Byte() = address.GetAddressBytes
        Return I(0) = 10 OrElse (I(0) = 172 AndAlso I(1) > 15 AndAlso I(1) < 32) OrElse (I(0) = 192 AndAlso I(1) = 168)
    End Function
 
    Sub Listen(ByVal remoteHost As String, ByVal remotePort As UShort)
        Try
            SyncLock Me
                If _Listening Then Return
                _Listening = True
 
                StateChange()
 
                LocalEndPoint = New IPEndPoint(IPv4Addresses(0), 0)
                RemoteEndPoint = New IPEndPoint(IPAddress.Parse(remoteHost), remotePort)
 
                For I As Integer = 1 To 20 'Change this for more concurrent connections.
                    ConnectionPool.Push(New Interceptor(LocalEndPoint, RemoteEndPoint, ServerToClient, ClientToServer, ConnectEvent, DisconnectFilter))
                Next
 
                Master = New Socket(AddressFamily.InterNetwork, SocketType.Stream, ProtocolType.Tcp)
                Master.Bind(RemoteEndPoint)
                Master.Listen(3)
 
                Dim E As New SocketAsyncEventArgs
                AddHandler E.Completed, AddressOf AcceptAsync
 
                If Not Master.AcceptAsync(E) Then
                    AcceptAsync(Master, E)
                End If
            End SyncLock
        Catch
            Close()
        End Try
    End Sub
 
    Private Sub AcceptAsync(ByVal sender As Object, ByVal e As SocketAsyncEventArgs)
        Try
            If e.LastOperation = SocketAsyncOperation.Accept AndAlso e.SocketError = SocketError.Success Then
                SyncLock Me
                    Dim Interceptor As Interceptor = ConnectionPool.Pop
                    _Connections.Add(Interceptor.GUID, Interceptor)
                    Interceptor.Initialize(e.AcceptSocket)
                End SyncLock
 
                e.AcceptSocket = Nothing
                If Not Master.AcceptAsync(e) Then
                    AcceptAsync(Master, e)
                End If
            Else
                Close()
            End If
        Catch
            Close()
        End Try
    End Sub
 
    Sub Close()
        SyncLock Me
            If Not _Listening Then Return
            _Listening = False
 
            Try
                Master.Close()
            Catch
                'Do Nothing
            End Try
 
            Dim E As Dictionary(Of Guid, Interceptor).Enumerator = _Connections.GetEnumerator
            While E.MoveNext
                E.Current.Value.Close()
            End While
 
            _Connections.Clear()
        End SyncLock
    End Sub
 
End Class
 
Class Interceptor
 
    Private Closing As Boolean
 
    Private ClientSocket As Socket
    Private ServerSocket As Socket
 
    Private LocalEndPoint As IPEndPoint
    Private RemoteEndPoint As IPEndPoint
 
    Private ConnectEventArgs As SocketAsyncEventArgs
    Private ServerRead As SocketAsyncEventArgs
    Private ClientRead As SocketAsyncEventArgs
 
    Private ServerRecvEvent As Carrier.RecieveDG
    Private ClientRecvEvent As Carrier.RecieveDG
    Private ConnectEvent As Carrier.ConnectionDG
    Private DisconnectEvent As Carrier.ConnectionDG
 
    Private Const BufferSize As Integer = 65535 'Change this to increase maximum packet size.
 
    Private _GUID As Guid
    ReadOnly Property GUID As Guid
        Get
            Return _GUID
        End Get
    End Property
 
    Sub New(ByVal local As IPEndPoint, ByVal remote As IPEndPoint, _
            ByVal serverRecv As Carrier.RecieveDG, _
            ByVal clientRecv As Carrier.RecieveDG, _
            ByVal connect As Carrier.ConnectionDG, _
            ByVal disconnect As Carrier.ConnectionDG)
 
        _GUID = GUID.NewGuid
 
        LocalEndPoint = local
        RemoteEndPoint = remote
 
        ServerRecvEvent = serverRecv
        ClientRecvEvent = clientRecv
        ConnectEvent = connect
        DisconnectEvent = disconnect
 
        ConnectEventArgs = New SocketAsyncEventArgs
        ConnectEventArgs.RemoteEndPoint = remote
 
        ServerRead = New SocketAsyncEventArgs
        ClientRead = New SocketAsyncEventArgs
 
        ServerRead.SetBuffer(New Byte(BufferSize - 1) {}, 0, BufferSize)
        ClientRead.SetBuffer(New Byte(BufferSize - 1) {}, 0, BufferSize)
 
        AddHandler ConnectEventArgs.Completed, AddressOf ConnectAsync
        AddHandler ServerRead.Completed, AddressOf ServerReadAsync
        AddHandler ClientRead.Completed, AddressOf ClientReadAsync
    End Sub
 
    Sub Initialize(ByVal socket As Socket)
        Try
            Closing = False
            ClientSocket = socket
 
            ServerSocket = New Socket(AddressFamily.InterNetwork, SocketType.Stream, ProtocolType.Tcp)
            ServerSocket.Bind(LocalEndPoint)
 
            If Not ServerSocket.ConnectAsync(ConnectEventArgs) Then
                ConnectAsync(ServerSocket, ConnectEventArgs)
            End If
        Catch
            Close()
        End Try
    End Sub
 
    Private Sub ConnectAsync(ByVal sender As Object, ByVal e As SocketAsyncEventArgs)
        Try
            If e.LastOperation = SocketAsyncOperation.Connect AndAlso e.SocketError = SocketError.Success Then
                ConnectEvent(Me)
 
                Dim T As New Thread(AddressOf GuaranteeClientRead)
                T.IsBackground = True
                T.Start()
 
                If Not ServerSocket.ReceiveAsync(ServerRead) Then
                    ServerReadAsync(ServerSocket, ServerRead)
                End If
            Else
                Close()
            End If
        Catch
            Close()
        End Try
    End Sub
 
    Private Sub GuaranteeClientRead()
        If Not ClientSocket.ReceiveAsync(ClientRead) Then
            ClientReadAsync(ClientSocket, ClientRead)
        End If
    End Sub
 
    Private Sub ServerReadAsync(ByVal sender As Object, ByVal e As SocketAsyncEventArgs)
        Try
            If e.LastOperation = SocketAsyncOperation.Receive AndAlso e.SocketError = SocketError.Success AndAlso e.BytesTransferred > 0 Then
                Dim Data(e.BytesTransferred - 1) As Byte
                Buffer.BlockCopy(e.Buffer, 0, Data, 0, e.BytesTransferred)
                ServerRecvEvent(Me, Data)
 
                If Not ServerSocket.ReceiveAsync(e) Then
                    ServerReadAsync(ServerSocket, e)
                End If
            Else
                Close()
            End If
        Catch
            Close()
        End Try
    End Sub
 
    Private Sub ClientReadAsync(ByVal sender As Object, ByVal e As SocketAsyncEventArgs)
        Try
            If e.LastOperation = SocketAsyncOperation.Receive AndAlso e.SocketError = SocketError.Success AndAlso e.BytesTransferred > 0 Then
                Dim Data(e.BytesTransferred - 1) As Byte
                Buffer.BlockCopy(e.Buffer, 0, Data, 0, e.BytesTransferred)
                ClientRecvEvent(Me, Data)
 
                If Not ClientSocket.ReceiveAsync(e) Then
                    ClientReadAsync(ClientSocket, e)
                End If
            Else
                Close()
            End If
        Catch
            Close()
        End Try
    End Sub
 
    Private Sub SendAsync(ByVal sender As Object, ByVal e As SocketAsyncEventArgs)
        If Not e.LastOperation = SocketAsyncOperation.Send AndAlso e.SocketError = SocketError.Success Then
            Close()
        End If
    End Sub
 
    Sub Close()
        SyncLock Me
            If Closing Then Return
            Closing = True
 
            Try
                ServerSocket.Close()
            Catch
                'Do nothing
            End Try
 
            Try
                ClientSocket.Close()
            Catch
                'Do nothing
            End Try
 
            ServerSocket = Nothing
            ClientSocket = Nothing
 
            DisconnectEvent(Me)
        End SyncLock
    End Sub
 
    Sub SendToServer(ByVal data As Byte())
        Try
            Dim E As New SocketAsyncEventArgs
            E.SetBuffer(data, 0, data.Length)
            AddHandler E.Completed, AddressOf SendAsync
 
            If Not ServerSocket.SendAsync(E) Then
                SendAsync(ServerSocket, E)
            End If
        Catch
            Close()
        End Try
    End Sub
 
    Sub SendToClient(ByVal data As Byte())
        Try
            Dim E As New SocketAsyncEventArgs
            E.SetBuffer(data, 0, data.Length)
            AddHandler E.Completed, AddressOf SendAsync
 
            If Not ClientSocket.SendAsync(E) Then
                SendAsync(ClientSocket, E)
            End If
        Catch
            Close()
        End Try
    End Sub
 
End Class