HTTP Proxy на VB

Создайте новый проект(Standard EXE). Добавим:

Вот что должно получится:

И напишем код:

Option Explicit

Dim s(255) As String
Dim h(255) As String
Dim p(255) As String
Dim i As Integer

Private Sub cmdStart_Click()
    If cmdStart.Caption = "Start" Then
        wsTCP(0).LocalPort = txtPort
        wsTCP(0).Listen
        lblStatus = "Running..."
        cmdStart.Caption = "Stop"
    Else
        cmdStart.Caption = "Start"
        wsTCP(0).Close
        lblStatus = "Stopped"
    End If
End Sub

Private Sub wsProxy_Close(Index As Integer)
    On Error Resume Next
    Unload wsProxy(Index)
    wsTCP(Index).SendData p(Index)
End Sub

Private Sub wsProxy_Connect(Index As Integer)
    wsProxy(Index).SendData s(Index)
End Sub

Private Sub wsProxy_DataArrival(Index As Integer, ByVal bytesTotal As Long)
    wsProxy(Index).GetData h(Index)
    Debug.Print "(" & Index & ") " & h(Index)
    p(Index) = p(Index) & h(Index)
End Sub

Private Sub wsProxy_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)
    Debug.Print "(" & Index & ") Error " & Number & ": " & Description
    Unload wsProxy(Index)
End Sub

Private Sub wsTCP_Close(Index As Integer)
    Unload wsTCP(Index)
End Sub

Private Sub wsTCP_ConnectionRequest(Index As Integer, ByVal requestID As Long)
    i = i + 1
    Load wsTCP(i)
    Load wsProxy(i)
    wsTCP(i).Accept requestID
End Sub

Private Sub wsTCP_DataArrival(Index As Integer, ByVal bytesTotal As Long)
    wsTCP(Index).GetData s(Index)
    Debug.Print "(" & Index & ") " & s(Index)
    Dim strHost As String, iPort As Integer
    iPort = 80
    If InStr(UCase(s(Index)), "GET ") > 0 Then
        strHost = Mid(s(Index), InStr(UCase(s(Index)), "GET ") + 4)
    ElseIf InStr(UCase(s(Index)), "PUT ") > 0 Then
        strHost = Mid(s(Index), InStr(UCase(s(Index)), "PUT ") + 4)
    Else
        wsTCP(Index).SendData "Mailformed HTTP request"
        Exit Sub
    End If
    strHost = Left(strHost, InStr(strHost, " ") - 1)
    If InStr(strHost, "://") <> 0 Then strHost = Mid(strHost, InStr(strHost, "://") + 3)
    If InStr(strHost, ":") <> 0 Then
        iPort = Val(Mid(strHost, InStr(strHost, ":") + 1))
        strHost = Left(strHost, InStr(strHost, ":") - 1)
    End If
    If InStr(strHost, "/") > 0 Then strHost = Left(strHost, InStr(strHost, "/") - 1)
    With wsProxy(Index)
        .RemoteHost = strHost
        .RemotePort = iPort
        .Connect
    End With
End Sub

Private Sub wsTCP_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)
    Debug.Print "(" & Index & ") Error " & Number & ": " & Description
    Unload wsTCP(Index)
End Sub

Private Sub wsTCP_SendComplete(Index As Integer)
    wsTCP(Index).Close
End Sub

Скачать исходник

Ну вот и все! Приятного программирования