ActiveVB - Tipp 0546: HTTP Anfragen über Proxy ausführen

ActiveVB - Tipp 0546: HTTP Anfragen über Proxy ausführen

Download des Beispielprojektes [3,12 KB]

'Dieser Source 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 Winsock über Proxy.vbp --------
' Die Komponente 'Microsoft Winsock Control 6.0 (SP5) (MSWINSCK.OCX)' 
' wird benötigt.

'--------- Anfang Formular "Form1" alias Form1.frm  ---------
' Steuerelement: Textfeld "Text3"
' Steuerelement: Textfeld "Text2"
' Steuerelement: Schaltfläche "Command1"
' Steuerelement: Textfeld "Text1"
' Steuerelement: Windows Socket "Winsock1"
' Steuerelement: Textfeld "Text4"
' Steuerelement: Beschriftungsfeld "Label3"
' Steuerelement: Beschriftungsfeld "Label2"
' Steuerelement: Beschriftungsfeld "Label1"

Option Explicit

Private Sub Command1_Click()
   Dim test As Variant
   Dim slash As Variant
   Dim host As String

   Text4.Text = ""
   If Left(Text1.Text, 7) <> "http://" Then Text1.Text = "http://" &  _
   Text1.Text 'prüfen http:// vorhanden ist, wenn nicht ergänzen
       
   test = Split(Text1.Text, "/")                           'slash 
' anhängen, falls hinter der adresse noch keiner steht
    If UBound(test) < class="token">Then Text1.Text = Text1.Text & "/"
  
   slash = Split(Text1.Text, "/")                          'den 
' Hostnamen und die subdomain herrausfinden
    host = slash(2)
  
   Winsock1.Close                                          'Man kann 
' ja nie wissen...
    Winsock1.RemotePort = Text3.Text                        'Proxy Port
    Winsock1.RemoteHost = Text2.Text                        'Proxy Adresse
    Winsock1.Connect
   Do While Winsock1.State = 6: DoEvents: Loop
   If Winsock1.State <> 7 Then Exit Sub
  
   Winsock1.SendData "GET " & Text1.Text & " HTTP/1.0" & vbCrLf  _
   'Unseren request senden
    Winsock1.SendData "Accept: */*" & vbCrLf                      _
   'Alle mime-Typen akzeptieren
    Winsock1.SendData "Proxy-Connection: Keep-Alive" & vbCrLf     _
   'Allen Proxys mitteilen, das sie die verbindung aufrecht erhalten 
' sollen
    Winsock1.SendData "User-Agent: Mozilla/4.0 (compatible; MSIE 6.0; " & _
   "Windows NT 5.1)" & vbCrLf 'Mitteilen, das wir den IE6 nutzen
    Winsock1.SendData "Host: " & host & vbCrLf                    _
   'Jetzt muß der Proxy noch wissen wohin er die anfrage 
' weiterleiten soll. Würden wir eine direkte verbindung zum host 
' aufbauen, müßten könnten wir das weglassen.
    Winsock1.SendData vbCrLf                                      _
   'Dieser zeilenumbruch signalisiert dem server, das wir fertig sind.
   
End Sub

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
   Dim data As String
   Winsock1.GetData data
   Text4.Text = Text4.Text & data
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)
   MsgBox "Der Winsock hat den Fehler """ & Number & """ gemeldet:"  _
   & vbCrLf & vbCrLf & Description, vbCritical
End Sub

'---------- Ende Formular "Form1" alias Form1.frm  ----------
'--------- Ende Projektdatei Winsock über Proxy.vbp ---------