CoderHelper如何实现为用户提供的简单的纯HTML站点服务器?

王朝vb·作者佚名  2006-01-10
窄屏简体版  字體: |||超大  

CoderHelper如何实现为用户提供的简单的纯HTML站点服务器?

以下代码为关键代码.其它代码将不贴出.以下代码取自另外一程序员的代码.按照CoderHelper的需要.做出了更改.该程序员没有给出版权标识或者MysticBoy目前无法知道该代码出自那位程序员.牵扯版权问题.与MysticBoy无关.

Private Sub sckWS_Close(Index As Integer)

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

 
 
 
免责声明:本文为网络用户发布,其观点仅代表作者个人观点,与本站无关,本站仅提供信息存储服务。文中陈述内容未经本站证实,其真实性、完整性、及时性本站不作任何保证或承诺,请读者仅作参考,并请自行核实相关内容。
 
 
© 2005- 王朝網路 版權所有  導航