vb6编写代理服务器

'工程说明
  '程序中有三个WINSOCK对像
  'SERVER是一个监听对像,监听被代理(即ID)是的请求,如果IE发来请求,则打开一个
  'Winsock2对像,接受联接,并继续监听
  'Winsock2对像,用来联接客户端,如果对方传来请求消息,则经过判断,用相应的
  '       Winsock3与要请求的服务器进行接接
  'Winsock3对像,用来联接服务端,如果发来消息,传给相应的Winsock2,让其传给客
  '       户端
  '
   
   
  Private Sub Command1_Click()
  '打或是关闭服务
  If Command1.Caption = "停止" Then
          SERVER.Close
          Command1.Caption = "开始"
  Else
          Form_Load
          Command1.Caption = "停止"
  End If
  End Sub
   
  Private Sub Form_Load()
  '窗体启动时,打开Server,定议监听端口,开始监听
  SERVER.LocalPort = 810
  SERVER.Listen
  End Sub
   
  Private Sub Server_ConnectionRequest(ByVal requestID As Long)
  '如果客户传来请求,先判断是不是有空闲的Winsock2如果有使用它,无则新建一个
  On Error Resume Next
      For Each tWinsock In Winsock2
        If tWinsock.State <> 7 Then
            tWinsock.Close
            i = tWinsock.Index
            GoTo lls
        End If
      Next
      i = Winsock2.Count
      Load Winsock2(i)
        Load Winsock3(i)
lls:
      Winsock2(i).Accept requestID
  End Sub
  Private Sub Winsock2_DataArrival(Index As Integer, ByVal bytesTotal As Long)
  'Winsock2传来数据
        On Error Resume Next
        Dim bty()     As Byte, strHost       As String, strData       As String, strHeader       As String
          '接收数据
          Winsock2(Index).GetData strData, vbString
          '找到指定的HOST地址
          pos = InStr(1, UCase(strData), "HOST:") + 5
          strHost = Trim(Mid(strData, pos, InStr(pos, strData, vbCrLf) - pos))
          Text1.Text = strData       '显示传来的请求,没有用
          '关闭对应的Winsock3
          Winsock3(Index).Close
          '求HTTP协议第一行信息
          strHeader = Left(strData, InStr(1, strData, vbCrLf))
          If InStr(1, strHeader, ".ds") > 0 Then               '如果是下载*.DS
                  Winsock2(Index).SendData "您要下载DS文件"
                  DoEvents
                  Winsock2(Index).Close
                  Winsock3(Index).Close
                  If Index > 0 Then           '从内存中卸载无用的控件
                          Unload Winsock2(Index)
                          Unload Winsock3(Index)
                  End If
                   
                  Exit Sub
          End If
          '解释HOST，得到主机在址和端口,并付给Winsock3
                  If InStr(1, strHost, ":") Then
                          Winsock3(Index).RemoteHost = Left(strHost, InStr(1, strHost, ":") - 1)
                          Winsock3(Index).RemotePort = Right(strHost, Len(strHost) - InStr(1, strHost, ":"))
                  Else
                          Winsock3(Index).RemoteHost = strHost
                          Winsock3(Index).RemotePort = 80
                  End If
          Winsock3(Index).Connect   '联接主机
          '是不是联接成功
          Do While Winsock3(Index).State <> 7
            DoEvents
            'Debug.Print   Winsock3(Index).State
            If Winsock3(Index).State = sckError Then
                  '如果联接错误
                  Winsock2(Index).SendData "不能联接到指定主机"
                  DoEvents
                  Winsock2(Index).Close
                  Winsock3(Index).Close
                  If Index > 0 Then           '从内存中卸载无用的控件
                          Unload Winsock2(Index)
                          Unload Winsock3(Index)
                  End If
                  Exit Sub
            End If
          Loop
           
          Winsock3(Index).SendData strData
           
  End Sub
   
  Private Sub Winsock3_Close(Index As Integer)
  '如果主机关闭,从内存中卸载无用的控件
          Winsock2(Index).Close
          If Index > 0 Then
                  Unload Winsock2(Index)
                  Unload Winsock3(Index)
          End If
           
  End Sub
   
  Private Sub Winsock2_Close(Index As Integer)
  '如果主机关闭,从内存中卸载无用的控件
          Winsock3(Index).Close
          If Index > 0 Then
                  Unload Winsock2(Index)
                  Unload Winsock3(Index)
          End If
                   
  End Sub
   
  Private Sub Winsock3_DataArrival(Index As Integer, ByVal bytesTotal As Long)
  '如果主机传来数据,以字节方式返回给客户端
        On Error Resume Next
        Dim bty()     As Byte
        Winsock3(Index).GetData bty, vbByte
        Winsock2(Index).SendData bty
  End Sub