Dim strIcq As String
 
Private Sub Form_Load()
  strIcq = InputBox("Welche ICQ-Nummer soll geprüft werden?")
  Winsock1.Close
  Winsock1.LocalPort = 0
  ' Alle Verbindungen schließen
  Winsock1.Connect "wwp.icq.com", 80
  ' Mit dem Server wwp.icq.com verbinden, mit dem HTTP-Port (80)
End Sub
 
Private Sub Winsock1_Connect()
' Wir sind verbunden
  Dim strHttpRequest As String
 
  ' HTTP-Request senden, ein HTTP-Request ist die Anfrage an den Webserver, 
  ' eine Datei (zB Webseite) zu senden
  strHttpRequest = "GET /scripts/online.dll?icq=" & strIcq & "&img=1 HTTP/1.1" _
    & vbCrLf & _
    "Host: wwp.icq.com" & vbCrLf & _
    "Accept: */*" & vbCrLf & _
    "Connection: close" & vbCrLf & vbCrLf
 
  Winsock1.SendData strHttpRequest ' Ab geht unser HTTP-Request an den Server
End Sub
 
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
  On Error Resume Next
  Static lngContentLength As Long
 
  Dim strData As String
  Dim strHttpHeader As String
  Dim F As Integer
  Dim lPos As Long
 
  ' Daten empfangen
  mSockCtrl.GetData strData
 
  ' Prüfen, ob HTTP-Header enthalten
  ' wenn ja: auswerten und entfernen
  If Not bHeaderSend And Left$(strData, 5) = "HTTP/" Then
    strHttpHeader = Left$(strData, InStr(1, strData, _
      vbCrLf & vbCrLf) + 3)
 
    ' Dateigröße ermitteln
    lPos = InStr(strHttpHeader, "Content-Length: ")
    If lPos > 0 Then
      lngContentLength = Val(Mid$(strHttpHeader, lPos + 15, _
        InStr(Mid$(strHttpHeader, lPos), vbCrLf) - 1))
    End If
 
    ' Header entfernen
    strData = Mid$(strData, Len(strHttpHeader) + 1)
    bHeaderSend = True
  End If
 
  If Not bHeaderSend Then lngContentLength = 0
 
  ' Daten in Datei temporär speichern
  F = FreeFile
  Open App.Path & "\temp.gif" For Append As #F
  Print #F, strData;
  Close #F
 
  ' Fortschritt
  lngFileSize = lngFileSize + Len(strData)
End Sub
 
Private Sub Winsock1_Close()
  ' Fertig, wie groß ist die Datei?
 
  Select Case FileLen(App.Path & "\temp.gif")
  Case 475: MsgBox "ICQ #" & strIcq & " offline." ' Offline
  Case 446: MsgBox "ICQ #" & strIcq & " online." ' Offline
  Case Else: MsgBox "ICQ #" & strIcq & " unbekannt." ' Unbekannt
  End Select
  Winsock1.Close
End Sub

Cu David
--------------------------------------------
ist eine geniale Erfindung

Q-lympics ist geil