If wskInt(Index).State = sckConnected Then wskInt(Index).Close
Unload wskInt(Index)
log ("Internal connection " + str(Index) + " unloaded." + vbCrLf)End SubPrivate Sub wskExt_Connect(Index As Integer) Dim Response(0 To 9) As Byte Dim sIP() As String, i As Long On Error Resume Next
Private Sub wskExt_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) log ("Server Error: " + str(Number) + ":" + Description + vbCrLf) Dim Response(0 To 9) As Byte
Response(0) = 5 Response(1) = 4 Response(3) = 1 If wskInt(Index).State <> sckConnected Then Exit Sub
wskInt(Index).SendData ResponseEnd SubPrivate Sub wskInt_Close(Index As Integer) Unload wskInt(Index)
For i = 0 To Request(1) - 1 .sUsername = .sUsername & Chr(Request(2 + i)) Next For i = 0 To Request(2 + Len(.sUsername)) - 1 .sPassword = .sPassword & Chr(Request(3 + Len(.sUsername) + i)) Next
End SubPrivate Sub wskInt_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) log ("Client Error: " + Description + vbCrLf)End SubPrivate Sub log(str As String) txtDebug.Text = txtDebug.Text + str txtDebug.SelStart = Len(txtDebug.Text) End SubPrivate Function isValidUser(username As String, password As String) isValidUser = 1 End Function
Private gSockInstancePrivate Type typSocks
sStat As Integer
sVersion As Byte
sMethodCnt As Byte
sMethods(1 To 255) As Byte
sSelectedMethod As Byte
sUsername As String
sPassword As String
End TypeDim socksRecord() As typSocksPrivate Sub cmdStart_Click()
gSockInstance = 0
wskInt(0).LocalPort = 1080
wskInt(0).Listen
cmdStart.Enabled = False
log ("本地IP：" & wskInt(0).LocalIP & vbCrLf)
log ("Listening on port 1080..." + vbCrLf + vbCrLf)
End Sub
Private Sub wskExt_Close(Index As Integer)
Unload wskExt(Index)
log ("External connection " + str(Index) + " unloaded." + vbCrLf)
If wskInt(Index) Is Nothing Then Exit Sub
If wskInt(Index).State = sckConnected Then wskInt(Index).Close
Unload wskInt(Index)
log ("Internal connection " + str(Index) + " unloaded." + vbCrLf)End SubPrivate Sub wskExt_Connect(Index As Integer) Dim Response(0 To 9) As Byte
Dim sIP() As String, i As Long On Error Resume Next
Response(0) = 5
Response(1) = 0
sIP() = Split(wskExt(Index).RemoteHostIP, ".")
Response(3) = 1
For i = 0 To 3
Response(4 + i) = Val(sIP(i))
Next i
Response(8) = Fix(wskExt(Index).RemotePort / 256)
Response(9) = wskExt(Index).RemotePort - (Fix(wskExt(Index).RemotePort / 256) * 256)
wskInt(Index).SendData Response
log ("Remote server connection succeeful." + vbCrLf)
End SubPrivate Sub wskExt_DataArrival(Index As Integer, ByVal bytesTotal As Long) Dim Response
wskExt(Index).GetData Response
log ("[SERVER]" + StrConv(Response, vbUnicode) + vbCrLf)
wskInt(Index).SendData ResponseEnd Sub
Response(0) = 5
Response(1) = 4
Response(3) = 1 If wskInt(Index).State <> sckConnected Then Exit Sub
wskInt(Index).SendData ResponseEnd SubPrivate Sub wskInt_Close(Index As Integer) Unload wskInt(Index)
log ("Internal connection " + str(Index) + " unloaded." + vbCrLf)
If wskExt(Index) Is Nothing Then Exit Sub
If wskExt(Index).State = sckConnected Then wskExt(Index).Close
Unload wskExt(Index)
log ("External connection " + str(Index) + " unloaded." + vbCrLf)End SubPrivate Sub wskInt_ConnectionRequest(Index As Integer, ByVal requestID As Long) gSockInstance = gSockInstance + 1
Load wskInt(gSockInstance)
ReDim socksRecord(gSockInstance)
socksRecord(gSockInstance).sStat = 0
wskInt(gSockInstance).Accept requestID
End Sub
Dim Request
wskInt(Index).GetData Request
Debug.Print "sStat=" & socksRecord(Index).sStat With socksRecord(Index)
Select Case .sStat
Case 0: 'Method select
.sVersion = Request(0)
If .sVersion = 5 Then
log (vbCrLf + "-----(" + str(Index) + ")----- Method select ----------" + vbCrLf)
log ("Protocol version: " + str(.sVersion) + vbCrLf)
.sMethodCnt = Request(1)
.sSelectedMethod = &HFF 'Not Acceptable
log ("Number of methods: " + str(.sMethodCnt) + vbCrLf)
For i = 1 To .sMethodCnt
.sMethods(i) = Request(1 + i)
If .sMethods(i) = 2 Then
.sSelectedMethod = 2
Exit For
End If
Next i
log ("Selected mothod: " + str(.sSelectedMethod) + vbCrLf)
.sStat = 1
'Method Selection
wskInt(Index).SendData Chr$(.sVersion) & Chr$(.sSelectedMethod)
log ("Return selected method to the client: " + str(.sSelectedMethod) + vbCrLf)
Else
log ("Wrong protocol version: " + str(.sVersion) + vbCrLf)
End If
Case 1: 'Auth
log (vbCrLf + "-----(" + str(Index) + ")----- Auth ----------" + vbCrLf)
For i = 0 To Request(1) - 1
.sUsername = .sUsername & Chr(Request(2 + i))
Next
For i = 0 To Request(2 + Len(.sUsername)) - 1
.sPassword = .sPassword & Chr(Request(3 + Len(.sUsername) + i))
Next
log ("Username: " + .sUsername + vbCrLf)
log ("Password: " + .sPassword + vbCrLf)
If isValidUser(.sUsername, .sPassword) Then
.sStat = 2
wskInt(Index).SendData Chr$(1) & Chr$(0)
log ("User " + .sUsername + " is accepted." + vbCrLf)
Else
wskInt(Index).SendData Chr$(1) & Chr$(1)
log ("User " + .sUsername + " is not accepted." + vbCrLf)
End If
Case 2: 'Accepted
log (vbCrLf + "-----(" + str(Index) + ")----- Accepted ----------" + vbCrLf)
Select Case Request(1)
Case Is = &H1 'CONNECT
CMD = "CONNECT"
Case Is = &H2 'BIND
CMD = "BIND"
Case Is = &H3 'UDP Associate
CMD = "UDP"
End Select
log ("CMD: " + CMD + vbCrLf)
'Host?
Select Case Request(3) 'Type of Host
Case Is = &H1 'IPv4
For i = 0 To 2
Host = Host & Request(4 + i) & "."
Next i
Host = Host & Request(7)
lpos = 8
Case Is = &H3 'String
'First is length
lpos = Request(4)
For i = 0 To lpos - 1
Host = Host & Chr(Request(5 + i))
Next
lpos = 5 + lpos
Case Is = &H4 'IPv6
For i = 0 To 4
Host = Host & "." & Request(4 + i)
Next i
Host = Host & Request(9)
lpos = 10
End Select
log ("HOST: " + Host + vbCrLf)
'Port?
'In Network-Order
Port = Request(lpos) * 256 + Request(lpos + 1)
log ("PORT: " + str(Port) + vbCrLf)
Load wskExt(Index)
With wskExt(Index)
.RemoteHost = Host
.RemotePort = Port
.Connect
End With
.sStat = 3
Case 3: 'ok
log (vbCrLf + "-----(" + str(Index) + ")----- ok ----------" + vbCrLf)
log ("[CLIENT]" + StrConv(Request, vbUnicode) + vbCrLf)
wskExt(Index).SendData Request
End Select
End With
End SubPrivate Sub wskInt_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) log ("Client Error: " + Description + vbCrLf)End SubPrivate Sub log(str As String)
txtDebug.Text = txtDebug.Text + str
txtDebug.SelStart = Len(txtDebug.Text)
End SubPrivate Function isValidUser(username As String, password As String)
isValidUser = 1
End Function