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
版权声明:本文内容由互联网用户自发贡献,该文观点与技术仅代表作者本人。本站仅提供信息存储空间服务,不拥有所有权,不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容, 请发送邮件至 dio@foxmail.com 举报,一经查实,本站将立刻删除。