I am looking to incorporate a custom HTTP server into a program I am writing to allow web access to a number of the same controls already based in the program, and I have very little experience of winsock.
I found http://www.vbforums.com/showthread.php?t=532223 here and have managed to modify the "mini webserver" file listed to fit my needs for the most part, but I think I need to modify the way it does what it does now...would appreciate some advice (and I welcome other people to use this code themselves if they wish, I've edited it to make it totally liftable by other people...and when I get it working, I'll post the edited code in the same liftable way :-))
Okay, firstly I have the winsock control "ws(0)" on the form.
"BaseData" is the data returned by the HTTP server in the headers. I'm aware that this string isn't updated (I planned to do that soon, getting it working was the important part)...and I copied the data direct from the link listed above, I've not modified it at all (although, again, I plan to sometime)Code:Private Sub Form_Load()
BaseData = "HTTP/1.0 200 OK " & vbCrLf & "Date: " & Format(Date, "DD MMMM YYYY") & " " & Format(Now, "hh:mm:ss") & " GMT" & vbCrLf & "Server: Apache/1.3.27 (Unix) PHP/4.0.6" & vbCrLf & "X-Powered-By: PHP/4.0.6" & vbCrLf & "Content-Type: text/html" & vbCrLf & "Age: 0" & vbCrLf: Debug.Print BaseData
ws(0).Listen
Me.Hide
End Sub
"endit" is a command which closes then listensCode:Private Sub ws_ConnectionRequest(Index As Integer, ByVal requestID As Long)
On Error GoTo Error
numserv = ws.Count
Load ws(numserv)
ws(Index).Close
ws(numserv).Accept requestID
DoEvents
ws(numserv).SendData BaseData
DoEvents
endit (numserv)
Error:
End Sub
Lastly is the dataarrival section...this is where the problems are, I think.Code:Private Sub endit(numserv As Integer)
On Error GoTo Error
ws(numserv).Close
ws(numserv).Listen
Error:
End Sub
I was having a problem at one point with file not sending completely so put in the do:doevents on line 4...I am sure there's a better way to do this, and would appreciate suggestions. I would guess there is some sort of .busy or something
One thing I've noticed is that on first connect I get a "document contains no data" error, which is obvious considering it sends nothing on first connect...however, I want to send something the first time and I want it to do the stuff listed in "dataarrival".Code:Private Sub ws_DataArrival(Index As Integer, ByVal bytesTotal As Long)
Dim bData As String: retdata = ""
ws(Index).GetData bData
Do: DoEvents: Loop While InStr(bData, "HTTP/1.1") = 0
f = InStr(bData, "GET"): g = InStr(f, bData, "HTTP/")
t = Mid(bData, f + 5, g - f - 6)
If t = "index.htm" Then [does stuff here]
'Should point out that all the if/then here generate a webpage in the
'string "retdata" which is then sent below
If retdata <> "" Then
'ws(Index).Accept ws(Index).Tag
DoEvents
ws(Index).SendData BaseData & vbCrLf & retdata
DoEvents
endit (Index)
End If
End Sub
I should also point out that relevant strings are public (BaseData, for instance) so all data required is accessible in all subs/functions it is required in...that's not the issue.
Any help/suggestions appreciated :-)
