VB.NET多线程Socket实现简单HTTP服务
发布时间:2020-12-16 22:16:21 所属栏目:大数据 来源:网络整理
导读:Imports System.NetImports System.Net.SocketsImports System.ThreadingModule monkeyServerPrivate Const HttpVersion As String = "HTTP/1.1"Private Const WebTitle As String = "headtitleMonkey Server/title/head"Private ReadOnly ReasonPhrase4() A
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 (编辑:李大同) 【声明】本站内容均来自网络,其相关言论仅代表作者个人观点,不代表本站立场。若无意侵犯到您的权利,请及时与联系站长删除相关内容! |