Im Forum wurde vor kurzer Zeit gefragt, wie man einen http-Proxy mit VB realisiert. Dazu machte ich mir auch Gedanken und kurzerhand entstand dieser Workshop. Dieser Workshop ist darauf begrenzt, die theoretische Vorgehensweise anhand eines kleines Beispielprojekts zu erklären, die Praxis sieht wie so oft leicht anders aus. Grundlegendes zu http-Proxys Im Forum wurde vor kurzer Zeit gefragt, wie man einen http-Proxy mit VB realisiert. Dazu machte ich mir auch Gedanken und kurzerhand entstand dieser Workshop. Leider ist das Beispielprojekt, das hieraus hervorgegangen ist, immer noch mit Mängeln behaftet. Warum es nicht zuverlässig funktioniert liegt wohl daran, dass es im Internet viele Browser- und noch mehr Server-Typen gibt, die alle ihre eigene Note haben. Dieser Workshop ist also darauf begrenzt, dass man die Theorie erklärt, die Praxis sieht wie so oft leicht anders aus. http-Request - Unterschiede zwischen DIREKT und PROXY Beim direkten http-Request sendet der Browser an den Webserver sein http-Request mit folgender Grundstruktur: Beispiel: Download der Datei "index.htm" GET /index.htm HTTP/1.1 [Zusätze] z.B. http-Request eines Opera-7.03-Browsers, der sich über "User-Agent" als IE-kompatibel identifiziert: GET / HTTP/1.1 User-Agent: Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1) Opera 7.11 [en] Host: www.google.de Accept: text/html, image/png, image/jpeg, image/gif, image/x-xbitmap, */*;q=0.1 Accept-Language: en;q=1.0,de;q=0.9 Accept-Charset: windows-1252, utf-8, utf-16, iso-8859-1;q=0.6, *;q=0.1 Accept-Encoding: deflate, gzip, x-gzip, identity, *;q=0 Connection: Keep-Alive Zu beachten ist, dass ein http-Request am Ende immer noch zwei Zeilenumbrüche hat (in VB vbCrLf). Der Webserver kann aus diesem Request folgende Informationen erkennen:
Das Selbe, wenn der Browser eine Anfrage an einen Proxy schickt (Änderungen fett): GET http://www.google.de/ HTTP/1.1 User-Agent: Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1) Opera 7.11 [en] Host: www.google.de Accept: text/html, image/png, image/jpeg, image/gif, image/x-xbitmap, */*;q=0.1 Accept-Language: en;q=1.0,de;q=0.9 Accept-Charset: windows-1252, utf-8, utf-16, iso-8859-1;q=0.6, *;q=0.1 Accept-Encoding: deflate, gzip, x-gzip, identity, *;q=0 Proxy-Connection: Keep-Alive Die Unterschiede sind leicht erklärt: Der Browser muss dem Proxy die komplette URL inklusive des verwendeten Protokolls übertragen, damit dieser den Webserver anschreiben kann. Der Browser teilt dem Proxy über Proxy-Connection mit, ob die Verbindung erhalten bleiben soll, was standardmäßig über Proxy-Connection: Keep-Alive aktiviert ist. Nun muss der Proxy eigentlich nichts anderes tun, als aus dieser Anfrage sowohl die Adresse des Hosts auslesen, ggf. das Protokoll erkennen und den Dateinamen herausfinden. Am Ende schickt der Proxy genau die Anfrage an den Server, die normal vom Browser direkt verschickt wird. Von da an muss der Proxy eigentlich nur noch die Daten, die vom Server kommen an den Client bzw. Browser übermitteln und umgekehrt. Der Webserver merkt normal gar nicht, dass er mit einem Proxy und keinem Browser "redet". Dann muss man noch bedenken, was der Proxy tun soll, wenn der Webserver nicht erreichbar ist - und wie man das feststellt. In diesem Workshop habe ich mich der Einfachheit halber für den Tipp von Server anpingen und Reaktionszeit ermitteln entschieden. Für den Fall, dass der Webserver per Ping nicht erreichbar ist, simulieren wir "einfach" einen Webserver, der dem Browser eine einfache HTML-Nachricht zurückschickt, dass der Host nicht erreichbar ist. Dazu musste ich nur eine Standard-Antwort eines Apache-Webservers auswerten und abändern. Übrigens: Meine Tests habe ich auch alle mit dem Apache durchgeführt, da er kostenlos und sehr weit verbreitet ist. An die Arbeit Zuerst in VB ein neues Standard-EXE-Projekt erstellen. Für dieses Projekt benötigen wir das Winsock-Control. Dies bitte über Projekt -> Komponenten oder Strg + T hinzufügen. Dann benötigen wir eine Hauptform frmMain und ein Modul Functions zur Aufnahme der Funktionen. (Ich lagere die Funktionen lieber extern in ein Modul aus, da der Code der Form schon sehr komplex ist.) Alle benötigten Controls (auf frmMain) in dieser Tabelle:
Nachdem alle Controls auf der Form "wohlgeordnet" sind, widmen wir uns dem Programmcode: frmMain Zuerst mal der allgemeine Deklarationsteil: Option Explicit ' Allgemein benötigte Variablen & Funktionen Private Declare Function CharLower Lib "user32" _ Alias "CharLowerA" ( _ ByVal lpsz As String) As String Dim Host As String Dim Oldhost As String Dim Request As String Dim d As String Dim Buffer As String Dim ControlledCancel As Boolean Dim ToSendRequest As Boolean Dann kommt die "Beenden"-Routine: Private Sub cmdQuit_Click() ' Beide Winsocks disconnecten, wenn sie das nicht sind If sckClient.State <> sckClosed Then sckClient.Close End If If sckServer.State <> sckClosed Then sckServer.Close End If End End Sub Dann die Start-Routine, mit der wir den Proxy-Hörgang starten: Private Sub cmdStart_Click() On Error GoTo Fehler ' Überprüfen, ob der LocalPort so eingestellt werden kann If IsNumeric(txtLocalPort.Text) = False Or _ Val(txtLocalPort.Text) > 65535 Or _ Val(txtLocalPort.Text) < 1 Then MsgBox "Bitte gültige Port-Nummer angeben.", vbExclamation Exit Sub End If ' Abhörvorgang starten sckClient.LocalPort = txtLocalPort.Text sckClient.Listen Exit Sub ' Wenn doch ein Fehler auftritt Fehler: MsgBox "Fehler " & Err.Number, vbCritical End Sub Jetzt muss geklärt werden, was passieren soll, wenn ein Client versucht, sich mit dem Proxy zu verbinden. Dann tritt das Ereignis ConnectionRequest bei sckClient auf. Private Sub sckClient_ConnectionRequest(ByVal requestID As Long) ' Abhörvorgang beenden sckClient.Close ' Verbindungsaufnahme akzeptieren sckClient.Accept requestID End Sub Wenn die Verbindung zum Client geschlossen wird: Private Sub sckClient_Close() ' Einstellen, dass die Trennung "gewollt" ist ControlledCancel = True sckServer.Close If sckClient.State <> sckClosed Then sckClient.Close End If ' Proxy wieder starten cmdStart_Click End Sub Genauso, wenn die Verbindung zum Webserver geschlossen wurde: Private Sub sckServer_Close() If ControlledCancel = True Then ' Wenn die Trennung "gewollt" ist, einfach weitermachen Exit Sub End If ' Wenn die Trennung nicht gewollt war und vom WebServer kam If sckServer.State <> sckClosed Then ToSendRequest = False sckServer.Close End If ' Neu mit dem Webserver verbinden sckServer.Connect Host, 80 End Sub Daten empfangen und an den Webserver weiterschicken Jetzt kommt der "harte" Teil, das Empfangen von Daten des Clients (Browser), Auswerten, Modifizieren und Weiterschicken an den Webserver. Private Sub sckClient_DataArrival(ByVal bytesTotal As Long) ' Erst mal alle benötigten Variablen Dim Source As String Dim URL As String Dim Rest As String Dim n As Long Dim i As Long Dim HTTPVersion As String Dim Filepath As String Dim FileTypes As String Dim UserAgent As String Dim Language As String Dim Charset As String Dim Encoding As String Dim Connection As String Dim Referer As String Dim Command As String sckClient.GetData d Buffer = d Buffer = CharLower(Buffer) ' Ob es ein Kommando ist, das modifiziert werden muss, oder nicht If Left(Buffer, 3) <> "get" Or Left(Buffer, 4) = "post" Then If sckServer.State = sckConnected Then sckServer.SendData d End If Exit Sub End If Source = d n = InStr(Source, vbCrLf) Request = Right(Source, Len(Source) - n) Command = Left(Source, n - 1) If Left(Command, 3) = "GET" Then ' wenn der Browser Daten will n = InStr(Command, " HTTP/") URL = Mid(Command, 5, Len(Command) - 4 - 9) HTTPVersion = Right(Command, 8) Buffer = Right(URL, Len(URL) - 7) Host = Left(Buffer, InStr(Buffer, "/") - 1) Filepath = Right(Buffer, Len(Buffer) - Len(Host)) ' Kommando einstellen Command = "GET" ElseIf Left(Command, 4) = "POST" Then ' wenn der Browser Daten schicken will n = InStr(Command, " HTTP/") URL = Mid(Command, 6, Len(Command) - 5 - 9) HTTPVersion = Right(Command, 8) Buffer = Right(URL, Len(URL) - 7) Host = Left(Buffer, InStr(Buffer, "/") - 1) Filepath = Right(Buffer, Len(Buffer) - Len(Host)) ' Kommando einstellen Command = "POST" End If ' Wenn der Webserver nicht erreichbar ist If Ping(Host) = False Then ' Fehlernachricht an den Client senden (wird noch besprochen) Buffer = CreateServerMessage(Host & " nicht erreichbar", _ Host & " nicht erreichbar.", _ "Der Remote-Computer " & Host & " ist nicht erreichbar. " & _ "Stellen Sie sicher dass Sie mit dem Internet verbunden sind " & _ "und dass der Remotehost online ist. " _ " Bitte nutzen Sie diesen Server nur als HTTP-Proxy.") sckClient.SendData Buffer End If ' Den Rest des HTTP-Requests aufspalten und die ' Informationen auswerten Do ' Solange wiederholen, bis Request keine Zeilenumbrüche ' mehr enthält n = InStr(Request, vbCrLf) If n = 0 Then Exit Do End If Buffer = Left(Request, n - 1) Request = Right(Request, Len(Request) - n) Buffer = Right(Buffer, Len(Buffer) - 1) If Left(Buffer, 7) = "Accept:" Then ' Die Datei-(MIME-)Typen, die der Browser akzeptiert FileTypes = Buffer ElseIf Left(Buffer, 16) = "Accept-Language:" Then ' Die Sprache, die neben Englisch noch akzeptiert wird Language = Buffer ElseIf Left(Buffer, 16) = "Accept-Encoding:" Then ' Die Codierungen, die akzeptiert werden Encoding = Buffer ElseIf Left(Buffer, 8) = "Referer:" Then ' Der Referer (über welchen Link man die Seite aufgerufen hat) Referer = Buffer ElseIf Left(Buffer, 11) = "User-Agent:" Then ' Der Browser-Typ UserAgent = Buffer ElseIf Left(Buffer, 17) = "Proxy-Connection:" Then ' Ganz wichtig, Connection muss auf "Keep-Alive" stehen Connection = "Connection:" & Right(Buffer, Len(Buffer) - 17) End If Loop If txtReferer.Text <> "" Then ' Referer austauschen (Verschleierung der Herkunft) Referer = "Referer: " & txtReferer.Text End If ' http-Request zusammensetzen Request = Command & " " & Filepath & " " & HTTPVersion & _ vbCrLf & FileTypes vbCrLf & Referer & vbCrLf & Language & _ vbCrLf & UserAgent & vbCrLf & "Host: " _ & Host & vbCrLf & Connection & vbCrLf & vbCrLf With frmMain.sckServer ' Wenn der Host immer noch der Gleiche und man noch ' immer mit ihm verbunden ist If Host = Oldhost And .State = sckConnected Then .SendData Request Else ' Wenn der Host gewechselt hat ToSendRequest = True If .State <> sckClosed Then .Close End If ' Mit neuem Host verbinden .Connect Host, 80 Oldhost = Host End If End With End Sub Damit haben wir den wohl "schlimmsten" Teil des Proxys geschafft. Erläuterungen zur Vorgehensweise Dazu nun eine Erklärung: Am Anfang wird entschieden, ob es überhaupt ein http-Kommando ist, und welche http-Version verwendet wird. Dann werden Host und Dateipfad ermittelt. Dann kann man, wenn der Webserver per Ping nicht erreichbar ist, eine "Nachricht" an den Browser "zurückschicken". Private Sub sckServer_Connect() ' Wenn die Verbindung nur aufgebaut wurde, ' um die Anfrage zu senden If ToSendRequest = True Then sckServer.SendData Request End If End Sub Jetzt müssen nur noch die Daten, die vom Webserver kommen, an den Client übermittelt werden. Da diese keine Meta-Informationen enthalten, die man noch abändern muss, damit sie passen, kann man sie einfach "weiterleiten". Private Sub sckServer_DataArrival(ByVal bytesTotal As Long) ' Daten vom Server abfangen sckServer.GetData d ' und an den Client weitersenden sckClient.SendData d End Sub Jetzt haben wir den Haupt-Programm-Code fertig. Wir müssen nur noch eine Möglichkeit finden, den Browser, bzw. den Nutzer zu informieren, dass ein Server nicht erreichbar ist, sollte dies der Fall sein. Wie wir das feststellen? Mit dem Ping-Tipp von Dieter Otter (vielen Dank . Das Ganze packen wir in das Functions-Modul. Erst mal der allgemeine Deklarationsteil: Option Explicit Private Declare Function CharLower Lib "user32" _ Alias "CharLowerA" ( _ ByVal lpsz As String) As String ' ### Ping ### Private Declare Function IsDestinationReachable Lib "Sensapi.dll" _ Alias "IsDestinationReachableA" ( _ ByVal lpszDestination As String, _ lpQOCInfo As QOCINFO) As Long Private Type QOCINFO dwSize As Long dwFlags As Long dwInSpeed As Long dwOutSpeed As Long End Type ' ############ Und die Funktion, mit der wir die Erreichbarkeit prüfen: Public Function Ping(ByVal IP As String) As Boolean Dim QuestStruct As QOCINFO Dim lReturn As Long ' Größe der Struktur QuestStruct.dwSize = Len(QuestStruct) ' Prüfen, ob Ziel erreichbar lReturn = IsDestinationReachable(IP, QuestStruct) ' Antwort auswerten If lReturn = 1 Then ' Antwort bekommen Ping = True Else ' keine Antwort Ping = False End If End Function Die Funktion liefert False zurück, wenn der Host nicht erreichbar ist, deshalb die Zeile beim Auswerten... Daten an den Browser schicken und Proxy-Einrichtung Und nun noch, wie wir Daten an den Browser schicken: Public Function CreateServerMessage( _ Optional ByVal Title As String, _ Optional ByVal Head As String, _ Optional ByVal Text As String) As String Dim Message As String Dim HTTPHeader As String Dim Tag As String Dim Monat As String ' Tag einstellen If Weekday(Date) = vbMonday Then Tag = ";Mon"; ElseIf Weekday(Date) = vbTuesday Then Tag = ";Tue"; ElseIf Weekday(Date) = vbWednesday Then Tag = ";Wed"; ElseIf Weekday(Date) = vbThursday Then Tag = ";Thu"; ElseIf Weekday(Date) = vbFriday Then Tag = ";Fri"; ElseIf Weekday(Date) = vbSaturday Then Tag = ";Sat"; ElseIf Weekday(Date) = vbSunday Then Tag = ";Sun"; End If ' Die Nachricht aus den Parametern im HTML-Format erstellen Message = "<html>" & vbCrLf & _ "<head><title>" & Title & "</title></head>" & vbCrLf & _ "<body>" & vbCrLf & "<br><br><h1>" & Head & "</h1>" & _ "<br><br><br>" & vbCrLf & Text & vbCrLf & _ "<br><br><br><i>by(e) proxy...</i>" & _ vbCrLf & "</body>" & vbCrLf & "</html>" ' Und den HTTPHeader, der die Einleitung für die Nachricht gibt HTTPHeader = "HTTP/1.1 OK" & vbCrLf & _ "Date: " & Tag & ", " & DatePart("d", Date) & " " & _ MonthName(DatePart("m", Date), True) & " " & _ DatePart("yyyy", Date) & " " & Time & vbCrLf & _ "Accept-Ranges: bytes" & vbCrLf & _ "Content-Length: " & Len(Message) & vbCrLf & _ "Connection: Keep-Alive" & vbCrLf & _ "Content-Type: text/html" & vbCrLf & vbCrLf CreateServerMessage = HTTPHeader & Message End Function Diese Funktion liefert einen String zurück, der eigentlich dem Nutzer am Schirm und nur indirekt dem Browser mitteilt, dass die Anfrage nicht erfolgreich war. Wer sich mit http auskennt, wird schon erkannt haben, dass wir hier nichts anderes machen, als dem Client eine Antwort zurückzuschicken, die er als Antwort des Webservers annimmt. Wir teilen ihm ein bisschen Information wie Datum und den Inhalts-Typ (Content-Type) mit und er ist "zufrieden". Der Browser hat nämlich einen großen Macken für unsere Zwecke: Er will solange Daten haben, bis das, was in Content-Length steht, gekommen ist. Wir stellen also eine Nachricht zusammen und teilen ihm davor noch die Länge der Nachricht über "Content-Length" mit. Wenn der Browser das erhalten hat, "glaubt" er tatsächlich, er wäre mit dem Webserver verbunden und parst unsere Nachricht, die dem Nutzer am Browser den Fehler klarstellt. Wir gaukeln dem Browser also eigentlich einen Webserver vor und er nimmt es uns netterweise auch noch ab... Dieser Proxy kann den Referer austauschen, wodurch der Webserver nicht (richtig) wissen kann, über welche Links der User sich zu ihm gehangelt hat. Dieser Proxy ist sehr moderat in der Datenverarbeitung. Man kann ihn mit ein bisschen Kenntnis leicht erweitern. So könnte man auch die pers. Information des Browsers austauschen (User-Agent). Leider ist es ein Single-User-Proxy, aber theoretisch müsste man ihn durch mehr Winsock-Controls mit demselben Code (nur auf anderen Ports) auch für mehrere User bauen können. Zuletzt: Die Einrichtung des Proxys Dazu muss man nur die Einstellungen der gewählten DFÜ-Verbindung ändern und als Proxy die Adresse und den Port des Proxys eintragen. Dann noch den Proxy gestartet und ab geht's... Mir ging es in diesem Workshop darum die Grund-Praxis eines Proxy-Servers zu erklären, ich hoffe, das ist mir gelungen... In meiner Version des Proxys habe ich noch eine Log-Funktion integriert, die hier aber wohl ein bisschen umständlich zu erklären gewesen wäre. cu in vb@rchiv Dieser Workshop wurde bereits 39.104 mal aufgerufen.
Anzeige
Diesen und auch alle anderen Workshops finden Sie auch auf unserer aktuellen vb@rchiv Vol.6 (einschl. Beispielprojekt!) Ein absolutes Muss - Geballtes Wissen aus mehr als 8 Jahren vb@rchiv! - nahezu alle Tipps & Tricks und Workshops mit Beispielprojekten - Symbol-Galerie mit mehr als 3.200 Icons im modernen Look Weitere Infos - 4 Entwickler-Vollversionen (u.a. sevFTP für .NET), Online-Update-Funktion u.v.m. |
vb@rchiv CD Vol.6 Geballtes Wissen aus mehr als 8 Jahren vb@rchiv! Online-Update-Funktion Entwickler-Vollversionen u.v.m. Tipp des Monats Januar 2025 Dieter Otter Zeilen einer MultiLine-TextBox ermitteln (VB.NET) Dieser Zipp zeigt, wie man die Zeilen einer MultiLine-TextBox exakt so ermitteln kann, wie diese auch in der TextBox dargestellt werden. sevOutBar 4.0 Vertikale Menüleisten á la Outlook Erstellen von Outlook ähnlichen Benutzer- interfaces - mit beliebig vielen Gruppen und Symboleinträgen. Moderner OfficeXP-Style mit Farbverläufen, Balloon-Tips, u.v.m. |
||||||||||||||||||||||||||||||||||
Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein. |