VB 5/6-Tipp 0564: Socks4 Proxy/Server benutzen
von Kill][Switch
Beschreibung
Dieser Tipp zeigt, wie man eine Winsockverbindung durch einen Socks4 Proxy/Server leiten kann. Dazu wird nur das Modul benötigt das sich in dem Projekt befindet - es lässt sich somit also leicht überall einbauen!
Es werden alle Funktionen des Socks4 Protokolls unterstützt. (jedoch nicht die Funktionen von Socks4A!)
Schwierigkeitsgrad: | Verwendete API-Aufrufe: keine | Download: |
'Dieser Quellcode stammt von http://www.activevb.de 'und kann frei verwendet werden. Für eventuelle Schäden 'wird nicht gehaftet. 'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum. 'Ansonsten viel Spaß und Erfolg mit diesem Source! '------------- Anfang Projektdatei Projekt1.vbp ------------- ' Die Komponente ' (MSWINSCK.OCX)' wird benötigt. '--------- Anfang Formular "Form1" alias Form1.frm --------- ' Steuerelement: Timersteuerelement "Timer1" ' Steuerelement: Windows Socket "Winsock1" (Index von 0 bis 0) ' Steuerelement: Schaltfläche "Command2" ' Steuerelement: Textfeld "Text6" ' Steuerelement: Rahmensteuerelement "Frame1" ' Steuerelement: Schaltfläche "Command7" auf Frame1 ' Steuerelement: Schaltfläche "Command6" auf Frame1 ' Steuerelement: Schaltfläche "Command5" auf Frame1 ' Steuerelement: Schaltfläche "Command4" auf Frame1 ' Steuerelement: Textfeld "Text7" auf Frame1 ' Steuerelement: Schaltfläche "Command3" auf Frame1 ' Steuerelement: Schaltfläche "Command1" auf Frame1 ' Steuerelement: Textfeld "Text5" auf Frame1 ' Steuerelement: Textfeld "Text4" auf Frame1 ' Steuerelement: Textfeld "Text3" auf Frame1 ' Steuerelement: Textfeld "Text2" auf Frame1 ' Steuerelement: Textfeld "Text1" auf Frame1 ' Steuerelement: Beschriftungsfeld "Label9" auf Frame1 ' Steuerelement: Beschriftungsfeld "Label6" auf Frame1 ' Steuerelement: Beschriftungsfeld "Label7" auf Frame1 ' Steuerelement: Beschriftungsfeld "Label5" auf Frame1 ' Steuerelement: Beschriftungsfeld "Label4" auf Frame1 ' Steuerelement: Beschriftungsfeld "Label3" auf Frame1 ' Steuerelement: Beschriftungsfeld "Label2" auf Frame1 ' Steuerelement: Beschriftungsfeld "Label1" auf Frame1 ' Steuerelement: Textfeld "Text8" ' Steuerelement: Beschriftungsfeld "Label8" ' ' Autor: Kill][Switch <Kill_Switch.2000@gmx.de> 'Mit diesem Beispiel wird gezeigt wie eine Winsockverbindung 'durch einen Sock4 Server/Proxy zu leiten ist. 'Quelle der Infos über das Socks4 Protokoll 'http://www.socks.nec.com/protocol/socks4.protocol 'Socks4A wird nicht unterstützt! 'Da ich kaum Informationen darüber gefunden habe! 'Sonst werden alle Funktionen des Socks4 Protokolls unterstützt. Option Explicit Private Sub Command1_Click() 'CONNECT Verbindung starten (0) Dim Result As Boolean 'Ist True wenn die Verbindung zum Socksserver geklappt hat Result = Socks4_Connect(Winsock1.Item(0), Text3.Text, _ Text4.Text, Text5.Text, Text1.Text, Text2.Text) If Result = False Then MsgBox "Verbindung zum Socksserver " & _ "fehlgeschlagen!", vbCritical + vbOKOnly, "Socks4 Error" End Sub Private Sub Command2_Click() 'Daten über CONNECT Verbindung senden (0) SendData_WSock Winsock1.Item(0), Text7.Text DebugText "SEND(0): " & Text7.Text End Sub Private Sub Command3_Click() 'CONNECT Verbindung schließen (0) Close_WSock Winsock1.Item(0) End Sub Private Sub Command4_Click() 'BIND - Verbindung herstellen Dim Index As Variant Dim Result As Boolean 'Neues Winsock laden Index = Create_WSock(Winsock1) Result = Socks4_Bind(Winsock1.Item(Index), Text5.Text, _ Text1.Text, Text2.Text) If Result = False Then MsgBox "Verbindung zum Socksserver " & _ "fehlgeschlagen!", vbCritical + vbOKOnly, "Socks4 Error" 'Die UsedID sollte IMMER die gleiche sein! End Sub Private Sub Command5_Click() 'Daten über BIND Verbindung senden (1) SendData_WSock Winsock1.Item(1), Text7.Text DebugText "SEND(1): " & Text7.Text End Sub Private Sub Command6_Click() 'BIND Verbindung schließen (1) Close_WSock Winsock1.Item(1) End Sub Private Sub Command7_Click() 'BIND Winsock entladen (1) If Winsock1.Count > 0 Then Unload_WSock Winsock1.Item(1) End Sub Private Sub Form_Load() 'Vorbereitung - Arrays setzten, ... Reset_WSock Winsock1, True End Sub Sub DebugText(Txt As String) 'Statustext Text6.Text = Text6.Text & Txt & vbCrLf Text6.SelLength = Len(Text6.Text) End Sub Private Sub Timer1_Timer() 'Testfunktion - zeigt den Inhalt des WSocks-Arrays Dim t As String Dim i As Variant For i = 0 To UBound(WSocks) - 1 Step 1 t = t & "Array(" & i & ")" & vbCrLf & _ "sckProtocol: " & WSocks(i).sckProtocol & vbCrLf & _ "sckHostIP: " & WSocks(i).sckHostIP & vbCrLf & _ "sckHostPort: " & WSocks(i).sckHostPort & vbCrLf & _ "sckState: " & WSocks(i).sckState & vbCrLf & _ "sckUsed: " & WSocks(i).sckUsed & vbCrLf & _ "sckSocksIP: " & WSocks(i).sckSocksIP & vbCrLf & _ "sckSocksPort: " & WSocks(i).sckSocksPort & vbCrLf & _ "======================" & vbCrLf Next Text8.Text = "Winsocks: " & Winsock1.Count & vbCrLf & vbCrLf & t End Sub Private Sub Winsock1_Close(Index As Integer) 'Wenn die Verbindung vom Server getrennt wurde 'das Close_Wsock auslösen um alles zu diesem Index zurück zu setzen Close_WSock Winsock1.Item(Index) End Sub Private Sub Winsock1_DataArrival(Index As Integer, ByVal bytesTotal As Long) Dim Data As String 'Eingehende Daten überprüfen auf SocksResp Data = RecvData_WSock(Winsock1.Item(Index)) 'Wenn SocksResp dann Sind die Daten keine Nutzdaten If Data = "" Then Exit Sub DebugText "RECV(" & Index & "): " & Data 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) 'Wenn ein Fehler aufgetreten ist Verbindung trennen 'das Close_Wsock auslösen um alles zu diesem Index zurück zu setzen 'und eine Meldung ausgeben Close_WSock Winsock1.Item(Index) MsgBox "[" & Number & "] " & Description, _ vbCritical + vbOKOnly, "WinsockError" End Sub '---------- Ende Formular "Form1" alias Form1.frm ---------- '--------- Anfang Modul "Module1" alias Module1.bas --------- ' ' Autor: Kill][Switch <Kill_Switch.2000@gmx.de> 'Mit diesem Modul ist es ganz einfach möglich Winsockverbindungen 'durch einen Sock4 Server/Proxy zu leiten. 'Quelle der Infos über das Socks4 Protokoll 'http://www.socks.nec.com/protocol/socks4.protocol 'Socks4A wird nicht unterstützt! 'da ich kaum Informationen darüber gefunden habe 'sonst werden alle Funktionen des Socks4 Protokolls unterstützt '!!!WICHTIGE INFOS!!! '-------------------- 'BIND: 'Wird ein Port am Sock4 Proxy/Server mit dem BIND-Befehl geöffnet 'so bleibt die Winsockverbindung vom Client zum Socks4 bestehen. 'Wird innerhalb eines Timeouts keine Verbindung auf den offenen Port 'festgestellt dann sendet der Socks4 eine Fehlermeldung und der 'Client MUSS die Verbindung trennen! 'ConnectionRequest übergaben auf einen anderen Port sind NICHT möglich! 'Es muss für jede eingehende Verbindung ein Winsock/Port am Socks4 'geöffnet werden. 'BIND ist also somit nicht gut geeignet für z.B. Chat- oder 'Sharing-Tools! Option Explicit Public Type Winsck 'Ist das Winsock zu diesem ArrayIndex geladen? sckUsed As Boolean 'Status (CLOSED,CONNECTED,...) sckState As Variant 'IP des Zielhosts vom Socksserver bestätigts sckHostIP As String 'Port des Zielhosts vom Socksserver bestätigts sckHostPort As String 'Verwendetes Socksprotokoll '(4 = Socks4 - 0 = nicht Verbunden oder sckUsed = False) sckProtocol As Byte 'Bind - SocksServerIP sckSocksIP As String 'Bind - SocksServerPort - wartend auf Verbindung sckSocksPort As String End Type 'Zu jedem Winsock wird ein Array unter dem selben Index mit Infos erstellt Public WSocks() As Winsck Dim FreeWsck() As Variant Const CLOSED = 0 Const CONNECTED = 1 Const S4_CONNECT_SEND = 2 'Socks4 Connect - auf Antwort warten Const S4_BIND_SEND = 3 'Socks4 Bind - auf Antwort warten Const S4_BIND_WAIT = 4 'Socks4 Bind - auf Verbindung/Fehler warten Function Socks4_Connect(WSock As Winsock, HostIP As String, _ HostPort As String, UserID As String, SocksServer As String, _ SocksPort As String) As Boolean On Error Goto SocksERROR Dim SocksHeader As String Dim SocksHostIP As String Dim TempArray() As String Dim i As Long Dim SocksResp As String With WSock .Close Wait_WSock WSock, sckClosed, False 'Zum Socksserver verbinden .Connect SocksServer, SocksPort Wait_WSock WSock, sckConnecting, True 'Ziel IP zerlegen... ReDim TempArray(0) TempArray = Split(HostIP, ".") If UBound(TempArray) <> 3 Then Goto SocksERROR HostIP = "" For i = 0 To 3 Step 1 HostIP = HostIP & getChr(getHex(TempArray(i), "2")) Next '1 - h04 - Socksversion 4 SocksHeader = Chr(&H4) '2 - h01 - CMD: Connect SocksHeader = SocksHeader & Chr(&H1) '3,4 - Port des Zielhosts SocksHeader = SocksHeader & getChr(getHex(HostPort, "4")) '5,6,7,8 - IP des Zielhosts SocksHeader = SocksHeader & HostIP '9,10,... (variable Länge) - User ID SocksHeader = SocksHeader & getChr(getHex(UserID, "0")) 'Letztes Byte - h00 - Abschluss SocksHeader = SocksHeader & Chr(&H0) 'Status auf "Warte auf Antwort" setzten und Header senden WSocks(.Index).sckState = S4_CONNECT_SEND WSocks(.Index).sckProtocol = 4 .SendData SocksHeader End With Socks4_Connect = True Exit Function SocksERROR: Socks4_Connect = False End Function Function Socks4_Bind(WSock As Winsock, UserID As String, _ SocksServer As String, SocksPort As String) As Boolean On Error Goto SocksERROR Dim HostPort As String Dim SocksHeader As String Dim SocksHostIP As String Dim TempArray() As String Dim i As Long Dim HostIP As String Dim SocksResp As String With WSock .Close Wait_WSock WSock, sckClosed, False 'Zum Socksserver verbinden .Connect SocksServer, SocksPort Wait_WSock WSock, sckConnecting, True 'Als IP wird die Lokale IP übertragen (?) HostIP = WSock.LocalIP 'IP zerlegen... ReDim TempArray(0) TempArray = Split(HostIP, ".") If UBound(TempArray) <> 3 Then Goto SocksERROR HostIP = "" For i = 0 To 3 Step 1 HostIP = HostIP & getChr(getHex(TempArray(i), "2")) Next 'Als Port wird der Lokale Port übertragen (?) HostPort = WSock.LocalPort '1 - h04 - Socksversion 4 SocksHeader = Chr(&H4) '2 - h02 - CMD: Bind SocksHeader = SocksHeader & Chr(&H2) '3,4 - Port des Zielhosts SocksHeader = SocksHeader & getChr(getHex(HostPort, "4")) '5,6,7,8 - IP des Zielhosts SocksHeader = SocksHeader & HostIP '9,10,... (variable Länge) - User ID SocksHeader = SocksHeader & getChr(getHex(UserID, "0")) 'Letztes Byte - h00 - Abschluss SocksHeader = SocksHeader & Chr(&H0) 'Status auf "Warte auf Antwort" setzten und Header senden WSocks(.Index).sckState = S4_BIND_SEND WSocks(.Index).sckProtocol = 4 .SendData SocksHeader End With Socks4_Bind = True Exit Function SocksERROR: Socks4_Bind = False End Function Public Function RecvData_WSock(WSock As Winsock) As String 'Empfange Daten verarbeiten Dim Data As String Dim Socks_VN As String Dim Socks_CD As String Dim Socks_Port As String Dim Socks_IP As String Dim i As Variant Dim Temp As String Dim ErrMsg As String With WSock .GetData Data 'Wenn auf SocksResp gewartet wird... (CONNECT) If WSocks(.Index).sckState = S4_CONNECT_SEND Then 'SocksResp verarbeiten If Len(Data) <> "8" Then Goto SocksERROR Socks_VN = Mid(Data, 1, 1) Socks_CD = Mid(Data, 2, 1) Socks_Port = Mid(Data, 3, 2) Socks_IP = Mid(Data, 5, 4) 'VN muss h00 sein If getHex(Asc(Socks_VN), 2) <> "00" Then Goto SocksERROR 'Status verarbeiten... Select Case Socks_CD Case Chr(&H5A) 'request granted : ) Case Else: Goto SocksERROR End Select 'Information in WSocks-Array speichern For i = 1 To 4 Step 1 Temp = Temp & Asc(Mid(Socks_IP, i, 1)) & "." Next WSocks(.Index).sckState = CONNECTED WSocks(.Index).sckHostIP = Left(Temp, Len(Temp) - 1) Temp = Asc(Mid(Socks_Port, 1, 1)) Temp = (Temp * 256) + Asc(Mid(Socks_Port, 2, 1)) WSocks(.Index).sckHostPort = Temp 'Funktion beenden da keine Nutzdaten RecvData_WSock = "" Exit Function End If 'Wenn auf SocksResp gewartet wird... (BIND) If WSocks(.Index).sckState = S4_BIND_SEND Then 'SocksResp verarbeiten If Len(Data) <> "8" Then Goto SocksERROR Socks_VN = Mid(Data, 1, 1) Socks_CD = Mid(Data, 2, 1) Socks_Port = Mid(Data, 3, 2) Socks_IP = Mid(Data, 5, 4) 'VN muss h00 sein If getHex(Asc(Socks_VN), 2) <> "00" Then Goto SocksERROR 'Status verarbeiten... Select Case Socks_CD Case Chr(&H5A) 'request granted : ) Case Else: Goto SocksERROR End Select 'Information in WSocks-Array speichern For i = 1 To 4 Step 1 Temp = Temp & Asc(Mid(Socks_IP, i, 1)) & "." Next WSocks(.Index).sckState = S4_BIND_WAIT WSocks(.Index).sckSocksIP = Left(Temp, Len(Temp) - 1) Temp = Asc(Mid(Socks_Port, 1, 1)) Temp = (Temp * 256) + Asc(Mid(Socks_Port, 2, 1)) WSocks(.Index).sckSocksPort = Temp 'Funktion beenden da keine Nutzdaten RecvData_WSock = "" Exit Function End If 'Wenn auf SocksResp gewartet wird... (BIND Client connected) If WSocks(.Index).sckState = S4_BIND_WAIT Then 'SocksResp verarbeiten If Len(Data) <> "8" Then Goto SocksERROR Socks_VN = Mid(Data, 1, 1) Socks_CD = Mid(Data, 2, 1) Socks_Port = Mid(Data, 3, 2) Socks_IP = Mid(Data, 5, 4) 'VN muss h00 sein If getHex(Asc(Socks_VN), 2) <> "00" Then Goto SocksERROR 'Status verarbeiten... Select Case Socks_CD Case Chr(&H5A) 'request granted : ) Case Else: Goto SocksERROR End Select 'Information in WSocks-Array speichern For i = 1 To 4 Step 1 Temp = Temp & Asc(Mid(Socks_IP, i, 1)) & "." Next WSocks(.Index).sckState = CONNECTED WSocks(.Index).sckHostIP = Left(Temp, Len(Temp) - 1) Temp = Asc(Mid(Socks_Port, 1, 1)) Temp = (Temp * 256) + Asc(Mid(Socks_Port, 2, 1)) WSocks(.Index).sckHostPort = Temp 'Funktion beenden da keine Nutzdaten RecvData_WSock = "" Exit Function End If End With 'Nutzdaten zurückgeben RecvData_WSock = Data Exit Function SocksERROR: 'Bei einem Fehler MUSS der Client die Verbindung trennen! Close_WSock WSock 'Status verarbeiten... Select Case Socks_CD Case Chr(&H5A) 'request granted : ) Case Chr(&H5B) ErrMsg = "request rejected or failed!" Case Chr(&H5C) ErrMsg = "request rejected becasue SOCKS server cannot" & _ "connect to identd on the client!" Case Chr(&H5D) ErrMsg = "request rejected because the client program" & _ "and identd report different user-ids!" Case Else Socks_CD = "" End Select If Socks_CD = "" Then ErrMsg = "fatal error!" MsgBox ErrMsg, vbCritical + vbOKOnly, "Socks4 Error" End Function Public Function SendData_WSock(WSock As Winsock, Data As String) As Boolean 'Daten senden... With WSock 'wenn nicht auf ein SocksResp gewartet wird! If WSocks(.Index).sckState = CONNECTED Then .SendData Data SendData_WSock = True Else SendData_WSock = False End If End With End Function Public Function Create_WSock(WSock As Object) As Variant 'Erstellt ein neues Winsock der neue Index wird zurück gegeben 'Aufruf: Create_WSock(Winsock1) Dim FreeIndex As Variant With WSock If UBound(FreeWsck) > 0 Then 'letzten freien Index wählen FreeIndex = FreeWsck(UBound(FreeWsck)) 'letzten freien Index aus Array löschen ReDim Preserve FreeWsck(UBound(FreeWsck) - 1) Else 'kein freier Index vorhanden - nächsten Index wählen FreeIndex = .Count 'Da neuer Index wird auch das Wsocks-Array größer ReDim Preserve WSocks(FreeIndex + 1) End If 'Winsock laden und Array mit Infos füllen Load .Item(FreeIndex) SetWSocks FreeIndex, True End With Create_WSock = FreeIndex End Function Public Sub Unload_WSock(WSock As Winsock) 'Entfernt ein Winsock aus dem Array Dim NewIndex As Variant With WSock 'Winsock schließen... Close_WSock WSock 'Wenn der Index gleich dem letzten Array ist... If .Index = UBound(WSocks) - 1 Then '...dann entferne das letzte ReDim Preserve WSocks(UBound(WSocks) - 1) Else 'oder den freien Index ans Array hängen... NewIndex = UBound(FreeWsck) + 1 ReDim Preserve FreeWsck(NewIndex) FreeWsck(NewIndex) = .Index 'und das WSocks-Array leeren SetWSocks .Index, False End If 'Winsock entladen Unload WSock End With End Sub Public Sub Reset_WSock(WSock As Object, Start As Boolean) 'Alles zurück setzten 'Aufruf: Reset_Wsock(Winsock1) Dim i As Variant 'Beim start gibts noch nix zum entladen If Start = False Then 'Winsocks entladen (?) For i = 0 To UBound(WSocks) - 1 Step 1 'Objekt anpassen! Close_WSock WSock.Item(i) 'Objekt 0 ist ja immer da! If i > 0 Then Unload WSock.Item(i) Next End If 'Arrays zurücksetzten ReDim FreeWsck(0) ReDim WSocks(1) SetWSocks 0, True End Sub Sub Close_WSock(WSock As Winsock) 'Ein Winsock schließen With WSock .Close Wait_WSock WSock, sckClosed, False SetWSocks .Index, True End With End Sub Sub SetWSocks(Index As Variant, sckUsed As Boolean) WSocks(Index).sckState = CLOSED WSocks(Index).sckUsed = sckUsed WSocks(Index).sckHostIP = "" WSocks(Index).sckHostPort = "" WSocks(Index).sckProtocol = 0 WSocks(Index).sckSocksIP = "" WSocks(Index).sckSocksPort = "" End Sub Sub Wait_WSock(WSock As Winsock, WSockState As Variant, Gleich As Boolean) 'Warten auf einen bestimmten Winsock.State If Gleich = True Then Do While WSock.State = WSockState DoEvents Loop Else Do While WSock.State <> WSockState DoEvents Loop End If End Sub Function getHex(AscWert As String, HexLen As Byte) As String 'Gibt HexString zurück Dim Result As String Result = Hex(AscWert) If HexLen = 0 Then 'HexLen ist 0 = Variable HexLen If InStr(Len(Result) / 2, ",") Then Result = "0" & Result End If Else 'Mit Nullen füllen bis HexLen Result = String(HexLen - Len(Result), "0") & Result End If getHex = Result End Function Function getChr(HexWert As String) As String 'Function um HexStrings umzuwandeln Dim i As Long Dim Result As String For i = 1 To Len(HexWert) Step 2 Result = Result & Chr("&H" & Mid(HexWert, i, 2)) Next getChr = Result End Function '---------- Ende Modul "Module1" alias Module1.bas ---------- '-------------- Ende Projektdatei Projekt1.vbp --------------
Tipp-Kompatibilität:
Windows/VB-Version | Win32s | Win95 | Win98 | WinME | WinNT4 | Win2000 | WinXP |
VB4 | |||||||
VB5 | |||||||
VB6 |
Ihre Meinung
Falls Sie Fragen zu diesem Artikel haben oder Ihre Erfahrung mit anderen Nutzern austauschen möchten, dann teilen Sie uns diese bitte in einem der unten vorhandenen Themen oder über einen neuen Beitrag mit. Hierzu können sie einfach einen Beitrag in einem zum Thema passenden Forum anlegen, welcher automatisch mit dieser Seite verknüpft wird.
Archivierte Nutzerkommentare
Klicken Sie diesen Text an, wenn Sie die 1 archivierten Kommentare ansehen möchten.
Diese stammen noch von der Zeit, als es noch keine direkte Forenunterstützung für Fragen und Kommentare zu einzelnen Artikeln gab.
Aus Gründen der Vollständigkeit können Sie sich die ausgeblendeten Kommentare zu diesem Artikel aber gerne weiterhin ansehen.
Kommentar von Wolfgang am 20.02.2007 um 22:14
Moin Moin,
das Beispiel funktioniert nicht vollständig, die "Connect" Verbindung wird hergestellt und bestätigt. Versuche ich eine "Bind" Verbindung herzustellen, kommt der Fehler "request rejected or failed!" . Meine Vermutung das der offene Port über eine Firewall geblockt wird! Falsche Vermutung. Über den Debugger konnte ich festgestellt,
dass in der "Function RecvData_WSock" bei der Abfrage "WSocks(.Index).sckState = S4_BIND_SEND" als Sock-IP 0.0.0.0 zurück gegeben wird, und weiter kann ich nicht folgen.
für eine kleine Hilfestellung wäre ich Dankbar.
Gruß Wolfgang