PDA

Click to See Complete Forum and Search --> : Server problem


saschart
Dec 18th, 2005, 03:04 AM
I need a very simple server which can put in the internet one image when receive a code in get request. I try some code which work but stoping in 15-30 minutes, who know why?

The code is here:

Dim webID As Integer
Dim maxUsers As Integer

Private Sub Form_Load()
Dim active As Integer
If App.PrevInstance = True Then
End
Else
webID = 0
maxUsers = 2

For active = 1 To maxUsers
Load webServer(active)
Next active

StartServer
End If
End Sub

Public Sub StartServer()
On Error GoTo MyWebError

webServer(0).Disconnect
webServer(0).LocalPort = 88
webServer(0).Listen


Exit Sub
MyWebError:
MsgBox "Web Server cannot be start! Port " & webServer(0).LocalPort & " may be in use by another application.", vbExclamation
End Sub

Private Sub webServer_Accept(Index As Integer, SocketId As Integer)
On Error GoTo MyReset
Label1 = "accept connect"

webID = webID + 1
If webID = maxUsers Then webID = 1

If webServer(webID).Connected = False Then
webServer(webID).Accept = SocketId
Else
GoTo MyReset
End If

Label2 = webID
Exit Sub

MyReset:
webServer(webID).Disconnect
Exit Sub
End Sub


Private Sub webServer_Read(Index As Integer, DataLength As Integer, IsUrgent As Integer)
Dim nPos As Integer
Dim strGet As String
Dim fileBuffer As String
Dim strHeader As String
Dim fileserver As String
Dim getBuffer As String
Dim readBuffer As Integer
Dim lenBuffer As Integer
Dim BytesWrite As Integer
Dim f As Integer

f = FreeFile
fileBuffer = ""

readBuffer = webServer(Index).Read(getBuffer, 2048)
nPos = InStr(5, getBuffer, " ")
strGet = Mid(getBuffer, 5, nPos - 5)

nPos = InStr(getBuffer, Chr(10))
strHeader = getBuffer

If Left(strGet, 22) = "/U2FzY2hBcnRtZXJnZXRi?" Then
fileserver = App.Path & "\imagetoshow.jpg"

If Len(Dir$(fileserver)) > 0 Then
lenBuffer = FileLen(fileserver)
Open fileserver For Binary As #f
fileBuffer = Input(lenBuffer, #f)
Close #f
Else
fileBuffer = "#"
End If

'back headers

strHeader = "HTTP/1.1 200 OK" & Chr(13) & Chr(10)
strHeader = strHeader & "Server: SaServer" & Chr(13) & Chr(10)
strHeader = strHeader & "Cache-Control: no-store, no-cache, must-revalidate, post-check=0, pre-check=0" & Chr(13) & Chr(10)
strHeader = strHeader & "Pragma: no-cache" & Chr(13) & Chr(10)
strHeader = strHeader & "Connection: close" & Chr(13) & Chr(10)
strHeader = strHeader & "Content-Type: image/jpeg" & Chr(13) & Chr(10)
strHeader = strHeader & Chr(13) & Chr(10)

BytesWrite = webServer(Index).Write(strHeader, Len(strHeader))

BytesWrite = webServer(Index).Write(fileBuffer, Len(fileBuffer))
End If

If webServer(Index).Connected Then
webServer(Index).Disconnect

End If
End Sub

Private Sub webServer_Disconnect(Index As Integer)
webServer(Index).Disconnect
End Sub

Private Sub Label2_Click()
Shell ("Explorer " & Label2), vbNormalNoFocus
End Sub



I use SocketWrench Freeware Edition from Catalyst.