frmtcp.frm

由于所有对外网的请求都是通过代理服务器实现的

VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Begin VB.Form frmMai 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "LoseGate"
   ClientHeight    =   5100
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   8985
   LinkTopic       =   "Form2"
   MaxButton       =   0   'False
   ScaleHeight     =   340
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   599
   StartUpPosition =   3  'Windows Default
   Begin VB.TextBox Text1 
      Height          =   3735
      Left            =   120
      MultiLine       =   -1  'True
      TabIndex        =   3
      Text            =   "frmTcp.frx":0000
      Top             =   360
      Width           =   2175
   End
   Begin VB.TextBox txtLog 
      BeginProperty Font 
         Name            =   "Small Fonts"
         Size            =   6.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   3735
      Left            =   2400
      Locked          =   -1  'True
      MultiLine       =   -1  'True
      TabIndex        =   2
      Top             =   360
      Width           =   6375
   End
   Begin VB.CommandButton Command2 
      Caption         =   "Stop Listening"
      Height          =   495
      Left            =   4920
      TabIndex        =   1
      Top             =   4200
      Width           =   1215
   End
   Begin VB.CommandButton Command1 
      Caption         =   "Listen"
      Height          =   495
      Left            =   3480
      TabIndex        =   0
      Top             =   4200
      Width           =   1215
   End
   Begin MSWinsockLib.Winsock insocket 
      Index           =   0
      Left            =   480
      Top             =   4320
      _ExtentX        =   741
      _ExtentY        =   741
   End
   Begin MSWinsockLib.Winsock outsocket 
      Index           =   0
      Left            =   1080
      Top             =   4320
      _ExtentX        =   741
      _ExtentY        =   741
   End
   Begin VB.Label Label1 
      Caption         =   "Http proxy sample"
      Height          =   255
      Left            =   120
      TabIndex        =   4
      Top             =   120
      Width           =   1455
   End
End
Attribute VB_Name = "frmMai"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
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