Text1.Text = Text1.Text & " " & insocket(0).LocalIPEnd SubPrivate 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, 0End SubPrivate 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
'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 SubPrivate 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).ListenEnd SubPrivate 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 SubPrivate 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
Dim f As folder
监测 f.SubFolders.Count
http://211.97.213.167/
On Error Resume Next
insocket(0).LocalPort = 3280
insocket(0).Listen
addLog "Listening to port 3280..", 0End SubPrivate Sub Command2_Click() On Error Resume Next
insocket(0).Close
outsocket(0).Close addLog "Stopped Listening.", 0End SubPrivate Sub Form_Load() addLog "Program Started.", 0
Text1.Text = Text1.Text & " " & insocket(0).LocalIPEnd SubPrivate 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, 0End SubPrivate 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 SubPrivate 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).ListenEnd SubPrivate 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 SubPrivate 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).ListenEnd Sub