前端之家收集整理的这篇文章主要介绍了
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
原文链接：https://www.f2er.com/vb/259328.html
