Mini-Webserver unter VB.NET Eine lokale Lösung, wie man mit nur wenigen Zeilen Code einen eigenen Mini-Webserver unter VB.NET erstellen kann.
Autor:   DaveS	Bewertung:	Views:  28.297
ohne Homepage	System:  Win2k, WinXP, Vista, Win7, Win8, Win10	kein Beispielprojekt

Wir kennen alle den Webbrowser, der Http Abfragen an Google und Facebook abschickt, und Webseiten als Antwort bekommt. Aber woher kommt der Server, der diese Abfragen entgegennimmt? Es gibt Software wie Internet Information Server, gross und kompliziert, und auch kleinere Möglichkeiten, wie Cassini, der mit VS Express Web Developer mitgeliefert wird. Aber manchmal braucht man eine kleine lokale Lösung, die ohne merkbaren Aufwand eingerichtet wird und leicht angepasst werden kann. Vielleicht ein Dokument-Server im lokalen Netz oder etwas was Http-Requests von bestimmter Hardware, zB Logdateien von einem Wlan-Router empfängt und verarbeitet. Sowas kann man mit nur wenigen Zeilen schreiben. Basis dafür ist die HttpListener-Klasse.

Imports System.Threading
Imports System.Net
 
Public Class MainForm
 
  Private Const basePath As String = "HttpServerRequest"
  Private Const Port As Integer = 9090
  Private Const baseDirectory As String = "C:\Users\xxxx\Test"
 
  Private Shared validExtensions As String() = {".HTM", ".HTML"}
 
  Private listener As HttpListener
  Private mainThread As Thread
 
  Protected Overrides Sub OnFormClosing(ByVal e As _
    System.Windows.Forms.FormClosingEventArgs)
 
    ' ToDo: ensure all worker threads are ended
    listener.Abort()
    mainThread.Join()
  End Sub
 
  Protected Overrides Sub OnLoad(ByVal e As System.EventArgs)
    mainThread = New Thread(AddressOf mainRequestLoop)
    mainThread.Start()
  End Sub
 
  Private Delegate Sub updateListBoxHandler(ByVal msg As String)
 
  Public Sub UpdateListBox(ByVal msg As String)
    If InvokeRequired Then
      Invoke(New updateListBoxHandler(AddressOf UpdateListBox), New String() {msg})
    Else
      ListBox1.Items.Add(msg)
    End If
  End Sub
 
  Private Sub mainRequestLoop()
    listener = New HttpListener()
 
    ' Use Http://hostName:9090/HttpServerRequest/datei.htm
 
    listener.Prefixes.Add("Http://*:" & Port.ToString() & "/" & basePath & "/")
    listener.Start()
    Try
      Do
        Dim ctx As HttpListenerContext = listener.GetContext()
        Dim worker As New HttpRequestWorker(ctx, Me)
        ' ToDo: use threadpool threads probably better
        Dim t As New Thread(AddressOf worker.ProcessRequest)
        t.Start()
      Loop
    Catch ex As Exception
      ' MsgBox(ex.ToString())
    End Try
  End Sub

  ' Http Request Handler
  Private Class HttpRequestWorker
 
    Private context As HttpListenerContext
    Private caller As MainForm
 
    Public Sub New(ByVal context As HttpListenerContext, ByVal f As MainForm)
      Me.context = context
      caller = f
    End Sub
 
    ' Handle the request
    Public Sub ProcessRequest()
 
      Dim msg As String = context.Request.HttpMethod & " " & _
        context.Request.Url.ToString()
 
      caller.UpdateListBox(msg)
 
      Dim url As System.Uri = context.Request.Url
 
      Dim path As String = url.GetComponents(UriComponents.Path, _
        UriFormat.SafeUnescaped)
      Debug.WriteLine(path)
 
      ' Dim query As String = url.GetComponents(UriComponents.Query, UriFormat.SafeUnescaped)
      ' Debug.WriteLine(query)
 
      Dim parts(-1) As String
      Dim file As String = String.Empty
      Dim ext As String = String.Empty
      Dim response As HttpListenerResponse = context.Response
 
      Try
        Dim requestError As Boolean
 
        requestError = context.Request.HttpMethod.ToUpper() <> "GET" _
          OrElse String.IsNullOrEmpty(path)
 
        If Not requestError Then
          parts = path.Split("/")
          requestError = parts.Count <> 2 OrElse parts(0) <> basePath
        End If
 
        If Not requestError Then
          file = IO.Path.Combine(baseDirectory, parts(1))
          ext = IO.Path.GetExtension(parts(1).ToUpper())
          requestError = Not validExtensions.Contains(ext) OrElse Not IO.File.Exists(file)
        End If
 
        If Not requestError Then
          response.AddHeader("Cache-Control", "no-cache")
          response.AddHeader("Pragma", "no-cache")
          response.StatusCode = 200
 
          Dim encoding As System.Text.Encoding = System.Text.Encoding.Default
          response.ContentEncoding = encoding
         response.ContentType = "text/html"
 
          Dim responseHtml As String = IO.File.ReadAllText(file)
          Dim responseHtmlBytes() As Byte = encoding.GetBytes(responseHtml)
          response.ContentLength64 = responseHtmlBytes.Length
 
          Dim stream As IO.Stream = response.OutputStream
          stream.Write(responseHtmlBytes, 0, responseHtmlBytes.Length)
          stream.Close()
        Else
          response.StatusCode = 404
        End If
      Catch ex As Exception
        response.StatusCode = 500
      Finally
        response.Close()
      End Try
    End Sub
  End Class

  Private Sub StopButton_Click(ByVal sender As System.Object, ByVal e As _
    System.EventArgs) Handles StopButton.Click
 
    Me.Close()
  End Sub
 
End Class

Dieser Mini-WebServer serviert .htm oder .html Seiten aus dem baseDirectory Verzeichnis.
Uri wäre sowas wie http://localhost:9090/HttpServerRequest/myseite.html

Anmerkung:
Ohne Adminrechte muss die Url für den ausführenden Benutzer berechtigt werden mit dem HttpCfg (XP) oder netsh Http (wesentlich einfacher) ab Vista. z.B.:

netsh http add urlacl url=http://*:9090/HttpServerRequest/ user=RECHNERODERDOMÄNE\USER

Copyright ©2000-2023 [email protected] Dieter OtterAlle Rechte vorbehalten.

Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein.