Webserver
This application is a simple webserver with winsocks
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
- 24th March, 2005: Initial post