用VB制作简易的代理服务器代码

•  
• Private Sub Form_Load()
  Winsock1(0).Listen
  For i = 1 To 255
  Load Winsock1(i)
  Load Winsock2(i)
  Winsock1(i).Close
  Next
  End Sub
•  
• Private Sub Form_Unload(Cancel As Integer)
  Winsock1(0).Close
  Unload Me
  End Sub
•  
• Private Sub Winsock1_ConnectionRequest(Index As Integer, ByVal requestID As Long)
  For i = 1 To 255
  If Winsock1(i).State = sckClosed Then
  Winsock1(i).Accept requestID
  Exit For
  End If
  Next
  End Sub
•  
• Private Sub Winsock1_DataArrival(Index As Integer, ByVal bytesTotal As Long)
  'On Error GoTo OnError
  Dim Dat As String
  Winsock1(Index).GetData Dat
  Dim ProxyTmp
  Dim ProxyFile() As Byte
  ProxyTmp = Split(Dat, " ")
  Dim UrlTemp
  Dim UrlW As String
  UrlTemp = Split(ProxyTmp(1), "/")
  i = 0
• UrlW = UrlTemp(2)
  Winsock2(Index).Close
  Winsock2(Index).Protocol = sckTCPProtocol
  List1.AddItem "User:" + Trim(Winsock1(Index).RemoteHostIP)
  List1.AddItem "正在连接" + UrlW + "中····"
  List1.AddItem "连接到" + ProxyTmp(1)
  List1.AddItem "完成"
  Winsock2(Index).RemoteHost = UrlW
  Winsock2(Index).RemotePort = 80
  Winsock2(Index).Connect
  Dim Times As Long
  Times = GetTickCount
• Do Until Form1.Winsock2(Index).State = sckConnected
  DoEvents
  Loop
• Winsock2(Index).SendData Dat
  Exit Sub
  OnError:
  Winsock1(Index).SendData "<font color='red'>对不起,您所想要访问的站点暂时无法访问或者访问超时,请联系管理员!</font>"
  End Sub
•  
• Private Sub Winsock1_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)
  Winsock1(Index).Close
  Winsock1(0).Close
  Winsock1(0).Listen
  End Sub
•  
• Private Sub Winsock1_SendComplete(Index As Integer)
  Winsock1(Index).Close
  Winsock1(0).Close
  Winsock1(0).Listen
• End Sub
•  
•  
• Private Sub Winsock2_ConnectionRequest(Index As Integer, ByVal requestID As Long)
• Winsock2(Index).Accept requestID
• End Sub
• Private Sub Winsock2_DataArrival(Index As Integer, ByVal bytesTotal As Long)
  On Error Resume Next
  Dim Dat() As Byte
  Dim nc As Integer
  nc = 0
• 
  Winsock2(Index).GetData Dat
  Do Until Winsock1(Index).State = sckConnected
   
  Loop
  Winsock1(Index).SendData Dat
  'SendDat Dat, Index
• Winsock2(Index).PeekData Dat
• 
  Debug.Print Dat
• 
  End Sub
• 
  Private Sub Winsock2_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)
  Winsock2(Index).Close
  End Sub
• Sub SendDat(Dt() As Byte, i As Integer)
  Dim TmpDt() As Byte
  Do While Winsock1(i).State = sckConnected
• x = x + 1
  Loop
  If UBound(Dt) < 100000 Then
  Winsock1(i).SendData Dt
   DoEvents
• Else
  For i = 0 To UBound(Dt) / 100000
  For j = 0 To 99999
   ReDim Preserve TmpDt(j)
    TmpDt(j) = Dt(i * 100000 + j)
   Next
    Winsock1(i).SendData TmpDt
    DoEvents
    Next
    TmpDt() = ""
  For j = 0 To UBound(Dt) Mod 100000
    
    ReDim Preserve TmpDt(j)
    TmpDt(j) = Dt((i + 1) * 100000 + j)
    Next
    Winsock1(i).SendData TmpDt
     DoEvents
• End If
• End Sub
  这个服务器本身不完善,耗内存不匪.不过重在说明基本原理.希望哪位能够改进一下,还请能发于我一份.
• 我的E-MAIL:fantasynoisy@yahoo.com.cn
• 我的QQ:373277012
• 请老手们多指教.新手敬上.