关闭

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

标签: 服务器vbintegerstringbytelist
1365人阅读 评论(0) 收藏 举报
  •  
  • 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
  • 请老手们多指教.新手敬上.
0
0

查看评论
* 以上用户言论只代表其个人观点,不代表CSDN网站的观点或立场
    个人资料
    • 访问:11964次
    • 积分:198
    • 等级:
    • 排名:千里之外
    • 原创:8篇
    • 转载:0篇
    • 译文:0篇
    • 评论:0条
    文章分类