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

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

Exit Sub

End If

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

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

sckWS(ttlConnections).LocalPort = 0 'set its local port to 0

sckWS(ttlConnections).Accept requestID 'Accept the connection request.

DoEvents

List1.AddItem sckWS(ttlConnections).RemoteHostIP & ' 已连接'

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

End Sub

Public Sub sSendData(id As Long, Data)

sckWS(id).SendData Data

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 '

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

ElseIf requestedPage = '104' Then

sSendData id, LoadResString(104)

DoEvents

List1.AddItem sckWS(id).RemoteHostIP & '请求超时!'

List1.ListIndex = List1.ListCount - 1

DoEvents

Else

sckWS(ttlConnections).SendData Replace(LoadResString(101), '&file&', requestedPage)

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

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