vb.net 實現http伺服器
http://blog.okbase.net/vbfans/archive/819.html
作者：Eugene Popov
介紹
在學習.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,
"", _
|