实例介绍
最近需要研究一个通讯,监视抓包的工具感觉不是很直观,网上找到的工具只能转发却看不到数据包内容,实在忍不了了。代码只能达到能用的层度,发生错误重连的功能暂时没有,也不打算写了,临时用一下而已。有需要的可以借鉴一下。vs2019编写,vb.net.接收端为Listener监听,转发目的端为客户端 tcpclient,使用的时候请注意功能的选择和配置。 客户端<-->服务端<-->客户端<-->服务端
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
小贴士
感谢您为本站写下的评论,您的评论对其它用户来说具有重要的参考价值,所以请认真填写。
- 类似“顶”、“沙发”之类没有营养的文字,对勤劳贡献的楼主来说是令人沮丧的反馈信息。
- 相信您也不想看到一排文字/表情墙,所以请不要反馈意义不大的重复字符,也请尽量不要纯表情的回复。
- 提问之前请再仔细看一遍楼主的说明,或许是您遗漏了。
- 请勿到处挖坑绊人、招贴广告。既占空间让人厌烦,又没人会搭理,于人于己都无利。
关于好例子网
本站旨在为广大IT学习爱好者提供一个非营利性互相学习交流分享平台。本站所有资源都可以被免费获取学习研究。本站资源来自网友分享,对搜索内容的合法性不具有预见性、识别性、控制性,仅供学习研究,请务必在下载后24小时内给予删除,不得用于其他任何用途,否则后果自负。基于互联网的特殊性,平台无法对用户传输的作品、信息、内容的权属或合法性、安全性、合规性、真实性、科学性、完整权、有效性等进行实质审查;无论平台是否已进行审查,用户均应自行承担因其传输的作品、信息、内容而可能或已经产生的侵权或权属纠纷等法律责任。本站所有资源不代表本站的观点或立场,基于网友分享,根据中国法律《信息网络传播权保护条例》第二十二与二十三条之规定,若资源存在侵权或相关问题请联系本站客服人员,点此联系我们。关于更多版权及免责申明参见 版权及免责申明
网友评论
我要评论