Webserver

• Download source files - 7.82 KB
• Download demo project - 10.86 KB

Introduction

This article demonstrates how you can create your own Webserver in a few steps. The webserver waits on a defined port until an instance sends a query. If the request won't be blocked there(e.g. by an IP-Blocker), the request will be forwarded to a free sender. (The number of senders is defined as mc_MaxCurrentProcesses). If this constant is 2, only 3 requests can be handled. If a request is token from a free sender, first we check if the other instance has ever sent a GET query. If it's not the case, the work of the sender is complete here. But if it's really a GET query, the queried page will be cut off in a string-operation. If the queried file exists, it'll be sent binary to the instance. Now you can see the queried file in the browser. It's also possible to divert the query, that means if the IP of the instance is blocked, the (in this example)file forbidden.htm will be binary sent to the instance.

Configuration

• Define the maximum number of operations that can be handled at the same time
• Define the port for the queries

This project uses MSWINSCK.OCX as a component. The files index.htm, forbidden.htm, and 404.htm are used in the application path:

Private Sub cmdStartServer_Click()
  On Error GoTo ERR_Catcher

'the distributer gets the port and will get ready
  wscDistributer.LocalPort = mc_Port
  wscDistributer.Listen

'prepare historylist (clear), print out new message for marking the last
  lstHistory.Clear
  lstHistory.AddItem "WebServer started (Local: http://" & _
        wscDistributer.LocalIP & ":" & wscDistributer.LocalPort & _
        "  /  http://" & wscDistributer.LocalHostName & ":" & _
        wscDistributer.LocalPort & ")"

  lstHistory.AddItem "For reachable in the Internet, please read Readme.txt "
  lstHistory.ListIndex = lstHistory.ListCount - 1

  'change active buttons
    cmdStartServer.Enabled = False
    cmdStopServer.Enabled = True
  
  Exit Sub
  
ERR_Catcher:
  MsgBox "An error happened" & vbCrLf & _
        "Another webserver is probably active and runs on port " _
	& mc_Port & "listens." & _
        vbCrLf & "Check this and try again later... " & _
        vbCrLf & _
        vbCritical + vbOKOnly, "ERROR"
  wscDistributer.Close
  End
End Sub

Private Sub cmdStopServer_Click()
  'close distributer for coming queries
    wscDistributer.Close
  
  'complete historylist
    lstHistory.AddItem "WebServer stopped"
    lstHistory.ListIndex = lstHistory.ListCount - 1
  
  'change active buttons
    cmdStartServer.Enabled = True
    cmdStopServer.Enabled = False
End Sub

Private Sub wscSender_DataArrival(Index As Integer, ByVal bytesTotal As Long)
  Dim strRequest As String        'the command sent from the Instance
  Dim intPosBegin As Integer      'startposition of the address in the command
  Dim intPosEnd As Integer        'Endposition of the address in the command
  Dim strFilePath As String       'filepath (with App.Path)
  Dim strRequestedPage As String  'filepath according to the command

  On Error GoTo ERR_Catcher
  
  'accept command of the Instance
  wscSender(Index).GetData strRequest
  
  'if it's a GET query
  If Mid(strRequest, 1, 3) = "GET" Then
  
    'cut off filepath according to the command
      intPosBegin = InStr(strRequest, "GET") + Len("GET") + 1
      intPosEnd = InStr(intPosBegin, strRequest, " ")
      strRequestedPage = Mid(strRequest, intPosBegin, intPosEnd - intPosBegin)
      If Left$(strRequestedPage, 1) = "/" Then
          strRequestedPage = Right$(strRequestedPage, Len(strRequestedPage) - 1)
      End If
    
    'checking and completion of the filepath with App.Path
      If strRequestedPage = "" Or strRequestedPage = "/" Then
        strFilePath = FileWithAppPath("index.html")
      Else
        strFilePath = FileWithAppPath(strRequestedPage)
      End If
    
    'IP-Blocker: If a blocking function is active, 
    'you'll automatically go to forbidden.htm
      If optAllButLocal.Value = True And wscSender(Index).RemoteHostIP = _
			wscSender(Index).LocalIP Then
        strFilePath = FileWithAppPath("forbidden.htm")
      End If
      If optLocal.Value = True And wscSender(Index).RemoteHostIP <> _
		wscSender(Index).LocalIP Then
        strFilePath = FileWithAppPath("forbidden.htm")
      End If
    
    'checking the existence of the file. if the file doesn't exist 
    'you'll automatically go to 404.htm
      If Dir(strFilePath) = "" Then strFilePath = FileWithAppPath("404.htm")
    
    'complete historylist with eventdetails and select last item
    lstHistory.AddItem Space(3) & Now() & "  Uhr:  " & _
            "Sendingquery (" & wscSender(Index).RemoteHostIP & "): " & _
            strFilePath & "  (" & Format(FileLen(strFilePath), "#,##0") & " Bytes)"
      lstHistory.ListIndex = lstHistory.ListCount - 1
    
    'send binary files to the instance
     wscSender(Index).SendData LoadBinary(strFilePath)
  End If
  
  Exit Sub
  
ERR_Catcher:
    MsgBox "While sending the files an error occurred. " & _
          "The action has been aborted!", vbCritical + vbOKOnly, "ERROR"
               
    wscSender(Index).Close
End Sub

Private Sub wscSender_SendComplete(Index As Integer)
  'after sending close the sender
    wscSender(Index).Close
End Sub

Private Sub wscDistributer_ConnectionRequest(ByVal requestID As Long)
  'the building of the connection can here be forbidden
  
  'check if there is a sender
  Dim i As Integer
  
  For i = 0 To mc_MaxCurrentProcesses
    If wscSender(i).State = sckClosed Then
      'if one was found, for secure it'll be closed
        wscSender(i).Close
      'and queried to accept the request
        wscSender(i).Accept requestID
        Exit For
    End If
  Next i
End Sub

'function for binary opening and reading of the file
Private Function LoadBinary(ByVal strFileName As String) As String
  Dim ff As Integer

  ff = FreeFile
  
  'the file will be opened binary
  Open strFileName For Binary As #ff
    'and the contents are returned
    LoadBinary = Input(FileLen(strFileName), #ff)
  Close #ff
End Function

Private Sub optAllButLocal_Click()
  AccessTypeChanged 0
End Sub

Private Sub optLocal_Click()
  AccessTypeChanged 1
End Sub

Private Sub optAll_Click()
  AccessTypeChanged 2
End Sub

'this function tells when an accesstype has changed
Private Sub AccessTypeChanged(ByVal i As Integer)
Dim strMessage As String
  
  Select Case i
    Case 0
      strMessage = Space(3) & Now() & " o´clock:  Access for all out of Localhost"
    Case 1
      strMessage = Space(3) & Now() & " o´clock:  Access only for Localhost"
    Case 2
      strMessage = Space(3) & Now() & " o´clock:  Access for all"
    Case Else
  End Select
  
  'complete historylist and select last item
  lstHistory.AddItem strMessage
  lstHistory.ListIndex = lstHistory.ListCount - 1
End Sub 

So that was part of the whole code.

Have fun.

History

• 24^th March, 2005: Initial post