by MerlTalon (1 Submission)
Category: Internet/HTML
Compatability: Visual Basic 5.0
Difficulty: Unknown Difficulty
Originally Published: Tue 30th July 2002
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
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]
VBcoders
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
No comments have been posted about This is a simple proxy program written in VB 5.0. I couldn't find simple enough code online so I cr. Why not be the first to post a comment about This is a simple proxy program written in VB 5.0. I couldn't find simple enough code online so I cr.
