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

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