vb.net 实现http服务器

于 2018-01-18 22:26:35 发布
阅读量5.1k 收藏 8
点赞数
分类专栏： VB

http://blog.okbase.net/vbfans/archive/819.html


作者：Eugene Popov


下载源代码：http://www.okbase.net/file/item/23112

介绍
在学习.NET编程时，我试图创建一个简单的web服务器。我有许多HTTP服务器在互联网上，但都比较复杂而且不能调用PHP和EXE文件。所以我决定写一个简单的支持PHP的WEB服务器。

编码
什么是web服务器？web服务器是从浏览器等客户端接受HTTP请求的服务器端应用程序，将HTML页面或其它内容返回给客户端。WEB客户端或浏览器创建的请求如下：
GET /about.html HTTP/1.1
Host: example.org
User-Agent: SomeBrowser/5.0
..................

服务器处理请求成功则发送名为about.html的页面（包括页面的头部信息）给客户端。

服务器的主类是一个名为HttpServer的类，包含了一些全局变量。

1
2
3
4
5
6
7
8
9
Public Class HttpServer
Private myListener As TcpListener
Dim xdoc As XDocument
Dim serverRoot As String
Dim errorMessage As String
Dim badRequest As String
Dim randObj As New Object ()
Dim active As Boolean = True
Dim SERVER_NAME As String



首先我们在类的构造函数中初始化所有全局变量，如：出错信息，侦听端口。
在指定文件里存储这些配置信息会更好，我为服务器创建了配置文件。

serverConfig.xml

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
<?xml version= "1.0" encoding= "utf-8" ?>
<configuration>
<serverName>localhost</serverName>
<Host>
<Dir>C:\EugeneServer</Dir>
<Port>5555</Port>
</Host>
<php>
<Path>c:\php</Path>
</php>
<Forbidden>
<Path>C:\EugeneServer\bin\</Path>
</Forbidden>
<Default>
<File>Index.html</File>
So on....
</Default>
<Mime>
<Values>
<Ext>.htm</Ext>
<Type>text/html</Type>
</Values>
So on...
</Mime>
</configuration>

这样所有的配置信息非常清晰：Dir是web页面的文件夹，Port是侦听端口，Forbidden是禁止访问的文件夹或文件。

在PHP区域，我们制定PHP解析器的路径，例如 c:\php，如果不想用PHP，可以将此处留空。

在构造函数中，我们将文件加载到内存并读取所有配置。

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Sub New ()
Try
'load xml-file with all configuration
xdoc = XDocument.Load(AppDomain.CurrentDomain.BaseDirectory & _
"\serverConfig.xml" )
'two messages about errors
errorMessage = "<html><body><h2>Requested file not found</h2></body></html>"
badRequest = "<html><body><h2>Bad Request</h2></body></html>"
Dim port As Integer = _
xdoc.Element( "configuration" ).Element( "Host" ).Element( "Port" ).Value
SERVER_NAME = xdoc.Element( "configuration" ).Element( "serverName" ).Value
'determine the directory of the web pages
serverRoot = _
xdoc.Element( "configuration" ).Element( "Host" ).Element( "Dir" ).Value
myListener = New TcpListener(IPAddress.Any, port)
myListener.Start()
Catch ex As Exception
End Try
End Sub

为了处理请求，我们需要一些有用的方法，我们需要从内容中获得MIME类型，同时，我们需要获得默认页。

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Private Function GetMimeType( ByVal extention As String ) As String
For Each xel As XElement In xdoc.Element_
( "configuration" ).Element( "Mime" ).Elements( "Values" )
If xel.Element( "Ext" ).Value = extention Then Return xel.Element( "Type" ).Value
Next
Return "text/html"
End Function
Private Function Get_DefaultPage( ByVal serverFolder As String ) As String
For Each xel As XElement _
In xdoc.Element( "configuration" ).Element( "Default" ).Elements( "File" )
If File.Exists(serverFolder & "\" & xel.Value) Then
Return xel.Value
End If
Next
Return ""
End Function

接下来，需要定义发送头部和内容的方法，两个方法都有socket参数指定接收者。

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Private Sub SendData( ByVal data As Byte (), ByRef sockets As Socket)
Try
sockets.Send(data, data.Length, SocketFlags.None)
Catch ex As Exception
End Try
End Sub
Private Sub SendHeader( ByVal HttpVersion As String , _
ByVal MimeType As String , ByVal totalBytes As Integer , _
ByVal statusCode As String , ByRef sockets As Socket)
Dim ss As New StringBuilder()
If MimeType = "" Then MimeType = "text/html"
ss.Append(HttpVersion)
ss.Append(statusCode).AppendLine()
ss.AppendLine( "Sever: EugeneServer" )
ss.Append( "Content-Type: " )
ss.Append(MimeType).AppendLine()
ss.Append( "Accept-Ranges: bytes" ).AppendLine()
ss.Append( "Content-Length: " )
ss.Append(totalBytes).AppendLine().AppendLine()
Dim data_ToSend As Byte () = Encoding.ASCII.GetBytes(ss.ToString())
ss.Clear()
SendData(data_ToSend, sockets)
End Sub

另外一个有意思的方法是GetCgiData，非常感谢它，PHP才能和EXE应用交互。参数有 SERVER_PROTOCOL, REFERER, REQUESTED_METHOD, USER_AGENT，就像PHP里用getenv("REQUESTED_METHOD") 或 $_SERVER['REMOTE_ADDR']获取全局变量一样。主要的工作是创建php-cgi.exe进程，接受所有全局变量，然后输出string到主线程。

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
Private Function GetCgiData( ByVal cgiFile As String , _
ByVal QUERY_STRING As String , ByVal ext As String , ByVal remote_address As String , _
ByVal SERVER_PROTOCOL As String , ByVal REFERER As String , _
ByVal REQUESTED_METHOD As String , ByVal USER_AGENT As String , _
ByVal request As String ) As String
Dim proc As New System.Diagnostics.Process()
'indicate the executable to get stdout
If ext = ".php" Then
proc.StartInfo.FileName = xdoc.Element_
( "configuration" ).Element( "php" ).Element( "Path" ).Value & "\\php-cgi.exe"
'if path to the php is not defined
If Not File.Exists(proc.StartInfo.FileName) Then
Return errorMessage
End If
proc.StartInfo.Arguments = " -q " & cgiFile & " " & QUERY_STRING
Else
proc.StartInfo.FileName = cgiFile
proc.StartInfo.Arguments = QUERY_STRING
End If
Dim script_name As String = cgiFile.Substring(cgiFile.LastIndexOf("\"c) + 1)
'Set some global variables and output parameters
proc.StartInfo.EnvironmentVariables.Add( "REMOTE_ADDR" , remote_address.ToString())
proc.StartInfo.EnvironmentVariables.Add( "SCRIPT_NAME" , script_name)
proc.StartInfo.EnvironmentVariables.Add( "USER_AGENT" , USER_AGENT)
proc.StartInfo.EnvironmentVariables.Add( "REQUESTED_METHOD" , REQUESTED_METHOD)
proc.StartInfo.EnvironmentVariables.Add( "REFERER" , REFERER)
proc.StartInfo.EnvironmentVariables.Add( "SERVER_PROTOCOL" , SERVER_PROTOCOL)
proc.StartInfo.EnvironmentVariables.Add( "QUERY_STRING" , request)
proc.StartInfo.UseShellExecute = False
proc.StartInfo.RedirectStandardOutput = True
proc.StartInfo.RedirectStandardInput = True
proc.StartInfo.CreateNoWindow = True
Dim str As String = ""
proc.Start()
str = proc.StandardOutput.ReadToEnd()
proc.Close()
proc.Dispose()
Return str
End Function


更复杂的部分 - 处理aspx页面。因此，我们需要建立Host类，ProcessFile方法传递SimpleWorkerRequest类的对象，将aspx页面传递给ASPNET环境。HttpRuntime.ProcessRequest将进行页面处理。为了得到输出，我们需要创建Host类的实例，ApplicationHost的CreateApplicationHost方法带3个参数：class类型，文件虚拟路径和物理路径。对于虚拟路径，我们设置"/",这样可以用全路径名称代替虚拟路径，方便文件处理。CreateApplicationHost通过得到的HTML输出返回Host对象。

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Imports System.Web
Imports System.Web.Hosting
Imports System.IO
Public Class Host
Inherits MarshalByRefObject
Private Function ProcessFile( ByVal filename As String , _
ByVal query_string As String ) As String
Dim sw As New StringWriter()
Dim simpleWorker As New SimpleWorkerRequest(filename, query_string, sw)
HttpRuntime.ProcessRequest(simpleWorker)
Return sw.ToString()
End Function
Public Function CreateHost( ByVal filename As String , _
ByVal serverRoot As String , ByVal query_string As String ) As String
Dim myHost As Host = CType (ApplicationHost.CreateApplicationHost_
( GetType (Host), "/" , serverRoot), Host)
Return myHost.ProcessFile(filename, query_string)
End Function
End Class

最好是建立包含类的独立库然后添加到工程中，最好是添加到GAC。Mu web服务器从GAC使用该库并作为windows服务运行。
另外一种使用方法（在GAC中不存在）- 使用该库的控制台服务器位于相同的目录下。该方式我们必须在web页面文件夹（由配置文件的Dir指定）中创建bin目录，并将库放在bin目录下。但是有一个缺点，虽然很多网上的WEB服务器（VBNET和C#）用这种方式来访问ASP NET，我没办法管理aspx页面后面的工作代码。

HttpServer类的主要部分是HttpThread方法，结合了上述的所有方法.
首先，我们从客户端得到请求并进行解码。

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Private Sub HttpThread( ByVal sockets As Socket)
Dim request As String
Dim requestedFile As String = ""
Dim mimeType As String = ""
Dim filePath As String = ""
Dim QUERY_STRING As String = ""
Dim REQUESTED_METHOD As String = ""
Dim REFERER As String = ""
Dim USER_AGENT As String = ""
Dim SERVER_PROTOCOL As String = "HTTP/1.1"
Dim erMesLen As Integer = errorMessage.Length
Dim badMesLen As Integer = badRequest.Length
Dim logStream As StreamWriter
Dim remoteAddress As String = ""
If sockets.Connected = True Then
remoteAddress = sockets.RemoteEndPoint.ToString()
Dim received() As Byte = New Byte (1024) {}
Dim i As Integer = sockets.Receive(received, received.Length, 0)
Dim sBuffer As String = Encoding.ASCII.GetString(received)
If sBuffer = "" Then
sockets.Close()
Exit Sub
End If

确认是HTTP请求，并得到其版本，请求方法和其他一些参数。

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
Dim startPos As Integer = sBuffer.IndexOf( "HTTP" , 1)
If startPos = -1 Then
SendHeader(SERVER_PROTOCOL, "" , badMesLen, "400 Bad Request" , sockets)
SendData(badRequest, sockets)
sockets.Close()
Exit Sub
Else
SERVER_PROTOCOL = sBuffer.Substring(startPos, 8)
End If
Dim params() As String = sBuffer.Split( New Char () {vbNewLine})
For Each param As String In params
If param.Trim.StartsWith( "User-Agent" ) Then
USER_AGENT = param.Substring(12)
ElseIf param.Trim.StartsWith( "Referer" ) Then
REFERER = param.Trim.Substring(9)
End If
Next
'Get request method. If POST then there is a query with
'parameters at the request body
REQUESTED_METHOD = sBuffer.Substring(0, sBuffer.IndexOf( " " ))
Dim lastPos As Integer = sBuffer.IndexOf( "/" c) + 1
request = sBuffer.Substring(lastPos, startPos - lastPos - 1)
Select Case REQUESTED_METHOD
Case "POST"
requestedFile = request.Replace( "/" , "\").Trim()
QUERY_STRING = params(params.Length - 1).Trim()
Exit Select
Case "GET"
lastPos = request.IndexOf( "?" c)
If lastPos > 0 Then
requestedFile = request.Substring(0, lastPos).Replace( "/" , "\")
QUERY_STRING = request.Substring(lastPos + 1)
Else
requestedFile = request.Substring(0).Replace( "/" , "\")
End If
Exit Select
Case "HEAD" : Exit Select
Case Else
SendHeader(SERVER_PROTOCOL, "" , badMesLen, "400 Bad Request" , sockets)
SendData(badRequest, sockets)
sockets.Close()
Exit Sub
End Select


获取所需的文件的全名。 如果请求的文件禁止访问，或者没有这样的文件，我们发送错误消息。

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
If requestedFile.Length = 0 Then
requestedFile = Get_DefaultPage(serverRoot)
If requestedFile = "" Then
SendHeader(SERVER_PROTOCOL, "" , erMesLen, "404 Not Found" , sockets)
SendData(errorMessage, sockets)
End If
End If
filePath = serverRoot & "\" & requestedFile
For Each forbidden As XElement In xdoc.Element_
( "configuration" ).Element( "Forbidden" ).Elements( "Path" )
If filePath.StartsWith(forbidden.Value) Then
SendHeader(SERVER_PROTOCOL, "" , erMesLen, "404 Not Found" , sockets)
SendData(errorMessage, sockets)
sockets.Close()
Exit Sub
End If
Next
If File.Exists(filePath) = False Then
SendHeader(SERVER_PROTOCOL, "" , erMesLen, "404 Not Found" , sockets)
SendData(errorMessage, sockets)
Else
Dim ext As String = New FileInfo(filePath).Extension.ToLower()
mimeType = GetMimeType(ext)


处理web页面

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
If ext = ".aspx" Then
'Create object of the ASPClass
Dim aspxHost As New ASPClass()
'Pass the filename to it and return the html output
Dim htmlOut As String = aspxHost.CreateHost(requestedFile, serverRoot)
erMesLen = htmlOut.Length
SendHeader(SERVER_PROTOCOL, mimeType, erMesLen, " 200 OK" , sockets)
SendData(htmlOut, sockets)
ElseIf ext = ".php" OrElse ext = ".exe" Then
Dim cgi2html As String = GetCgiData(filePath, QUERY_STRING, ext, _
sockets.RemoteEndPoint, SERVER_PROTOCOL, REFERER, REQUESTED_METHOD, _
USER_AGENT)
If cgi2html = errorMessage Then
SendHeader(SERVER_PROTOCOL, "" , _
erMesLen, "404 Not Found" , sockets)
SendData(errorMessage, sockets)
Else
erMesLen = cgi2html.Length
SendHeader(SERVER_PROTOCOL, mimeType, _
erMesLen, " 200 OK" , sockets)
SendData(cgi2html, sockets)
End If
Else
Dim fs As New FileStream(filePath, FileMode.Open, _
FileAccess.Read, FileShare.Read)
Dim bytes() As Byte = New Byte (fs.Length) {}
erMesLen = bytes.Length
fs.Read(bytes, 0, erMesLen)
fs.Close()
SendHeader(SERVER_PROTOCOL, mimeType, erMesLen, "200 OK" , sockets)
SendData(bytes, sockets)
End If
End If
sockets.Close()

最后服务器输出到LOG文件，为了避免文件冲突，我们应该使用黑名单监视。

1
2
3
4
5
6
7
8
9
10
11
Monitor.Enter(randObj)
logStream = New StreamWriter( "Server.log" , True )
logStream.WriteLine( Date .Now.ToString())
logStream.WriteLine( "Connected to {0}" , sockets.RemoteEndPoint)
logStream.WriteLine( "Requested path {0}" , request)
logStream.WriteLine( "Total bytes {0}" , erMesLen)
logStream.Flush()
logStream.Close()
Monitor. Exit (randObj)
End If
End Sub

最后，我们需要一些代码来启动和停止服务器。

1
2
3
4
5
6
7
8
9
10
11
Protected Friend Sub StartListen()
While active = True
Dim sockets As Socket = myListener.AcceptSocket()
Dim listening As New Thread( AddressOf HttpThread)
listening.Start(sockets)
End While
End Sub
Protected Friend Sub StopListen()
active = False
End Sub
End Class


最后一件事，在Windows服务中用Run方法调用该简单的服务器，启动OnStart方法。

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Public Class EugeneServer
Inherits System.ServiceProcess.ServiceBase
Dim myServer As HttpServer
Public Sub New ()
Me .ServiceName = "EugeneServer"
Me .CanStop = True
Me .CanPauseAndContinue = True
Me .AutoLog = True
End Sub
Shared Sub Main()
System.ServiceProcess.ServiceBase.Run( New EugeneServer)
End Sub
Protected Overrides Sub OnStart( ByVal args() As String )
myServer = New HttpServer()
Dim thread As New Thread( New ThreadStart( AddressOf myServer.StartListen))
thread.Start()
End Sub
Protected Overrides Sub OnStop()
myServer.StopListen()
Threading.Thread.Sleep(1000)
myServer = Nothing
End Sub
End Class


文件中，有两个类型的项目：Windows服务和控制台应用，功能是一样的。我们可以使用IstallUtil.exe并添加ASPX.dll到GAC中来安装服务。控制台程序不需要安装便可安装。

结论

以上是所有关于这个小型web服务器的内容。当然，它很难用在实际的工作环境中，因为它有待完善。 但我发现它在对一些脚本进行调试时很有用。可以更好地理解Web服务器的工作原理。 感谢您阅读这篇文章。


回马枪逛逛
关注
  • 0
    点赞
  • 踩
  • 8
    收藏
    觉得还不错? 一键收藏
  • 0
    评论
专栏目录
评论
添加红包

请填写红包祝福语或标题

个

红包个数最小为10个

元

红包金额最低5元

当前余额3.43元 前往充值 >
需支付：10.00元
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付元
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明：

1.余额是钱包充值的虚拟货币，按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载，可以购买VIP、付费专栏及课程。

余额充值