CoderHelper如何实现为用户提供的简单的纯HTML站点服务器?
CoderHelper如何实现为用户提供的简单的纯HTML站点服务器? CoderHelper如何实现为用户提供的简单的纯HTML站点服务器?
sckWS(Index).Close
End Sub
Private Sub sckWS_ConnectionRequest(Index As Integer, ByVal requestID As Long)
On Error Resume Next
Dim n As Long
If Me.cbsXianzhi.Value = 1 Then
If Me.obtCant.Value = True Then
For n = 0 To Me.lstCant.ListCount - 1
If sckWS(ttlConnections).RemoteHostIP = Me.lstCant.List(n) Then
Addlog '拒绝访问IP' & Me.lstCant.List(n), 'IpCant'
List1.AddItem '拒绝访问IP' & Me.lstCant.List(n), 'IpCant'
Exit Sub
End If
Next
ElseIf Me.optCan.Value = True Then
For n = 0 To Me.lstCan.ListCount - 1
If sckWS(ttlConnections).RemoteHostIP = Me.lstCan.List(n) Then
Addlog '允许访问IP' & Me.lstCan.List(n), 'IpCan'
List1.AddItem '允许访问IP' & Me.lstCan.List(n), 'IpCan'
Exit For
End If
Next
Exit Sub
End If
End If
DoEvents
DoEvents
DoEvents
List1.ListIndex = List1.ListCount - 1
DoEvents
ttlConnections = ttlConnections + 1 'add 1 to the total # of connections
numConnections = numConnections + 1 'number of connected clients + 1
If Me.chkCountIP.Value = 1 Then Addlog '当前连接数' & numConnections & '总数' & ttlConnections
Me.sst.TrayToolTip = '当前连接用户数量' & numConnections
DoEvents
DoEvents
If Me.chkCountIP.Value = 1 Then cIni.WriteValue 'Count', '当前连接数' & numConnections & '总数' & ttlConnections, Year(Now) & Month(Now) & Day(Now)
If numConnections = maxConnections Then GoTo done 'if we've reached the max # of connections, exit sub.
Load sckWS(ttlConnections) 'load a new instance of sckWS.
DoEvents
DoEvents
DoEvents
sckWS(ttlConnections).LocalPort = 0 'set its local port to 0
sckWS(ttlConnections).Accept requestID 'Accept the connection request.
DoEvents
DoEvents
List1.AddItem sckWS(ttlConnections).RemoteHostIP & ' 已连接'
DoEvents
DoEvents
List1.ListIndex = List1.ListCount - 1
done:
If Me.chkRecIP.Value = 1 Then Addlog sckWS(ttlConnections).RemoteHostIP & ' 已连接'
If List1.ListCount >= 255 Then List1.RemoveItem 0
numConnections = numConnections - 1 'number of connections at the moment - 1
List1.ListIndex = List1.ListCount - 1
DoEvents
DoEvents
DoEvents
DoEvents
DoEvents
End Sub
Public Sub sSendData(id As Long, Data)
sckWS(id).SendData Data
DoEvents
DoEvents
DoEvents
End Sub
Private Sub sckWS_DataArrival(Index As Integer, ByVal bytesTotal As Long)
On Error Resume Next
sckWS(Index).GetData strdata$ 'Get any data sent to us
'MsgBox strdata$ ' I used this for debugging
Debug.Print strdata$
DoEvents
If Mid$(strdata$, 1, 3) = 'GET' Then 'If it is trying to get a site, find out
findget = InStr(strdata$, 'GET ') ' the site they want then set requestedPage$
spc2 = InStr(findget + 5, strdata$, ' ') ' to it.
pagetoget$ = Mid$(strdata$, findget + 4, spc2 - (findget + 4))
requestedPage$ = pagetoget$
Debug.Print requestedPage$
DoEvents
DoEvents
DoEvents '
List1.AddItem '请求文件: ' & requestedPage$
If requestedPage$ = '/' Then
requestedPage$ = Me.cmIndexPage.Text '如果没有任何请求.那么给出该目录下的index.html文件,即给出索引文件.
Else
requestedPage$ = Mid(requestedPage$, InStr(requestedPage$, '/') + 1)
End If
DoEvents
Dim id As Long
id = ttlConnections
If Me.chkRecFile.Value = 1 Then Addlog '请求文件: ' & requestedPage$
Debug.Print requestedPage$
DoEvents
If FileIsOK(Me.txtRoot + '\' + requestedPage$) Then
DoEvents
Dim dats() As Byte
dats = LoadBinFile(CheckPath(Me.txtRoot.Text) + requestedPage$)
sckWS(ttlConnections).SendData dats
DoEvents
ReDim dats(0) As Byte
DoEvents
DoEvents
ElseIf requestedPage = '104' Then
sSendData id, LoadResString(104)
DoEvents
DoEvents
List1.AddItem sckWS(id).RemoteHostIP & '请求超时!'
List1.ListIndex = List1.ListCount - 1
DoEvents
Else
sckWS(ttlConnections).SendData Replace(LoadResString(101), '&file&', requestedPage)
DoEvents
DoEvents
DoEvents
DoEvents
DoEvents
Addlog sckWS(ttlConnections).RemoteHostIP & '无法找到请求的文件' & requestedPage
List1.AddItem sckWS(id).RemoteHostIP & '请求的文件无法找到!'
List1.ListIndex = List1.ListCount - 1
End If
DoEvents
ElseIf Mid$(strdata$, 1, 4) = 'POST' Then 'This is the code when it is trying to post something!
findpost = InStr(strdata$, 'POST ') 'the data where filtered in the ConnectionRequest
spc2 = InStr(findpost + 5, strdata$, ' ') 'Function of the winsock control
pagetopost$ = Mid$(strdata$, findpost + 5, spc2 - (findpost + 5))
requestedPage$ = pagetopost$
Addlog 'Post' & pagetopost$
End If
DoEvents
DoEvents
DoEvents
DoEvents
DoEvents
End Sub
Private Sub sckWS_SendComplete(Index As Integer)
'This was a bug that was fixed from v.2a.
If requestedPage$ <> '' Then 'f the requested page doesn't = nothing then...
requestedPage$ = '' 'clear the requestedPage varible.
List1.AddItem sckWS(ttlConnections).RemoteHostIP & '已关闭!'
DoEvents
End If
sckWS(ttlConnections).Close 'Close the connection.
Addlog sckWS(ttlConnections).RemoteHostIP & '已关闭!'
DoEvents
End Sub
Private Sub sckWS_SendProgress(Index As Integer, ByVal bytesSent As Long, ByVal bytesRemaining As Long)
lblNow.Caption = sckWS(Index).RemoteHostIP & ':已发送' & bytesSent & '剩下:' & bytesRemaining
DoEvents
End Sub
