VB.NET多线程Socket实现简单HTTP服务

Imports System.Net
Imports System.Net.Sockets
Imports System.Threading

Module monkeyServer

	Private Const HttpVersion As String = "HTTP/1.1"
	Private Const WebTitle As String = "<head><title>Monkey Server</title></head>"
	Private ReadOnly ReasonPhrase4() As String = {"Bad Request", "Unauthorized", "", "Forbidden", "Not Found", " Method Not Allowed", "Not Acceptable"}
	Private ReadOnly HeadTail() As Byte = {13, 10}

	Private Function responseGet(ByVal localURI As String) As String
		Return "<html>" & WebTitle & "<body>response for GET method:" & localURI & "</body></html>"
	End Function

	Private Sub MonkeyClient(ByVal client As Socket)
		Dim clientBytes(4096) As Byte
		Dim headBytes() As Byte
		Dim responseBytes() As Byte
		Dim requestHeads() As String
		Dim requestLine() As String
		Dim clientLen As Integer = 0
		Dim headLength As Integer = 0
		Dim statusCode As Integer = 0
		Dim reasonPhrase As String
		Dim responseHead As String = ""
		Dim responseBody As String = ""
		Console.WriteLine("Client accepted : " & client.RemoteEndPoint.ToString())
		Do
			Try 
				clientLen = client.Receive(clientBytes, 4095, SocketFlags.None)
			Catch e As Exception
				Console.WriteLine(e.Message)
				Exit Do
			End Try
			headLength = 0
			For i As Integer = 0 To clientLen - 4
				Dim j As Integer
				For j = 0 To 3
					If HeadTail(j And 1) <> clientBytes(i + j) Then
						Exit For
					End If
				Next
				If j > 3 Then
					headLength = i
					Exit For
				End If
			Next
			statusCode = 400
			If headLength > 0 Then
				ReDim headBytes(headLength)
				Array.Copy(clientBytes, headBytes, headLength)
				requestHeads = Split(Text.Encoding.UTF8.GetString(headBytes), vbCrLf)
				Erase headBytes
				requestLine = requestHeads(0).Split(" ")
				If requestLine.Length = 3 Then
					If requestLine(2).ToUpper() = HttpVersion Then
						statusCode = 200
						reasonPhrase = "OK"
						Select Case requestLine(0).ToUpper()
							Case "GET"
								responseBody = responseGet(requestLine(1))
							Case Else
								statusCode = 501
								reasonPhrase = "Not Implemented"
						End Select
					Else
						statusCode = 505
						reasonPhrase = "HTTP Version not supported"
					End If
				End If
				Erase requestLine
				Erase requestHeads
			End If
			If statusCode >= 400 And statusCode < 500 Then
				reasonPhrase = ReasonPhrase4(statusCode - 400)
			End If
			'respone status line
			client.Send(Text.Encoding.UTF8.GetBytes(HttpVersion & " " & statusCode.ToString() & " " & reasonPhrase & vbCrLf))
			If statusCode = 200 Then
				responseBytes = Text.Encoding.UTF8.GetBytes(responseBody)
				responseHead &= "Content-Type:text/html;charset=UTF-8" & vbCrLf
				responseHead &= "Content-Length:" & responseBytes.Length.ToString() & vbCrLf
			Else
				responseBody = "<html>" & WebTitle & statusCode.ToString & " " & reasonPhrase & "</body></html>"
				responseBytes = Text.Encoding.UTF8.GetBytes(responseBody)
				responseHead &= "Content-Type: text/html;charset=UTF-8" & vbCrLf
				responseHead &= "Content-Length: " & responseBytes.Length.ToString() & vbCrLf
				responseHead &= "Connection: Close" & vbCrLf

			End If
			'response head
			client.Send(Text.Encoding.UTF8.GetBytes(responseHead))
			client.Send(HeadTail)
			'respone body
			client.Send(responseBytes)
			Erase responseBytes
		Loop
		Console.WriteLine("client exit :" & client.RemoteEndPoint.ToString())
		client.Close()
	End Sub

	Sub MonkeyServer(ByVal localIP As IPAddress, Optional ByVal dwPort As Integer = 80)
		Dim clientThread As Thread
		Dim server As New Socket(AddressFamily.InterNetwork, SocketType.Stream, ProtocolType.Tcp)
		server.Bind(New IPEndPoint(localIP, dwPort))
		Console.WriteLine("Local listening : " & server.LocalEndPoint.ToString())
		server.Listen(3)
		Do
			clientThread = New Thread(New ParameterizedThreadStart(AddressOf MonkeyClient))
			clientThread.Start(server.Accept())
		Loop
		server.Close()
	End Sub

	Sub Main()
		Console.WriteLine("Monkey Web Server")
		MonkeyServer(IPAddress.Parse("10.113.11.95"), 80)
	End Sub

End Module