7,762
社区成员
发帖
与我相关
我的任务
分享请介绍思路，思路好、有代码将额外多多加分！！！
这是一个小软件，要求能监视局域网上某个文件夹，如果该文件夹内增加了文件，软件将在本机上弹出窗口，并有声音提示。
...全文
请发表友善的回复…
发表回复
kxiangwei 2003-09-11
- 打赏
- 举报
Option Explicit
Private Sub Command1_Click()
'Hardwired values here. **check
On Error Resume Next
insocket(0).LocalPort = 3280
insocket(0).Listen
addLog "Listening to port 3280..", 0
End Sub
Private Sub Command2_Click()
On Error Resume Next
insocket(0).Close
outsocket(0).Close
addLog "Stopped Listening.", 0
End Sub
Private Sub Form_Load()
addLog "Program Started.", 0
Text1.Text = Text1.Text & " " & insocket(0).LocalIP
End Sub
Private Sub insocket_ConnectionRequest(Index As Integer, ByVal requestID As Long)
'A connection request has been received. Accept it.
insocket(Index).Close
blnNewConnection = True
insocket(Index).Accept requestID
addLog "Accepted connection from " & insocket(0).RemoteHostIP, 0
End Sub
Private Sub insocket_DataArrival(Index As Integer, ByVal bytesTotal As Long)
'This routine waits for the browser to send the HTTP request
'header. When all necessary information is collected,
'it connects to the real server and passes the header data.
'Non-smart, but hassle free, error handling
On Error Resume Next
'Declarations
Static strInBuffer As String 'Complete Incoming Buffer
Static blnHeaderRead As Boolean 'Is the http header read?
Dim strDataReceived As String 'Partial incoming buffer
Dim strDestinationHost As String 'Destination Host
Dim strDestinationPort As String 'Destination Port
Dim intPos As Integer, intPos2 As Integer 'String positions
'Warn other procedures that data is being managed at this time
blnManagingData = True
'If new connection, reset buffers and flag
If blnNewConnection Then
strInBuffer = ""
strDestinationHost = ""
strDestinationPort = ""
blnHeaderRead = False
blnNewConnection = False
End If
'Data has arrived, so store it in the partial buffer
insocket(Index).GetData strDataReceived
Debug.Print strDataReceived
'If the header is finished, dump it to the outer connection
'and exit
If blnHeaderRead Then
outsocket(Index).SendData strDataReceived
Exit Sub
End If
'Add data to the complete buffer
strInBuffer = strInBuffer & strDataReceived
'We must know where to connect to, and we're told that
'by the Host: parameter in the http-request header. Let's
'look for it.
intPos = InStr(strInBuffer, "Host: ")
If intPos > 0 Then
intPos = intPos + Len("Host: ")
intPos2 = InStr(intPos + 1, strInBuffer, vbCrLf)
If intPos2 > 0 Then
'Found! Let's check if a port number is present,
'or the normal 80 port is used.
strDestinationHost = Mid$(strInBuffer, intPos, intPos2 - intPos)
intPos = InStr(strDestinationHost, ":")
If intPos > 0 Then
strDestinationPort = Int(Right$(strDestinationHost, Len(strDestinationHost) - intPos + 1))
strDestinationHost = Left$(strDestinationHost, intPos - 1)
Else
strDestinationPort = 80
End If
addLog "Routing to " & strDestinationHost & ":" & strDestinationPort, 0
'Now that we're done, let's open the outer connection
MsgBox "Connect:" & strDestinationHost
outsocket(0).Connect strDestinationHost, strDestinationPort
'Wait to be connected..
While outsocket(0).State <> sckConnected
DoEvents
Wend
'Dump current buffer information
outsocket(0).SendData strInBuffer
'The header info has been read.
blnHeaderRead = True
End If
End If
'Let other procedures know we're finished
blnManagingData = False
End Sub
Private Sub outsocket_Close(Index As Integer)
On Error Resume Next
addLog "Outer connection closed", 0
While blnManagingData
DoEvents
Wend
DoEvents
insocket(Index).Close
'insocket(Index).Listen
End Sub
Private Sub outsocket_DataArrival(Index As Integer, ByVal bytesTotal As Long)
'Data is coming from the outer connection.
'Pass it to the inner connection.
On Error Resume Next
Dim strDataReceived As String
outsocket(Index).GetData strDataReceived
insocket(Index).SendData strDataReceived
End Sub
Private Sub outsocket_Error(Index As Integer, ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
On Error Resume Next
Debug.Print "here-error"
addLog "Outer connection closed", 0
DoEvents
insocket(Index).Close
insocket(Index).Listen
End Sub
Private Sub Command1_Click()
'Hardwired values here. **check
On Error Resume Next
insocket(0).LocalPort = 3280
insocket(0).Listen
addLog "Listening to port 3280..", 0
End Sub
Private Sub Command2_Click()
On Error Resume Next
insocket(0).Close
outsocket(0).Close
addLog "Stopped Listening.", 0
End Sub
Private Sub Form_Load()
addLog "Program Started.", 0
Text1.Text = Text1.Text & " " & insocket(0).LocalIP
End Sub
Private Sub insocket_ConnectionRequest(Index As Integer, ByVal requestID As Long)
'A connection request has been received. Accept it.
insocket(Index).Close
blnNewConnection = True
insocket(Index).Accept requestID
addLog "Accepted connection from " & insocket(0).RemoteHostIP, 0
End Sub
Private Sub insocket_DataArrival(Index As Integer, ByVal bytesTotal As Long)
'This routine waits for the browser to send the HTTP request
'header. When all necessary information is collected,
'it connects to the real server and passes the header data.
'Non-smart, but hassle free, error handling
On Error Resume Next
'Declarations
Static strInBuffer As String 'Complete Incoming Buffer
Static blnHeaderRead As Boolean 'Is the http header read?
Dim strDataReceived As String 'Partial incoming buffer
Dim strDestinationHost As String 'Destination Host
Dim strDestinationPort As String 'Destination Port
Dim intPos As Integer, intPos2 As Integer 'String positions
'Warn other procedures that data is being managed at this time
blnManagingData = True
'If new connection, reset buffers and flag
If blnNewConnection Then
strInBuffer = ""
strDestinationHost = ""
strDestinationPort = ""
blnHeaderRead = False
blnNewConnection = False
End If
'Data has arrived, so store it in the partial buffer
insocket(Index).GetData strDataReceived
Debug.Print strDataReceived
'If the header is finished, dump it to the outer connection
'and exit
If blnHeaderRead Then
outsocket(Index).SendData strDataReceived
Exit Sub
End If
'Add data to the complete buffer
strInBuffer = strInBuffer & strDataReceived
'We must know where to connect to, and we're told that
'by the Host: parameter in the http-request header. Let's
'look for it.
intPos = InStr(strInBuffer, "Host: ")
If intPos > 0 Then
intPos = intPos + Len("Host: ")
intPos2 = InStr(intPos + 1, strInBuffer, vbCrLf)
If intPos2 > 0 Then
'Found! Let's check if a port number is present,
'or the normal 80 port is used.
strDestinationHost = Mid$(strInBuffer, intPos, intPos2 - intPos)
intPos = InStr(strDestinationHost, ":")
If intPos > 0 Then
strDestinationPort = Int(Right$(strDestinationHost, Len(strDestinationHost) - intPos + 1))
strDestinationHost = Left$(strDestinationHost, intPos - 1)
Else
strDestinationPort = 80
End If
addLog "Routing to " & strDestinationHost & ":" & strDestinationPort, 0
'Now that we're done, let's open the outer connection
MsgBox "Connect:" & strDestinationHost
outsocket(0).Connect strDestinationHost, strDestinationPort
'Wait to be connected..
While outsocket(0).State <> sckConnected
DoEvents
Wend
'Dump current buffer information
outsocket(0).SendData strInBuffer
'The header info has been read.
blnHeaderRead = True
End If
End If
'Let other procedures know we're finished
blnManagingData = False
End Sub
Private Sub outsocket_Close(Index As Integer)
On Error Resume Next
addLog "Outer connection closed", 0
While blnManagingData
DoEvents
Wend
DoEvents
insocket(Index).Close
'insocket(Index).Listen
End Sub
Private Sub outsocket_DataArrival(Index As Integer, ByVal bytesTotal As Long)
'Data is coming from the outer connection.
'Pass it to the inner connection.
On Error Resume Next
Dim strDataReceived As String
outsocket(Index).GetData strDataReceived
insocket(Index).SendData strDataReceived
End Sub
Private Sub outsocket_Error(Index As Integer, ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
On Error Resume Next
Debug.Print "here-error"
addLog "Outer connection closed", 0
DoEvents
insocket(Index).Close
insocket(Index).Listen
End Sub
konglin 2003-09-11
- 打赏
- 举报
我把源代码发给你，把信箱告诉我。
http://211.97.213.167/
http://211.97.213.167/
konglin 2003-09-11
- 打赏
- 举报
难过！
konglin 2003-09-08
- 打赏
- 举报
难道没有人知道！
chanet 2003-09-03
- 打赏
- 举报
在 www.applevb.com 有代码..
northwolves 2003-09-02
- 打赏
- 举报
'引用microsoft scripting runtime
Dim f As folder
监测 f.SubFolders.Count
Dim f As folder
监测 f.SubFolders.Count
