Remember that HTTP server I tried making? Well, yeh, that went out the window, but now, for EM, I'm trying to make a HTTP admin console, I can do anything (when the request is /stop, it shows the stop prompt screen, etc.) *EXCEPT* read files.
Yeah VB6 is really shit for file handling, remember we discovered its limit with my little web server. I don't know any ways of getting around it though.
What you're about to see is some HTTP fucked up code. Enjoy :P
I've tried to comment it through, but some times I just gave up.
I've outlined the piece of code with "'''''''''''''''''' HERE!!! ''''''''''''''''''''''''"
Have fun now.
' Upon HTTP socket receive.
Private Sub wsk_HTTP_DataArrival(Index As Integer, ByVal bytesTotal As Long)
Dim Data As String
wsk_HTTP(Index).GetData Data
HTTP_Data(Index) = HTTP_Data(Index) & Data
If Replace(HTTP_Data(Index), vbNewLine + vbNewLine, "") <> HTTP_Data(Index) Then
' HTML Template
Template = "<html>" + vbNewLine + "<head>" + vbNewLine + "<title> :: JuleOS Basix IM Server HTTP Admin :: %%TITLE%% ::</title>" + vbNewLine + "<style>" + vbNewLine + "<!--" + vbNewLine + vbNewLine + "body { font-family: Tahoma,Arial; font-size: 10pt; }" + vbNewLine + vbNewLine + "-->" + vbNewLine + "</style>" + vbNewLine + "</head>" + vbNewLine + vbNewLine + "<body>" + vbNewLine + "%%CONTENT%%" + vbNewLine + "%%SIG%%" + vbNewLine + "</body>" + vbNewLine + "</html>" + vbNewLine
' Errors
Dim Error404 As String
Error404 = "<h2>Not Found</h2>" + vbNewLine + "<p>The file '%%PAGE%%' could not be found.</p>"
' Signatures
Dim ServerSig As String
ServerSig = vbNewLine + "<hr>" + vbNewLine + "<i>JuleOS Basix IM Server (HTTP Admin) version " & App.Major & "." & App.Minor & "." & App.Revision & "</i>"
' Sort data
Dim Page As String
Page = "/error404"
Dim temp() As String
temp = Split(HTTP_Data(Index), " ")
If UBound(temp) > 1 Then
' Set 'Page' and remove a new line if the request finishes there
Page = Replace(temp(1), vbNewLine, "")
End If
Dim OK As Boolean
Dim HTTPOut As String
Dim HTTPHeader As String
Dim HTMLTitle As String
OK = True
HTTPOut = ""
HTTPHeader = ""
HTMLTitle = "Web Page"
' Create Directory Structure
Dim DirStruct() As String
DirStruct = Split(Page, "/")
Dim GoAction As String
GoAction = ""
' Content-type header
Dim ContentType As String
' Default to text/html
ContentType = "text/html"
' Use Template?
' By default, yes.
Dim UseTemplate As Boolean
UseTemplate = True
' Check through pages
If Page = "/" Then
start = "P"
If Paused = True Then
start = "Un-p"
End If
HTTPOut = "<p>Server status: <b>" + lblStatus.Caption + "</b><br /><b>Online</b> = Server is accepting requests<br /><b>Paused</b> = Server is not accepting requests, but the socket is open.<br /><b>Near Full</b> = Server is reaching it's socket limit.</p>" + vbNewLine + vbNewLine + "<p><b>Server Actions</b><br /><a href='/stop'>Stop Server</a> - Stop the server (this will shut down the HTTP Admin too)<br /><a href='/pause'>" + start + "ause the IM server</a> - This will " + start + "ause the IM server and keep the HTTP Admin online</p>"
HTMLTitle = "Server Menu"
ElseIf Page = "/stop" Then
HTMLTitle = "Stop Server?"
HTTPOut = "<p>Are you sure you want to <b>STOP</b> the server?</p>" + vbNewLine + "<p><i>Note: This will also stop this HTTP Admin from working until a user at the remote location starts the server again.</i></p>" + vbNewLine + "<p><a href='/'>No, back to the menu</a> - <a href='/stop?yes'>Yes, stop the server</a></p>"
ElseIf Page = "/stop?yes" Then
HTMLTitle = "Server Stopped"
HTTPOut = "<p><b>Server OFFLINE.</b></p>"
GoAction = "STOP"
ElseIf Page = "/pause" Then
Call cmdPause_Click
HTMLTitle = "IM Server Paused"
HTTPOut = "<p>The IM server is now <b>" + lblStatus.Caption + "</b>.</p>" + vbNewLine + "<p><a href='/'>Main Menu</a></p>"
ElseIf DirStruct(1) = "images" Then
UseTemplate = False
HTTPOut = "Image not found."
Dim IMG As String
IMG = LCase(DirStruct(2))
'''''''''''''''''' HERE!!! ''''''''''''''''''''''''
If IMG = "logo.gif" Then
ContentType = "image/gif"
Open App.Path + "\logo.gif" For Binary As #1
Input #1, HTTPOut
Close #1
' Debugging purposes:
'HTTPOut = HTTPOut + " --- " & Len(HTTPOut)
End If
Else
OK = False
End If
' Debate whether it's a 404 or 200, then send the appropriate header
If OK = False Then
HTTPHeader = "HTTP/1.1 404 Not Found" + vbNewLine + "Connection: Close" + vbNewLine + "Content-type: " + ContentType + vbNewLine + vbNewLine
HTTPOut = HTTPOut + Replace(Error404, "%%PAGE%%", Page)
HTMLTitle = "Error 404"
Else
HTTPHeader = "HTTP/1.1 200 OK" + vbNewLine + "Connection: Close" + vbNewLine + "Content-type: " + ContentType + vbNewLine + vbNewLine
End If
' If using the template, apply it:
If UseTemplate = True Then
HTTPOut = Replace(Replace(Replace(Template, "%%TITLE%%", HTMLTitle), "%%CONTENT%%", HTTPOut), "%%SIG%%", ServerSig)
End If
' Send data (either a 200 OK or 404 Not Found)
wsk_HTTP(Index).SendData HTTPHeader + HTTPOut
' Schedule for disconnection
HTTP_ToDisconnect = HTTP_ToDisconnect & Index & ";"
' Cleanup
HTTP_Data(Index) = ""
If GoAction = "STOP" Then
MAction = "STOP"
tmrAction.Enabled = True
End If
End If
End Sub
Comments
Use an image box if its that importan and change the path for the image at the form's load event.
EDIT: Nope, didn't work!
What you're about to see is some HTTP fucked up code. Enjoy :P
I've tried to comment it through, but some times I just gave up.
I've outlined the piece of code with "'''''''''''''''''' HERE!!! ''''''''''''''''''''''''"
Have fun now.
' Upon HTTP socket receive. Private Sub wsk_HTTP_DataArrival(Index As Integer, ByVal bytesTotal As Long) Dim Data As String wsk_HTTP(Index).GetData Data HTTP_Data(Index) = HTTP_Data(Index) & Data If Replace(HTTP_Data(Index), vbNewLine + vbNewLine, "") <> HTTP_Data(Index) Then ' HTML Template Template = "<html>" + vbNewLine + "<head>" + vbNewLine + "<title> :: JuleOS Basix IM Server HTTP Admin :: %%TITLE%% ::</title>" + vbNewLine + "<style>" + vbNewLine + "<!--" + vbNewLine + vbNewLine + "body { font-family: Tahoma,Arial; font-size: 10pt; }" + vbNewLine + vbNewLine + "-->" + vbNewLine + "</style>" + vbNewLine + "</head>" + vbNewLine + vbNewLine + "<body>" + vbNewLine + "%%CONTENT%%" + vbNewLine + "%%SIG%%" + vbNewLine + "</body>" + vbNewLine + "</html>" + vbNewLine ' Errors Dim Error404 As String Error404 = "<h2>Not Found</h2>" + vbNewLine + "<p>The file '%%PAGE%%' could not be found.</p>" ' Signatures Dim ServerSig As String ServerSig = vbNewLine + "<hr>" + vbNewLine + "<i>JuleOS Basix IM Server (HTTP Admin) version " & App.Major & "." & App.Minor & "." & App.Revision & "</i>" ' Sort data Dim Page As String Page = "/error404" Dim temp() As String temp = Split(HTTP_Data(Index), " ") If UBound(temp) > 1 Then ' Set 'Page' and remove a new line if the request finishes there Page = Replace(temp(1), vbNewLine, "") End If Dim OK As Boolean Dim HTTPOut As String Dim HTTPHeader As String Dim HTMLTitle As String OK = True HTTPOut = "" HTTPHeader = "" HTMLTitle = "Web Page" ' Create Directory Structure Dim DirStruct() As String DirStruct = Split(Page, "/") Dim GoAction As String GoAction = "" ' Content-type header Dim ContentType As String ' Default to text/html ContentType = "text/html" ' Use Template? ' By default, yes. Dim UseTemplate As Boolean UseTemplate = True ' Check through pages If Page = "/" Then start = "P" If Paused = True Then start = "Un-p" End If HTTPOut = "<p>Server status: <b>" + lblStatus.Caption + "</b><br /><b>Online</b> = Server is accepting requests<br /><b>Paused</b> = Server is not accepting requests, but the socket is open.<br /><b>Near Full</b> = Server is reaching it's socket limit.</p>" + vbNewLine + vbNewLine + "<p><b>Server Actions</b><br /><a href='/stop'>Stop Server</a> - Stop the server (this will shut down the HTTP Admin too)<br /><a href='/pause'>" + start + "ause the IM server</a> - This will " + start + "ause the IM server and keep the HTTP Admin online</p>" HTMLTitle = "Server Menu" ElseIf Page = "/stop" Then HTMLTitle = "Stop Server?" HTTPOut = "<p>Are you sure you want to <b>STOP</b> the server?</p>" + vbNewLine + "<p><i>Note: This will also stop this HTTP Admin from working until a user at the remote location starts the server again.</i></p>" + vbNewLine + "<p><a href='/'>No, back to the menu</a> - <a href='/stop?yes'>Yes, stop the server</a></p>" ElseIf Page = "/stop?yes" Then HTMLTitle = "Server Stopped" HTTPOut = "<p><b>Server OFFLINE.</b></p>" GoAction = "STOP" ElseIf Page = "/pause" Then Call cmdPause_Click HTMLTitle = "IM Server Paused" HTTPOut = "<p>The IM server is now <b>" + lblStatus.Caption + "</b>.</p>" + vbNewLine + "<p><a href='/'>Main Menu</a></p>" ElseIf DirStruct(1) = "images" Then UseTemplate = False HTTPOut = "Image not found." Dim IMG As String IMG = LCase(DirStruct(2)) '''''''''''''''''' HERE!!! '''''''''''''''''''''''' If IMG = "logo.gif" Then ContentType = "image/gif" Open App.Path + "\logo.gif" For Binary As #1 Input #1, HTTPOut Close #1 ' Debugging purposes: 'HTTPOut = HTTPOut + " --- " & Len(HTTPOut) End If Else OK = False End If ' Debate whether it's a 404 or 200, then send the appropriate header If OK = False Then HTTPHeader = "HTTP/1.1 404 Not Found" + vbNewLine + "Connection: Close" + vbNewLine + "Content-type: " + ContentType + vbNewLine + vbNewLine HTTPOut = HTTPOut + Replace(Error404, "%%PAGE%%", Page) HTMLTitle = "Error 404" Else HTTPHeader = "HTTP/1.1 200 OK" + vbNewLine + "Connection: Close" + vbNewLine + "Content-type: " + ContentType + vbNewLine + vbNewLine End If ' If using the template, apply it: If UseTemplate = True Then HTTPOut = Replace(Replace(Replace(Template, "%%TITLE%%", HTMLTitle), "%%CONTENT%%", HTTPOut), "%%SIG%%", ServerSig) End If ' Send data (either a 200 OK or 404 Not Found) wsk_HTTP(Index).SendData HTTPHeader + HTTPOut ' Schedule for disconnection HTTP_ToDisconnect = HTTP_ToDisconnect & Index & ";" ' Cleanup HTTP_Data(Index) = "" If GoAction = "STOP" Then MAction = "STOP" tmrAction.Enabled = True End If End If End SubJonny