• Home
 · 
• Internet/HTML
 · 
• This is a simple proxy program written in VB 5.0. I couldn't find simple enough code online so I cr

This is a simple proxy program written in VB 5.0. I couldn't find simple enough code online so I cr

This is a simple proxy program written in VB 5.0. I couldn't find simple enough code online so I created one myself. This has only been tested

API Declarations


' Create 2 winsock controls on a new form
' Winsock1(0)
' Winsock2(0)
' also add a multiline text box
' Text1
' If you have any questions or simply like to talk to another programmer
' write me at [email protected]



Rate This is a simple proxy program written in VB 5.0. I couldn't find simple enough code online so I cr

• 1
• 2
• 3
• 4
• 5

(1(1 Vote))

Dim remDoc() As String
Dim remHost() As String
Dim conMade() As Boolean
Dim requestHeader() As String
Dim maxSockets As Integer
Dim proxyPort As Long

Private Sub Form_Load()
    maxSockets = 100 ' Maximum sockets to use for the proxy server
    proxyPort = 8180 ' Default proxy port
    ReDim sockInUse(maxSockets)
    ReDim remDoc(maxSockets)
    ReDim conMade(maxSockets)
    ReDim requestHeader(maxSockets)
    ReDim remHost(maxSockets)
    startProxy
End Sub
Private Sub startProxy(Optional ByVal onPort As Long)
    While Winsock1(0).State <> sckClosed
        Winsock1(0).Close
        DoEvents
    Wend
    If onPort = 0 Then
        onPort = proxyPort
    Else
        proxyPort = onPort
    End If
    Winsock1(0).LocalPort = onPort
    Winsock1(0).Listen
End Sub
Private Sub stopProxy() ' this only prevents any more connections to the proxy
    While Winsock1(0).State <> sckClosed
        Winsock1(0).Close
        DoEvents
    Wend
End Sub
Private Sub Timer1_Timer()
    Caption = socketsInUse
End Sub
Private Function socketsInUse() As Long
    Dim tmpLong As Long
    For i = 1 To UBound(sockInUse)
        If sockInUse(i) <> 0 Then tmpLong = tmpLong + 1
    Next i
    socketsInUse = tmpLong
End Function
Private Function getAvailSock() As Long
    Dim i As Integer
    For i = 1 To UBound(sockInUse)
        If sockInUse(i) = 0 Then
            getAvailSock = i
            i = UBound(sockInUse)
        End If
    Next i
    If getAvailSock = 0 Then Exit Function
    sockInUse(getAvailSock) = 2
    Load Winsock1(getAvailSock)
    Load Winsock2(getAvailSock)
End Function
Private Sub Winsock1_ConnectionRequest(Index As Integer, ByVal requestID As Long)
    Dim newCon As Long
    If Index <> 0 Then Winsock1_Close (Index): Exit Sub
    newCon = getAvailSock
    If newCon <> 0 Then
        Winsock1(newCon).Accept requestID
    End If
    While Winsock1(0).State <> sckListening
        While Winsock1(0).State <> sckClosed
            Winsock1(0).Close
            DoEvents
        Wend
        Winsock1(0).Listen
    Wend
End Sub
Private Sub Winsock2_Connect(Index As Integer)
    On Error GoTo errS
    conMade(Index) = True
    Winsock2(Index).SendData requestHeader(Index)
    Exit Sub
errS:
    MsgBox Err.Description
End Sub
Private Sub Winsock1_DataArrival(Index As Integer, ByVal bytesTotal As Long)
    On Error GoTo errS
    Dim inBuf As String
    Winsock1(Index).GetData inBuf
    If Not conMade(Index) Then
        requestHeader(Index) = requestHeader(Index) & inBuf
        If InStr(requestHeader(Index), Chr(13) & Chr(10) & Chr(13) & Chr(10)) <> 0 Then
            setupCon requestHeader(Index), Index
        End If
    Else
        Winsock2(Index).SendData inBuf
    End If
    Exit Sub
errS:
    MsgBox Err.Description
End Sub
Private Sub Winsock2_DataArrival(Index As Integer, ByVal bytesTotal As Long)
    On Error GoTo errS
    Dim inBuf As String
    Winsock2(Index).GetData inBuf
    Winsock1(Index).SendData inBuf
    Exit Sub
errS:
    MsgBox Err.Description
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)
    Call Winsock2_Close(Index)
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)
    Call Winsock1_Close(Index)
End Sub
Private Sub Winsock2_Close(Index As Integer)
    On Error GoTo errS
    While Winsock2(Index).State <> sckClosed
        Winsock2(Index).Close
        DoEvents
    Wend
    sockInUse(Index) = sockInUse(Index) - 1
    If sockInUse(Index) = 1 Then ' Closed before partner
        Call Winsock1_Close(Index)
    Else
        unloadSocket Index
    End If
    Exit Sub
errS:
    'MsgBox Err.Description
End Sub
Private Sub Winsock1_Close(Index As Integer)
    On Error GoTo errS
    If Index = 0 Then Exit Sub
    While Winsock1(Index).State <> sckClosed
        Winsock1(Index).Close
        DoEvents
    Wend
    sockInUse(Index) = sockInUse(Index) - 1
    If sockInUse(Index) = 1 Then ' Closed before partner
        Call Winsock2_Close(Index)
    Else
        unloadSocket Index
    End If
    Exit Sub
errS:
    'MsgBox Err.Description
End Sub
Private Sub unloadSocket(ByVal Index As Integer)
    Unload Winsock1(Index)
    Unload Winsock2(Index)
    remDoc(Index) = ""
    conMade(Index) = False
    requestHeader(Index) = ""
    remHost(Index) = ""
End Sub
Private Sub setupCon(ByVal conRequest As String, ByVal Index As Integer)
    Dim tmpStrA As String
    Dim tmpStrB As String
    Dim tmpServer As String
    Dim tmpPort As Long
    If InStr(conRequest, "GET ") <> 1 Then Exit Sub
    conRequest = Mid(conRequest, 12)
    conRequest = "GET " & Mid(conRequest, InStr(conRequest, "/"))
    tmpStrA = Left(conRequest, InStr(conRequest, Chr(13) & Chr(10) & "Proxy-") + 1)
    tmpStrB = Mid(conRequest, InStr(conRequest, "Connection: "))
    conRequest = tmpStrA & tmpStrB
    tmpServer = Mid(conRequest, InStr(conRequest, Chr(13) & Chr(10) & "Host: ") + 8)
    tmpServer = Left(tmpServer, InStr(tmpServer, Chr(13) & Chr(10)) - 1)
    If InStr(tmpServer, ":") <> 0 Then
        tmpPort = Val(Mid(tmpServer, InStr(tmpServer, ":") + 1))
    Else
        tmpPort = 80
    End If
    remDoc(Index) = Mid(conRequest, InStr(conRequest, "/"))
    remDoc(Index) = Left(remDoc(Index), InStr(remDoc(Index), " ") - 1)
    requestHeader(Index) = conRequest
    remHost(Index) = tmpServer
    Text1.Text = Text1.Text & remHost(Index) & remDoc(Index) & vbCrLf ' This line is optional
    Winsock2(Index).LocalPort = 0
    Winsock2(Index).Connect tmpServer, tmpPort
End Sub