VB.NET多线程Socket实现简单HTTP服务
来源：互联网 发布：表白视频制作软件 编辑：程序博客网 时间：2024/05/30 23:10
Imports System.NetImports System.Net.SocketsImports System.ThreadingModule monkeyServerPrivate 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 StringReturn "<html>" & WebTitle & "<body>response for GET method:" & localURI & "</body></html>"End FunctionPrivate Sub MonkeyClient(ByVal client As Socket)Dim clientBytes(4096) As ByteDim headBytes() As ByteDim responseBytes() As ByteDim requestHeads() As StringDim requestLine() As StringDim clientLen As Integer = 0Dim headLength As Integer = 0Dim statusCode As Integer = 0Dim reasonPhrase As StringDim responseHead As String = ""Dim responseBody As String = ""Console.WriteLine("Client accepted : " & client.RemoteEndPoint.ToString())DoTry clientLen = client.Receive(clientBytes, 4095, SocketFlags.None)Catch e As ExceptionConsole.WriteLine(e.Message)Exit DoEnd TryheadLength = 0For i As Integer = 0 To clientLen - 4Dim j As IntegerFor j = 0 To 3If HeadTail(j And 1) <> clientBytes(i + j) ThenExit ForEnd IfNextIf j > 3 ThenheadLength = iExit ForEnd IfNextstatusCode = 400If headLength > 0 ThenReDim headBytes(headLength)Array.Copy(clientBytes, headBytes, headLength)requestHeads = Split(Text.Encoding.UTF8.GetString(headBytes), vbCrLf)Erase headBytesrequestLine = requestHeads(0).Split(" ")If requestLine.Length = 3 ThenIf requestLine(2).ToUpper() = HttpVersion ThenstatusCode = 200reasonPhrase = "OK"Select Case requestLine(0).ToUpper()Case "GET"responseBody = responseGet(requestLine(1))Case ElsestatusCode = 501reasonPhrase = "Not Implemented"End SelectElsestatusCode = 505reasonPhrase = "HTTP Version not supported"End IfEnd IfErase requestLineErase requestHeadsEnd IfIf statusCode >= 400 And statusCode < 500 ThenreasonPhrase = ReasonPhrase4(statusCode - 400)End If'respone status lineclient.Send(Text.Encoding.UTF8.GetBytes(HttpVersion & " " & statusCode.ToString() & " " & reasonPhrase & vbCrLf))If statusCode = 200 ThenresponseBytes = Text.Encoding.UTF8.GetBytes(responseBody)responseHead &= "Content-Type:text/html;charset=UTF-8" & vbCrLfresponseHead &= "Content-Length:" & responseBytes.Length.ToString() & vbCrLfElseresponseBody = "<html>" & WebTitle & statusCode.ToString & " " & reasonPhrase & "</body></html>"responseBytes = Text.Encoding.UTF8.GetBytes(responseBody)responseHead &= "Content-Type: text/html;charset=UTF-8" & vbCrLfresponseHead &= "Content-Length: " & responseBytes.Length.ToString() & vbCrLfresponseHead &= "Connection: Close" & vbCrLfEnd If'response headclient.Send(Text.Encoding.UTF8.GetBytes(responseHead))client.Send(HeadTail)'respone bodyclient.Send(responseBytes)Erase responseBytesLoopConsole.WriteLine("client exit :" & client.RemoteEndPoint.ToString())client.Close()End SubSub MonkeyServer(ByVal localIP As IPAddress, Optional ByVal dwPort As Integer = 80)Dim clientThread As ThreadDim 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)DoclientThread = New Thread(New ParameterizedThreadStart(AddressOf MonkeyClient))clientThread.Start(server.Accept())Loopserver.Close()End SubSub Main()Console.WriteLine("Monkey Web Server")MonkeyServer(IPAddress.Parse("10.113.11.95"), 80)End SubEnd Module
