Imports System.Net
Imports System.Threading
Public Class Mainform
Dim percentEncoding
As New Dictionary(Of
String,
String) Dim server As HttpListener
Dim listenerThread As Thread
Dim requestsThreads As New List(Of Thread)
#Region "Settings"
Dim port As Integer = 8080
Dim wwwRoot As String = Application.StartupPath & "\www"
Dim onlyLocal As Boolean = True
Dim defDirRes_file As String = ""
Dim defDirRes_fileIfNotFoundList As Boolean = True
#End Region
#Region "Form events"
Sub New()
InitializeComponent()
percentEncoding.Add("%20", " ")
percentEncoding.Add("%21", "!")
percentEncoding.Add("%23", "#")
percentEncoding.Add("%24", "$")
percentEncoding.Add("%26", "&")
percentEncoding.Add("%27", "'")
percentEncoding.Add("%28", "(")
percentEncoding.Add("%29", ")")
percentEncoding.Add("%2A", "*")
percentEncoding.Add("%2B", "+")
percentEncoding.Add("%2C", ",")
percentEncoding.Add("%2F", "/")
percentEncoding.Add("%3A", ":")
percentEncoding.Add("%3B", ";")
percentEncoding.Add("%3D", "=")
percentEncoding.Add("%3F", "?")
percentEncoding.Add("%40", "@")
percentEncoding.Add("%5B", "[")
percentEncoding.Add("%5D", "]")
percentEncoding.Add("%7B", "{")
percentEncoding.Add("%7D", "}")
End Sub
Private Sub Mainform_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
Dim cl As ObjectModel.ReadOnlyCollection(Of String) = My.Application.CommandLineArgs
Dim autoOpenLocalhost As Boolean = False
If cl.Count > 0 Then
Try
port = CInt(cl(0))
If port < 0 Or port > 65535 Then
appendLog("Invalid command line argument: port must be an integer between 0 and 65535.")
port = 8080
End If
Catch ex As Exception
appendLog("Invalid command line argument: port must be an integer.")
port = 8080
End Try
If cl.Count > 1 Then
wwwRoot = cl(1)
validateDir()
If cl.Count > 2 Then
Try
onlyLocal = CBool(cl(2))
Catch ex As Exception
appendLog("Invalid command line argument: the third argument (only local requests accepting) must be a boolean value (""true"" or ""false"")")
End Try
If cl.Count > 3 Then
Try
If CBool(cl(3)) Then
autoOpenLocalhost = True
End If
Catch ex As Exception
appendLog("Invalid command line argument: the third argument (opening localhost) must be a boolean value (""true"" or ""false"")")
End Try
End If
End If
End If
End If
Control.CheckForIllegalCrossThreadCalls = False
showOptions()
startServ(autoOpenLocalhost)
End Sub
Private Sub Mainform_FormClosing(ByVal sender As System.Object, ByVal e As System.Windows.Forms.FormClosingEventArgs) Handles MyBase.FormClosing
e.Cancel = Not stopServ()
End Sub
Private Sub btnStart_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnStart.Click
startServ()
End Sub
Private Sub btnStop_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnStop.Click
stopServ()
End Sub
Private Sub btnOptions_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnOptions.Click
Dim ops As New Options(port, wwwRoot, onlyLocal, defDirRes_file, defDirRes_fileIfNotFoundList)
If ops.ShowDialog() = Windows.Forms.DialogResult.OK Then
port = ops.portValue.Value
wwwRoot = ops.dirValue.Text
onlyLocal = ops.onlyLocalValue.Checked
If ops.defDirResListing.Checked Then
defDirRes_file = ""
defDirRes_fileIfNotFoundList = True
Else
defDirRes_file = ops.defDirResFileValue.Text
defDirRes_fileIfNotFoundList = ops.defDirResFileIfNotFoundListing.Checked
End If
validateDir()
showOptions()
End If
End Sub
Private Sub btnOpenLocalhost_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnOpenLocalhost.Click
openLocalhost()
End Sub
#End Region
#Region "Server start/stop"
Sub startServ(Optional ByVal autoOpenLocalhost As Boolean = False)
appendLog("Starting server...")
Try
server = New HttpListener
listenerThread = New Thread(AddressOf listener)
btnStart.Enabled = False
server.Prefixes.Clear()
server.Prefixes.Add("http://*:" & port & "/")
server.Start()
listenerThread.Start()
btnStop.Enabled = True
btnOptions.Enabled = False
appendLog("Server started.")
If autoOpenLocalhost Then
openLocalhost()
End If
Catch ex As HttpListenerException
appendLog("Error starting server. Try with a different port.")
btnStart.Enabled = True
btnStop.Enabled = False
btnOptions.Enabled = True
End Try
End Sub
Function stopServ() As Boolean
If requestsThreads.Count <> 0 Then
If MsgBox(String.Format("The server is managing {0} requests; if you stop the server, the requests will be interrupted. Continue?", requestsThreads.Count), MsgBoxStyle.YesNo) = MsgBoxResult.No Then Return False
End If
appendLog("Stopping server...")
btnStop.Enabled = False
For Each t As Thread In requestsThreads
t.Abort()
Next
requestsThreads.Clear()
listenerThread.Abort()
server.Stop()
btnStart.Enabled = True
btnOptions.Enabled = True
appendLog("Server stopped.")
Return True
End Function
#End Region
#Region "Request managment"
Sub listener()
Do
Dim c As HttpListenerContext = server.GetContext()
requestsThreads.Add(New Thread(AddressOf handleRequest))
requestsThreads(requestsThreads.Count - 1).Start(c)
Loop
End Sub
Sub handleRequest(ByVal _c As Object)
Dim c As HttpListenerContext = CType(_c, HttpListenerContext)
Dim ip As String = c.Request.RemoteEndPoint.Address.ToString()
appendLog(String.Format("Requested {0} from {1} ...", c.Request.RawUrl, ip))
Dim b() As Byte = Nothing
Dim os As IO.Stream = c.Response.OutputStream
Dim r As String = wwwRoot & c.Request.RawUrl.Replace("/", "\")
For Each i As String In percentEncoding.Keys
r = r.Replace(i, percentEncoding(i))
Next
If onlyLocal And Not (ip = "::1" Or ip = "127.0.0.1") Then
b = System.Text.Encoding.UTF8.GetBytes(formatHTML("Error", "<h1>403 Error</h1><p>This server accepts only local requests.</p>"))
c.Response.StatusCode = 403
appendLog("Request refused (403 not authorized)")
Else
If r.EndsWith("\") Then
If defDirRes_file = "" Then
answerListing(c, b, r)
Else
If Not answerFile(c, b, r & defDirRes_file) Then
If defDirRes_fileIfNotFoundList Then
answerListing(c, b, r)
Else
b = System.Text.Encoding.UTF8.GetBytes(formatHTML("Error", "<h1>404 Error</h1><p>The file you requested doesn't exists.</p>"))
c.Response.StatusCode = 404
appendLog("Request failed (404 file not found)")
End If
End If
End If
Else
If Not answerFile(c, b, r) Then
b = System.Text.Encoding.UTF8.GetBytes(formatHTML("Error", "<h1>404 Error</h1><p>The file you requested doesn't exists.</p>"))
c.Response.StatusCode = 404
appendLog("Request failed (404 file not found)")
End If
End If
End If
os.Write(b, 0, b.Length)
os.Close()
requestsThreads.Remove(Thread.CurrentThread)
Thread.CurrentThread.Abort()
End Sub
Function answerFile(ByRef c As HttpListenerContext, ByRef b As Byte(), ByVal f As String) As Boolean
If My.Computer.FileSystem.FileExists(f) Then
Try
b = My.Computer.FileSystem.ReadAllBytes(f)
appendLog(String.Format("Request answered with {0} (200 OK)", f))
Catch ex As IO.IOException
b = System.Text.Encoding.UTF8.GetBytes(formatHTML("Error", "<h1>Error: server isn't able to read the requested file.</h1>"))
appendLog("IOException: the server can't acces the file. Request answered with error message (200 OK)")
End Try
c.Response.StatusCode = 200
Return True
Else
Return False
End If
End Function
Sub answerListing(ByRef c As HttpListenerContext, ByRef b As Byte(), ByVal r As String)
Dim s As String = String.Format("<h1>Index of {0}</h1>", c.Request.RawUrl) & Environment.NewLine
If c.Request.RawUrl <> "/" Then s &= "<p><a href=""../"">../</a></p>" & Environment.NewLine
For Each d As String In My.Computer.FileSystem.GetDirectories(r)
s &= String.Format("<p><a href=""{0}"">{0}</a></p>", d.Remove(0, r.Length) & "/") & Environment.NewLine
Next
For Each f As String In My.Computer.FileSystem.GetFiles(r)
s &= String.Format("<p><a href=""{0}"">{0}</a></p>", f.Remove(0, r.Length)) & Environment.NewLine
Next
b = System.Text.Encoding.UTF8.GetBytes(formatHTML("Index of " & c.Request.RawUrl, s))
c.Response.StatusCode = 200
appendLog("Request answered with directory listing (200 OK)")
End Sub
#End Region
#Region "Utils"
Function formatHTML(ByVal title As String, ByVal body As String) As String
Return String.Format("<html><head><title>{0}</title></head><body>{1}</body></html>", title, body)
End Function
Sub appendLog(ByVal text As String)
log.AppendText(String.Format("[{0} {1}] {2}", Date.Now.ToShortDateString, Date.Now.ToLongTimeString, text) & Environment.NewLine)
End Sub
Sub showOptions()
appendLog("Port: " & port)
appendLog("Root directory: " & wwwRoot)
appendLog("Allow only local requests: " & onlyLocal.ToString())
Dim s As String = "Response for directory request: "
If defDirRes_file = "" Then
s &= "directory listing"
Else
s &= """" & defDirRes_file & """; if not found, "
If defDirRes_fileIfNotFoundList Then
s &= "directory listing"
Else
s &= "404 error"
End If
End If
appendLog(s)
End Sub
Sub validateDir()
If wwwRoot.EndsWith("\") Then wwwRoot = wwwRoot.Remove(wwwRoot.Length - 1)
If Not My.Computer.FileSystem.DirectoryExists(wwwRoot) Then
appendLog("Error: the server root directory doesn't exist; using the default directory instead.")
wwwRoot = Application.StartupPath & "\www"
End If
End Sub
Sub openLocalhost()
Process.Start("http://localhost:" & port)
End Sub
#End Region
End Class
