TCPIP通讯转发

实例介绍

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

from clipboard

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

标签： tcpIP tcp 通讯 IP

实例下载地址

点此下载实例

不能下载？内容有错？点击这里报错 + 投诉 + 提问

好例子网口号：伸出你的我的手 — 分享！

网友评论

我要评论

小贴士

感谢您为本站写下的评论，您的评论对其它用户来说具有重要的参考价值，所以请认真填写。

类似“顶”、“沙发”之类没有营养的文字，对勤劳贡献的楼主来说是令人沮丧的反馈信息。
相信您也不想看到一排文字/表情墙，所以请不要反馈意义不大的重复字符，也请尽量不要纯表情的回复。
提问之前请再仔细看一遍楼主的说明，或许是您遗漏了。
请勿到处挖坑绊人、招贴广告。既占空间让人厌烦，又没人会搭理，于人于己都无利。

关于好例子网

本站旨在为广大IT学习爱好者提供一个非营利性互相学习交流分享平台。本站所有资源都可以被免费获取学习研究。本站资源来自网友分享，对搜索内容的合法性不具有预见性、识别性、控制性，仅供学习研究，请务必在下载后24小时内给予删除，不得用于其他任何用途，否则后果自负。基于互联网的特殊性，平台无法对用户传输的作品、信息、内容的权属或合法性、安全性、合规性、真实性、科学性、完整权、有效性等进行实质审查；无论平台是否已进行审查，用户均应自行承担因其传输的作品、信息、内容而可能或已经产生的侵权或权属纠纷等法律责任。本站所有资源不代表本站的观点或立场，基于网友分享，根据中国法律《信息网络传播权保护条例》第二十二与二十三条之规定，若资源存在侵权或相关问题请联系本站客服人员，点此联系我们。关于更多版权及免责申明参见版权及免责申明

TCPIP通讯转发

同类人气实例

实例介绍

实例下载地址