Click here to Skip to main content
13,349,032 members (64,686 online)
Click here to Skip to main content
Add your own
alternative version


25 bookmarked
Posted 24 Mar 2005


, 24 Mar 2005
Rate this:
Please Sign up or sign in to vote.
This application is a simple webserver with winsocks
Sample Image - Webserver.jpg


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.


  • 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

'prepare historylist (clear), print out new message for marking the last
  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
  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"
End Sub
Private Sub cmdStopServer_Click()
  'close distributer for coming queries
  '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")
        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
    MsgBox "While sending the files an error occurred. " & _
          "The action has been aborted!", vbCritical + vbOKOnly, "ERROR"
End Sub
Private Sub wscSender_SendComplete(Index As Integer)
  'after sending close the sender
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
      '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.


  • 24th March, 2005: Initial post


This article, along with any associated source code and files, is licensed under The GNU General Public License (GPLv3)


About the Author

Konstantin Merz FFB
Web Developer
Germany Germany
My hobbies are C++(managed and not manged(i'm a total tiro at this), Visual Basic .Net, Inside Win2k, Tennis and maths.

You may also be interested in...

Comments and Discussions

GeneralAuthentication Pin
Carey H4-Jul-07 12:31
memberCarey H4-Jul-07 12:31 
GeneralRe: Authentication Pin
Member 43208446-Aug-11 17:22
memberMember 43208446-Aug-11 17:22 
Hi,I think that we Can do it in the "Sub wscSender_DataArrival()" after we check the Strrequest by the if control statement
If Mid(strRequest, 1, 3) = "GET" Then
Simply by:
Including the password and User name in the Strrequest variable or another str variable to split them from the sring variable by adding the following statements:
UName= Mid(srtRequest, , )
Pass2= Mid(StrRequest, , )
and now calling our data base of any sort to check or validate the user name and his/her password to allow continue other wise deny and send a message to ask him/her user name and password for creating member ship.

Hope this helps.
GeneralPHP Support Pin
knightcon11-Aug-06 20:16
memberknightcon11-Aug-06 20:16 
GeneralRe: PHP Support Pin
Merz_Konstantin_FFB16-Oct-06 10:21
memberMerz_Konstantin_FFB16-Oct-06 10:21 
GeneralASP NET support and file missing Pin
anonymous26-Mar-05 9:41
sussanonymous26-Mar-05 9:41 

General General    News News    Suggestion Suggestion    Question Question    Bug Bug    Answer Answer    Joke Joke    Praise Praise    Rant Rant    Admin Admin   

Use Ctrl+Left/Right to switch messages, Ctrl+Up/Down to switch threads, Ctrl+Shift+Left/Right to switch pages.

Permalink | Advertise | Privacy | Terms of Use | Mobile
Web04 | 2.8.180111.1 | Last Updated 24 Mar 2005
Article Copyright 2005 by Konstantin Merz FFB
Everything else Copyright © CodeProject, 1999-2018
Layout: fixed | fluid