TCPIP通讯转发

最近需要研究一个通讯，监视抓包的工具感觉不是很直观，网上找到的工具只能转发却看不到数据包内容，实在忍不了了。代码只能达到能用的层度，发生错误重连的功能暂时没有，也不打算写了，临时用一下而已。有需要的可以借鉴一下。vs2019编写，vb.net.接收端为Listener监听，转发目的端为客户端 tcpclient,使用的时候请注意功能的选择和配置。   客户端<--&gt;服务端<--&gt;客户端<--&gt;服务端

Imports System.Net
Imports System.Net.Sockets
Imports System.IO
Public Class FrmTrack
    Dim LocalListener As TcpListener
    Dim LocalPort As Integer = 5000
    Dim LocalPoint As IPEndPoint

    Dim Detination_Client As TcpClient
    Dim Destination_Port As Integer = 5001
    Dim Destination_Point As IPEndPoint
    Private Sub BtnControl_Click(sender As Object, e As EventArgs) Handles btnControl.Click
        LocalPort = CInt(txtLocalPort.Text)
        LocalPoint = New IPEndPoint(IPAddress.Parse(txtLocalIP.Text), LocalPort)

        Destination_Port = CInt(txtDestinationPort.Text)
        Destination_Point = New IPEndPoint(IPAddress.Parse(txtDestinationIP.Text), Destination_Port)

        StartListenWork = New StartListenDelegate(AddressOf StartListen)
        StartListenWork.BeginInvoke(Nothing, Nothing)
        ConnectDestinationIPWork = New ConnectDestinationIPDelegate(AddressOf ConnectDestinationIP)
        ConnectDestinationIPWork.BeginInvoke(Nothing, Nothing)
    End Sub

    Private Delegate Sub StartListenDelegate()
    Private StartListenWork As StartListenDelegate
    Private Sub StartListen()
        LocalListener = New TcpListener(LocalPoint)
        AddRunMessage（String.Format("监听已开启{0}", LocalListener.LocalEndpoint.ToString())）
        ' While True
        LocalListener.Start()
            Dim Source_Client As TcpClient
            Source_Client = LocalListener.AcceptTcpClient()
            AddRunMessage（Source_Client.Client.RemoteEndPoint.ToString & "已连接。")
        Dim ReceiveDataWork As New ReceiveDataDelegate(AddressOf ReceiveData)
        ReceiveDataWork.BeginInvoke(Source_Client, Detination_Client, Nothing, Nothing)
        ReceiveDataWork = New ReceiveDataDelegate(AddressOf ReceiveData)
        ReceiveDataWork.BeginInvoke(Detination_Client, Source_Client, Nothing, Nothing)
        ' End While
    End Sub
    Private Sub AddRunMessage(msg As String)
        If track = False Then Return
        If InvokeRequired = True Then
            Invoke(New Action(Of String)(AddressOf AddRunMessage), msg)
        Else
            ListBox_Track.Items.Insert(0,
                    String.Format("{0}：{1}", DateTime.Now, msg))
        End If
    End Sub
    Private Delegate Sub ConnectDestinationIPDelegate()
    Private ConnectDestinationIPWork As ConnectDestinationIPDelegate
    Private Sub ConnectDestinationIP()
        Try
            Detination_Client = New TcpClient
            Detination_Client.ReceiveTimeout = 500
            Detination_Client.SendTimeout = 500
            Detination_Client.ExclusiveAddressUse = True
            Detination_Client.NoDelay = True
            Detination_Client.Connect(Destination_Point)
            AddRunMessage（Detination_Client.Client.RemoteEndPoint.ToString & "已连接。"）
        Catch ex As Exception
            AddRunMessage（ex.Message)
        End Try
    End Sub
    Private Delegate Sub ReceiveDataDelegate(Source_Client As TcpClient, Detination_Client As TcpClient)
    Private Sub ReceiveData(Source_Client As TcpClient, Detination_Client As TcpClient)
        Try
            Dim DataArray As New List(Of Byte)
            While True
                Dim buffer(3) As Byte
                Dim iar As IAsyncResult = Source_Client.Client.BeginReceive(buffer,
                    0,
                    buffer.Length,
                    SocketFlags.None,
                    Nothing,
                    Nothing)
                Source_Client.Client.EndReceive(iar)
                Dim lenBytes As IEnumerable(Of Byte) = buffer.Reverse
                Dim len As Long = BitConverter.ToInt32(lenBytes.ToArray, 0)
                DataArray.AddRange(buffer)
                If len = 0 Then
                    Throw New Exception(Source_Client.Client.RemoteEndPoint.ToString & "已断开。")
                End If
                Dim Count As Integer = DataArray.Count
                Do While DataArray.Count - Count < len
                    Dim ReadBytes As Byte() = ReadData(Source_Client)
                    If ReadBytes IsNot Nothing Then
                        DataArray.AddRange(ReadBytes)
                    Else
                        Exit Do
                    End If
                Loop
                If Detination_Client IsNot Nothing AndAlso Detination_Client.Connected Then
                    Write（Detination_Client, DataArray.ToArray）
                    AddRunMessage(Source_Client.Client.RemoteEndPoint.ToString & "-->" & Detination_Client.Client.RemoteEndPoint.ToString & "[" & Bytes_to_HexString(DataArray) & "]")
                End If
                DataArray.Clear()
            End While
        Catch ex As Exception
            AddRunMessage（ex.Message)
        End Try

    End Sub
    Private Sub Write(Connect_Client As TcpClient， bytes As Byte())
        Dim writeBytes As Byte() = bytes
        Dim myNetworkStream As NetworkStream
        myNetworkStream = Connect_Client.GetStream
        myNetworkStream.Write(writeBytes, 0, writeBytes.Length)
        myNetworkStream.Flush()
    End Sub
    Private Function ReadData(Connect_Client As TcpClient） As Byte()
        Dim Client_Stream As NetworkStream
        Client_Stream = Connect_Client.GetStream
        Dim k As Integer = Connect_Client.Available
        Dim startTime As Date = Now
        Dim Count As Integer = 0
        While k = 0
            k = Connect_Client.Available
            Threading.Thread.Sleep(1)
            If Count > 2000 Then
                AddRunMessage("接收文件超时放弃当前文件。")
                Return Nothing
            End If
        End While
        Dim myBufferBytes(k - 1) As Byte
        Client_Stream.Read(myBufferBytes, 0, k)
        Client_Stream.Flush()
        Return myBufferBytes
    End Function
    Private Function Bytes_to_HexString(DataArray As List(Of Byte)) As String
        Dim HexString As String = ""
        For Each Num As Byte In DataArray
            HexString = HexString & " " & Hex(Num).PadLeft(2, "0")
        Next
        Return HexString
    End Function

    Private Sub ListBox_Track_SelectedIndexChanged(sender As Object, e As EventArgs) Handles ListBox_Track.SelectedIndexChanged
        If ListBox_Track.SelectedItem IsNot Nothing Then txt_Detail.Text = ListBox_Track.SelectedItem.ToString
    End Sub

    Private Sub FrmTrack_Load(sender As Object, e As EventArgs) Handles MyBase.Load

    End Sub

    Private Sub 清除ToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles 清除ToolStripMenuItem.Click
        ListBox_Track.Items.Clear()
    End Sub
    Dim track As Boolean = True
    Private Sub BtnTrack_Click(sender As Object, e As EventArgs) Handles btnTrack.Click
        track = Not track
        btnTrack.Text = "Track-" & track.ToString
    End Sub
End Class