vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
Blitzschnelles Erstellen von grafischen Diagrammen!  
 vb@rchiv Quick-Search: Suche startenErweiterte Suche starten   Impressum  | Datenschutz  | vb@rchiv CD Vol.6  | Shop Copyright ©2000-2024
 
zurück
Rubrik: HTML/Internet/Netzwerk · Internet / Browser / IE   |   VB-Versionen: VB2005, VB200810.09.10
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:   DaveSBewertung:     [ Jetzt bewerten ]Views:  29.441 
ohne HomepageSystem:  Win2k, WinXP, Win7, Win8, Win10, Win11kein 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

Dieser Tipp wurde bereits 29.441 mal aufgerufen.

Voriger Tipp   |   Zufälliger Tipp   |   Nächster Tipp

Über diesen Tipp im Forum diskutieren
Haben Sie Fragen oder Anregungen zu diesem Tipp, können Sie gerne mit anderen darüber in unserem Forum diskutieren.

Neue Diskussion eröffnen

nach obenzurück


Anzeige

Kauftipp Unser Dauerbrenner!Diesen und auch alle anderen Tipps & Tricks finden Sie auch auf unserer aktuellen vb@rchiv  Vol.6

Ein absolutes Muss - Geballtes Wissen aus mehr als 8 Jahren vb@rchiv!
- nahezu alle Tipps & Tricks und Workshops mit Beispielprojekten
- Symbol-Galerie mit mehr als 3.200 Icons im modernen Look
Weitere Infos - 4 Entwickler-Vollversionen (u.a. sevFTP für .NET), Online-Update-Funktion u.v.m.
 
   

Druckansicht Druckansicht Copyright ©2000-2024 vb@rchiv Dieter Otter
Alle 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.

Diese Seiten wurden optimiert für eine Bildschirmauflösung von mind. 1280x1024 Pixel