VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "Socket"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
Private WithEvents Winsock1 As Winsock
Attribute Winsock1.VB_VarHelpID = -1
Private MySocksVersion As Integer, MyDestHost As String, MyDestPort As Long, MySocksAddress As String, MySocksPort As Long, Stage1 As Boolean, Stage2 As Boolean
Public Event Connect()
Public Event Closed()
Public Event DataArrival(ByVal Data As String, ByVal bytesTotal As Long)
Public Event Error(ByVal Description As String)

Public Sub Connect()
On Error Resume Next
Stage1 = False
Stage2 = False
Winsock1.Close
If MySocksAddress = "127.0.0.1" Then MySocksVersion = 0
If MySocksVersion = 0 Then
Winsock1.Connect MyDestHost, MyDestPort
Else
Winsock1.Connect MySocksAddress, MySocksPort
End If
End Sub

Public Sub CloseE()
On Error Resume Next
Stage1 = False
Stage2 = False
Winsock1.Close
RaiseEvent Closed
End Sub

Public Sub SendData(Data As String)
On Error Resume Next
Winsock1.SendData Data
End Sub

Public Property Let SocksAddress(ByVal strSocksAddress As String)
MySocksAddress = strSocksAddress
End Property

Public Property Get SocksAddress() As String
SocksAddress = MySocksAddress
End Property

Public Property Let SocksPort(ByVal lngSocksPort As Long)
MySocksPort = lngSocksPort
End Property

Public Property Get SocksPort() As Long
SocksPort = MySocksPort
End Property

Public Property Let DestinationAddress(ByVal strDestinationAddress As String)
MyDestHost = strDestinationAddress
End Property

Public Property Get DestinationAddress() As String
DestinationAddress = MyDestHost
End Property

Public Property Let DestinationPort(ByVal lngDestinationPort As Long)
MyDestPort = lngDestinationPort
End Property

Public Property Get DestinationPort() As Long
DestinationPort = MyDestPort
End Property

Public Property Let SocksVersion(ByVal intSocksVersion As Long)
MySocksVersion = intSocksVersion
End Property

Public Property Get SocksVersion() As Long
SocksVersion = MySocksVersion
End Property

Private Sub Class_Initialize()
On Error Resume Next
Set Winsock1 = New Winsock
End Sub

Private Sub Class_Terminate()
On Error Resume Next
Set Winsock1 = Nothing
End Sub

Private Sub Winsock1_Close()
On Error Resume Next
Stage1 = False
Stage2 = False
Winsock1.Close
RaiseEvent Closed
End Sub

Private Sub Winsock1_Error(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)
On Error Resume Next
Stage1 = False
Stage2 = False
Winsock1.Close
RaiseEvent Error(Description)
End Sub

Private Sub Winsock1_Connect()
On Error Resume Next
Select Case MySocksVersion
Case Is = 5
Winsock1.SendData GetSock5State
Case Is = 4
If IsIP(MyDestHost) = True Then
Winsock1.SendData LoginSocks4(MyDestHost, MyDestPort)
Else
Winsock1.SendData LoginSocks4a(MyDestHost, MyDestPort)
End If
Case Is = 0
RaiseEvent Connect
End Select
End Sub

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
On Error Resume Next
Dim Data As String
Select Case MySocksVersion
Case Is = 5
If Stage1 = False Then
Winsock1.GetData Data
If Data = Chr(5) & Chr(0) Then
If IsIP(MyDestHost) = True Then
Winsock1.SendData LoginSocks5(MyDestHost, MyDestPort)
Else
Winsock1.SendData LoginSocks5a(MyDestHost, MyDestPort)
End If
Stage1 = True
Stage2 = False
Else
Stage1 = False
Stage2 = False
Winsock1.Close
RaiseEvent Error(ErrorMsg(Asc(Mid(Data, 2, 1))))
End If
Else
If Stage2 = False Then
Winsock1.GetData Data
If Mid(Data, 1, 4) = Chr(5) & Chr(0) & Chr(0) & Chr(1) Then
Stage2 = True
RaiseEvent Connect
Else
Stage1 = False
Stage2 = False
Winsock1.Close
End If
Else
Winsock1.GetData Data
RaiseEvent DataArrival(Data, bytesTotal)
End If
End If
Case Is = 4
If Stage1 = False Then
Winsock1.GetData Data
If Mid(Data, 1, 2) = Chr(0) & Chr(&H5A) Then
Stage1 = True
RaiseEvent Connect
Else
Stage1 = False
Winsock1.Close
End If
Else
Winsock1.GetData Data
RaiseEvent DataArrival(Data, bytesTotal)
End If
Case Is = 0
Winsock1.GetData Data
RaiseEvent DataArrival(Data, bytesTotal)
End Select
End Sub

Private Function IsIP(StrAddress As String) As Boolean
On Error Resume Next
Dim X As Integer
StrAddress = LCase(StrAddress)
For X = 1 To Len(StrAddress)
If Asc(Mid(StrAddress, X, 1)) >= 97 And Asc(Mid(StrAddress, X, 1)) <= 122 Then
IsIP = False
Exit Function
End If
Next X
IsIP = True
End Function

Private Function GetSock5State() As String
On Error Resume Next
GetSock5State = Chr(5) & Chr(1) & Chr(0)
End Function

Private Function LoginSocks5(DestIP As String, DestPort As Long) As String
On Error Resume Next
LoginSocks5 = Chr(5) & Chr(1) & Chr(0) & Chr(1) & Chr(Split(DestIP, ".")(0)) & Chr(Split(DestIP, ".")(1)) & Chr(Split(DestIP, ".")(2)) & Chr(Split(DestIP, ".")(3)) & Chr(Int(DestPort / 256)) & Chr(DestPort Mod 256)
End Function

Private Function LoginSocks4(DestIP As String, DestPort As Long) As String
On Error Resume Next
LoginSocks4 = Chr(4) & Chr(1) & Chr(Int(DestPort / 256)) & Chr(DestPort Mod 256) & Chr(Split(DestIP, ".")(0)) & Chr(Split(DestIP, ".")(1)) & Chr(Split(DestIP, ".")(2)) & Chr(Split(DestIP, ".")(3)) & Chr(0)
End Function

Private Function LoginSocks5a(DestHost As String, DestPort As Long) As String
On Error Resume Next
LoginSocks5a = Chr(5) & Chr(1) & Chr(0) & Chr(3) & Chr(Len(DestHost)) & DestHost & Chr(Int(DestPort / 256)) & Chr(DestPort Mod 256)
End Function

Private Function LoginSocks4a(DestHost As String, DestPort As Long) As String
On Error Resume Next
LoginSocks4a = Chr(4) & Chr(1) & Chr(Int(DestPort / 256)) & Chr(DestPort Mod 256) & String(3, 0) & Chr(1) & Chr(0) & DestHost
End Function

Private Function ErrorMsg(ErrorTyp As Integer) As String
On Error Resume Next
Select Case ErrorTyp
Case Is = 1
ErrorMsg = "General SOCKS server failure"
Case Is = 2
ErrorMsg = "Connection not allowed by ruleset"
Case Is = 3
ErrorMsg = "Network unreachable"
Case Is = 4
ErrorMsg = "Host unreachable"
Case Is = 5
ErrorMsg = "Connection refused"
Case Is = 6
ErrorMsg = "TTL expired"
Case Is = 7
ErrorMsg = "Command not supported"
Case Is = 8
ErrorMsg = "Address type not supported"
Case Is = 9
ErrorMsg = "Connection forcefully rejected"
Case Else
ErrorMsg = "No Acceptable Methods"
End Select
End Function