1	#Region "Microsoft.VisualBasic::a3473a28b510eade8ad556ad3a6366ba, Microsoft.VisualBasic.Core\Net\Tcp\TcpRequest.vb"
2
3	' Author:
4	'
5	'       asuka (amethyst.asuka@gcmodeller.org)
6	'       xie (genetics@smrucc.org)
7	'       xieguigang (xie.guigang@live.com)
8	'
9	' Copyright (c) 2018 GPL3 Licensed
10	'
11	'
12	' GNU GENERAL PUBLIC LICENSE (GPL3)
13	'
14	'
15	' This program is free software: you can redistribute it and/or modify
16	' it under the terms of the GNU General Public License as published by
17	' the Free Software Foundation, either version 3 of the License, or
18	' (at your option) any later version.
19	'
20	' This program is distributed in the hope that it will be useful,
21	' but WITHOUT ANY WARRANTY; without even the implied warranty of
22	' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
23	' GNU General Public License for more details.
24	'
25	' You should have received a copy of the GNU General Public License
26	' along with this program. If not, see <http://www.gnu.org/licenses/>.
27
28
29
30	' /********************************************************************************/
31
32	' Summaries:
33
34	'     Class TcpRequest
35	'
36	'         Properties: LocalIPAddress
37	'
38	'         Constructor: (+4 Overloads) Sub New
39	'         Function: LocalConnection, OperationTimeOut, (+2 Overloads) SendMessage, ToString
40	'         Delegate Function
41	'
42	'             Function: (+4 Overloads) SendMessage
43	'
44	'             Sub: __send, ConnectCallback, (+2 Overloads) Dispose, Receive, ReceiveCallback
45	'                  SendCallback
46	'
47	'
48	'
49	' /********************************************************************************/
50
51	#End Region
52
53	Imports System.Net
54	Imports System.Net.Sockets
55	Imports System.Runtime.CompilerServices
56	Imports System.Threading
57	Imports Microsoft.VisualBasic.ApplicationServices.Debugging.ExceptionExtensions
58	Imports Microsoft.VisualBasic.Language.Default
59	Imports Microsoft.VisualBasic.Net.Http
60	Imports Microsoft.VisualBasic.Net.Protocols
61	Imports TcpEndPoint = System.Net.IPEndPoint
62
63	Namespace Net.Tcp
64
65	''' <summary>
66	''' The server socket should returns some data string to this client or this client will stuck at the <see cref="SendMessage"></see> function.
67	''' (服务器端<see cref="TcpServicesSocket"></see>必须要返回数据，否则本客户端会在<see cref="SendMessage
68	''' "></see>函数位置一直处于等待的状态)
69	''' </summary>
70	''' <remarks></remarks>
71	Public Class TcpRequest : Implements IDisposable
72
73	#Region "Internal Fields"
74
75	''' <summary>
76	''' The port number for the remote device.
77	''' </summary>
78	''' <remarks></remarks>
79	Dim port As Integer
80
81	''' <summary>
82	''' The response from the remote device.
83	''' </summary>
84	''' <remarks></remarks>
85	Dim response As Byte()
86
87	''' <summary>
88	''' ' ManualResetEvent instances signal completion.
89	''' </summary>
90	''' <remarks></remarks>
91	Dim connectDone As ManualResetEvent
92	Dim sendDone As ManualResetEvent
93	Dim receiveDone As ManualResetEvent
94	Dim __exceptionHandler As ExceptionHandler
95	Dim remoteHost As String
96
97	''' <summary>
98	''' Remote End Point
99	''' </summary>
100	''' <remarks></remarks>
101	Protected ReadOnly remoteEP As TcpEndPoint
102	#End Region
103
104	''' <summary>
105	''' Gets the IP address of this local machine.
106	''' (获取本机对象的IP地址，请注意这个属性获取得到的仅仅是本机在局域网内的ip地址，假若需要获取得到公网IP地址，还需要外部服务器的帮助才行)
107	''' </summary>
108	''' <value></value>
109	''' <returns></returns>
110	''' <remarks></remarks>
111	Public Shared ReadOnly Property LocalIPAddress As String
112	Get
113	#Disable Warning
114	Dim IP As System.Net.IPAddress = Dns.Resolve(Dns.GetHostName).AddressList(0)
115	Dim IPAddr As String = IP.ToString
116	#Enable Warning
117	Return IPAddr
118	End Get
119	End Property
120
121	Public Overrides Function ToString() As String
122	Return $"Remote_connection={remoteHost}:{port},  local_host={LocalIPAddress}"
123	End Function
124
125	Sub New(remoteDevice As TcpEndPoint, Optional exceptionHandler As ExceptionHandler = Nothing)
126	Call Me.New(remoteDevice.Address.ToString, remoteDevice.Port, exceptionHandler)
127	End Sub
128
129	Sub New(remoteDevice As IPEndPoint, Optional exceptionHandler As ExceptionHandler = Nothing)
130	Call Me.New(remoteDevice.IPAddress, remoteDevice.Port, exceptionHandler)
131	End Sub
132
133	Shared ReadOnly defaultHandler As New DefaultValue(Of ExceptionHandler)(AddressOf VBDebugger.PrintException)
134
135	''' <summary>
136	'''
137	''' </summary>
138	''' <param name="client">
139	''' Copy the TCP client connection profile data from this object.
140	''' (从本客户端对象之中复制出连接配置参数以进行初始化操作)
141	''' </param>
142	''' <param name="exceptionHandler"></param>
143	''' <remarks></remarks>
144	Sub New(client As TcpRequest, Optional exceptionHandler As ExceptionHandler = Nothing)
145	remoteHost = client.remoteHost
146	port = client.port
147	__exceptionHandler = exceptionHandler Or defaultHandler
148	remoteEP = New TcpEndPoint(System.Net.IPAddress.Parse(remoteHost), port)
149	End Sub
150
151	''' <summary>
152	'''
153	''' </summary>
154	''' <param name="remotePort"></param>
155	''' <param name="exceptionHandler">
156	''' Public <see cref="System.Delegate"/> Sub ExceptionHandler(ex As <see cref="Exception"/>)
157	''' </param>
158	''' <remarks></remarks>
159	Sub New(hostName$, remotePort%, Optional exceptionHandler As ExceptionHandler = Nothing)
160	remoteHost = hostName
161
162	If String.Equals(remoteHost, "localhost", StringComparison.OrdinalIgnoreCase) Then
163	remoteHost = LocalIPAddress
164	End If
165
166	port = remotePort
167	__exceptionHandler = exceptionHandler Or defaultHandler
168	remoteEP = New TcpEndPoint(System.Net.IPAddress.Parse(remoteHost), port)
169	End Sub
170
171	''' <summary>
172	''' 初始化一个在本机进行进程间通信的Socket对象
173	''' </summary>
174	''' <param name="localPort"></param>
175	''' <param name="exceptionHandler"></param>
176	''' <returns></returns>
177	''' <remarks></remarks>
178	'''
179	<MethodImpl(MethodImplOptions.AggressiveInlining)>
180	Public Shared Function LocalConnection(localPort%, Optional exceptionHandler As ExceptionHandler = Nothing) As TcpRequest
181	Return New TcpRequest(LocalIPAddress, localPort, exceptionHandler)
182	End Function
183
184	''' <summary>
185	''' 判断服务器所返回来的数据是否为操作超时
186	''' </summary>
187	''' <param name="str"></param>
188	''' <returns></returns>
189	''' <remarks></remarks>
190	Public Shared Function OperationTimeOut(str As String) As Boolean
191	Return String.Equals(str, NetResponse.RFC_REQUEST_TIMEOUT.GetUTF8String)
192	End Function
193
194	''' <summary>
195	''' Returns the server reply.(假若操作超时的话，则会返回<see cref="NetResponse.RFC_REQUEST_TIMEOUT"></see>)
196	''' </summary>
197	''' <param name="Message"></param>
198	''' <param name="OperationTimeOut">操作超时的时间长度，默认为30秒</param>
199	''' <returns></returns>
200	''' <remarks></remarks>
201	Public Function SendMessage(Message As String,
202	Optional OperationTimeOut As Integer = 30 * 1000,
203	Optional OperationTimeoutHandler As Action = Nothing) As String
204	Dim request As New RequestStream(0, 0, Message)
205	Dim response = SendMessage(request, OperationTimeOut, OperationTimeoutHandler).GetUTF8String
206	Return response
207	End Function 'Main
208
209	''' <summary>
210	''' Returns the server reply.(假若操作超时的话，则会返回<see cref="NetResponse.RFC_REQUEST_TIMEOUT"></see>，
211	''' 请注意，假若目标服务器启用了ssl加密服务的话，假若这个请求是明文数据，则服务器会直接拒绝请求返回<see cref="HTTP_RFC.RFC_NO_CERT"/> 496错误代码，
212	''' 所以调用前请确保参数<paramref name="Message"/>已经使用证书加密)
213	''' </summary>
214	''' <param name="Message"></param>
215	''' <param name="timeOut">操作超时的时间长度，默认为30秒</param>
216	''' <returns></returns>
217	''' <remarks></remarks>
218	Public Function SendMessage(Message As RequestStream,
219	Optional timeout% = 30 * 1000,
220	Optional timeoutHandler As Action = Nothing) As RequestStream
221
222	Dim response As RequestStream = Nothing
223	Dim bResult As Boolean = Parallel.OperationTimeOut(
224	AddressOf SendMessage,
225	[In]:=Message,
226	Out:=response,
227	TimeOut:=timeout / 1000)
228
229	If bResult Then
230	If Not timeoutHandler Is Nothing Then Call timeoutHandler() '操作超时了
231
232	If Not connectDone Is Nothing Then Call connectDone.Set()  ' ManualResetEvent instances signal completion.
233	If Not sendDone Is Nothing Then Call sendDone.Set()
234	If Not receiveDone Is Nothing Then Call receiveDone.Set() '中断服务器的连接
235
236	Dim ex As Exception = New Exception("[OPERATION_TIME_OUT] " & Message.GetUTF8String)
237	Dim ret As New RequestStream(0, HTTP_RFC.RFC_REQUEST_TIMEOUT, "HTTP/408  " & Me.ToString)
238	Call __exceptionHandler(New Exception(ret.GetUTF8String, ex))
239	Return ret
240	Else
241	Return response
242	End If
243	End Function
244
245	Public Delegate Function SendMessageInvoke(Message As String) As String
246
247	Public Function SendMessage(Message As String, Callback As Action(Of String)) As IAsyncResult
248	Dim SendMessageClient As New TcpRequest(Me, exceptionHandler:=Me.__exceptionHandler)
249	Return (Sub() Call Callback(SendMessageClient.SendMessage(Message))).BeginInvoke(Nothing, Nothing)
250	End Function
251
252	''' <summary>
253	''' This function returns the server reply for this request <paramref name="Message"></paramref>.
254	''' </summary>
255	''' <param name="Message">The client request to the server.</param>
256	''' <returns></returns>
257	''' <remarks></remarks>
258	Public Function SendMessage(Message As String) As String
259	Dim byteData As Byte() = System.Text.Encoding.UTF8.GetBytes(Message)
260	byteData = SendMessage(byteData)
261	Dim response As String = New RequestStream(byteData).GetUTF8String
262	Return response
263	End Function 'Main
264
265	''' <summary>
266	''' Send a request message to the remote server.
267	''' </summary>
268	''' <param name="Message"></param>
269	''' <returns></returns>
270	Public Function SendMessage(Message As RequestStream) As RequestStream
271	Dim byteData As Byte() = SendMessage(Message.Serialize)
272
273	If RequestStream.IsAvaliableStream(byteData) Then
274	Return New RequestStream(byteData)
275	Else
276	Return New RequestStream(0, 0, byteData)
277	End If
278	End Function
279
280	''' <summary>
281	''' 最底层的消息发送函数
282	''' </summary>
283	''' <param name="Message"></param>
284	''' <returns></returns>
285	Public Function SendMessage(Message As Byte()) As Byte()
286	If Not RequestStream.IsAvaliableStream(Message) Then
287	Message = New RequestStream(0, 0, Message).Serialize
288	End If
289
290	connectDone = New ManualResetEvent(False) ' ManualResetEvent instances signal completion.
291	sendDone = New ManualResetEvent(False)
292	receiveDone = New ManualResetEvent(False)
293	response = Nothing
294
295	' Establish the remote endpoint for the socket.
296	' For this example use local machine.
297	' Create a TCP/IP socket.
298	Dim client As New Socket(AddressFamily.InterNetwork, SocketType.Stream, ProtocolType.Tcp)
299	Call client.Bind(New System.Net.IPEndPoint(System.Net.IPAddress.Any, 0))
300	' Connect to the remote endpoint.
301	Call client.BeginConnect(remoteEP, New AsyncCallback(AddressOf ConnectCallback), client)
302	' Wait for connect.
303	Call connectDone.WaitOne()
304	' Send test data to the remote device.
305	Call __send(client, Message)
306	Call sendDone.WaitOne()
307
308	' Receive the response from the remote device.
309	Call Receive(client)
310	Call receiveDone.WaitOne()
311
312	On Error Resume Next
313
314	' Release the socket.
315	Call client.Shutdown(SocketShutdown.Both)
316	Call client.Close()
317
318	Return response
319	End Function
320
321	Private Sub ConnectCallback(ar As IAsyncResult)
322
323	' Retrieve the socket from the state object.
324	Dim client As Socket = DirectCast(ar.AsyncState, Socket)
325
326	' Complete the connection.
327	Try
328	client.EndConnect(ar)
329	' Signal that the connection has been made.
330	connectDone.Set()
331	Catch ex As Exception
332	Call __exceptionHandler(ex)
333	End Try
334	End Sub 'ConnectCallback
335
336	''' <summary>
337	''' An exception of type '<see cref="SocketException"/>' occurred in System.dll but was not handled in user code
338	''' Additional information: A request to send or receive data was disallowed because the socket is not connected and
339	''' (when sending on a datagram socket using a sendto call) no address was supplied
340	''' </summary>
341	''' <param name="client"></param>
342	Private Sub Receive(client As Socket)
343	' Create the state object.
344	Dim state As New StateObject With {
345	.workSocket = client
346	}
347
348	' Begin receiving the data from the remote device.
349	Try
350	Call client.BeginReceive(state.readBuffer, 0, StateObject.BufferSize, 0, New AsyncCallback(AddressOf ReceiveCallback), state)
351	Catch ex As Exception
352	Call Me.__exceptionHandler(ex)
353	End Try
354	End Sub 'Receive
355
356	''' <summary>
357	''' Retrieve the state object and the client socket from the asynchronous state object.
358	''' </summary>
359	''' <param name="ar"></param>
360	Private Sub ReceiveCallback(ar As IAsyncResult)
361	Dim state As StateObject = DirectCast(ar.AsyncState, StateObject)
362	Dim client As Socket = state.workSocket
363	Dim bytesRead As Integer
364
365	Try
366	' Read data from the remote device.
367	bytesRead = client.EndReceive(ar)
368	Catch ex As Exception
369	Call __exceptionHandler(ex)
370	GoTo EX_EXIT
371	End Try
372
373	If bytesRead > 0 Then
374	' There might be more data, so store the data received so far.
375	state.ChunkBuffer.AddRange(state.readBuffer.Takes(bytesRead))
376	' Get the rest of the data.
377	client.BeginReceive(state.readBuffer, 0, StateObject.BufferSize, 0, New AsyncCallback(AddressOf ReceiveCallback), state)
378	Else
379	' All the data has arrived; put it in response.
380	If state.ChunkBuffer.Count > 1 Then
381	response = state.ChunkBuffer.ToArray
382	Else
383	EX_EXIT:            response = Nothing
384	End If
385	' Signal that all bytes have been received.
386	Call receiveDone.Set()
387	End If
388	End Sub
389
390	''' <summary>
391	''' ????
392	''' An exception of type 'System.Net.Sockets.SocketException' occurred in System.dll but was not handled in user code
393	''' Additional information: A request to send or receive data was disallowed because the socket is not connected and
394	''' (when sending on a datagram socket using a sendto call) no address was supplied
395	''' </summary>
396	''' <param name="client"></param>
397	''' <param name="byteData"></param>
398	''' <remarks></remarks>
399	Private Sub __send(client As Socket, byteData As Byte())
400
401	' Begin sending the data to the remote device.
402	Try
403	Call client.BeginSend(byteData, 0, byteData.Length, 0, New AsyncCallback(AddressOf SendCallback), client)
404	Catch ex As Exception
405	Call Me.__exceptionHandler(ex)
406	End Try
407	End Sub 'Send
408
409	Private Sub SendCallback(ar As IAsyncResult)
410
411	' Retrieve the socket from the state object.
412	Dim client As Socket = DirectCast(ar.AsyncState, Socket)
413	' Complete sending the data to the remote device.
414	Dim bytesSent As Integer = client.EndSend(ar)
415	'Console.WriteLine("Sent {0} bytes to server.", bytesSent)
416	' Signal that all bytes have been sent.
417	sendDone.Set()
418	End Sub 'SendCallback
419
420	#Region "IDisposable Support"
421	Private disposedValue As Boolean ' To detect redundant calls
422
423	' IDisposable
424	Protected Overridable Sub Dispose(disposing As Boolean)
425	If Not Me.disposedValue Then
426	If disposing Then
427	' TODO: dispose managed state (managed objects).
428	Call connectDone.Set()  ' ManualResetEvent instances signal completion.
429	Call sendDone.Set()
430	Call receiveDone.Set() '中断服务器的连接
431	End If
432
433	' TODO: free unmanaged resources (unmanaged objects) and override Finalize() below.
434	' TODO: set large fields to null.
435	End If
436	Me.disposedValue = True
437	End Sub
438
439	' TODO: override Finalize() only if Dispose(      disposing As Boolean) above has code to free unmanaged resources.
440	'Protected Overrides Sub Finalize()
441	'    ' Do not change this code.  Put cleanup code in Dispose(      disposing As Boolean) above.
442	'    Dispose(False)
443	'    MyBase.Finalize()
444	'End Sub
445
446	' This code added by Visual Basic to correctly implement the disposable pattern.
447	Public Sub Dispose() Implements IDisposable.Dispose
448	' Do not change this code.  Put cleanup code in Dispose(disposing As Boolean) above.
449	Dispose(True)
450	GC.SuppressFinalize(Me)
451	End Sub
452	#End Region
453
454	End Class 'AsynchronousClient
455	End Namespace