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
VB.NET多线程Socket实现简单HTTP服务
最新推荐文章于 2025-03-31 14:07:19 发布
这个博客展示了如何使用VB.NET实现一个多线程的Socket HTTP服务器。通过MonkeyServer模块,程序监听指定的IP地址和端口,接收客户端请求,并根据HTTP方法返回不同的响应。代码中详细处理了HTTP请求头的解析,包括GET方法的响应,以及错误状态码的处理。
1591

被折叠的 条评论
为什么被折叠?



