Internetseiten lesen

Sie brauchen eine bestimmte Textstelle einer HTML-Seite, weil sie beispielsweise täglich Kurse aktualisieren wollen? Dazu kann man via Com den Internet-Explorer benutzen. Ein paar API-Funktionen machen das aber auch. Auf der Seite sonderfunktionen.htm ist ein Kommentar eingefügt, der mit diesem Beispiel gelesen und angezeigt wird.

Beispieldatei (url.zip 11 KB)

Option Explicit
Private Const INTERNET_FLAG_RELOAD = &H80000000
Private Const INTERNET_OPEN_TYPE_DIRECT = 1
Private Const INTERNET_OPEN_TYPE_PROXY = 3
Private Const strMeinAgent = "MeineApplikation"

Private Declare Function InternetOpen Lib "wininet" _
  Alias "InternetOpenA" (ByVal sAgent As String, _
  ByVal lAccessType As Long, ByVal sProxyName As String, _
  ByVal sProxyBypass As String, ByVal lFlags As Long) As Long
  Private Declare Function InternetCloseHandle Lib "wininet" _
  (ByVal hInet As Long) As Integer

Private Declare Function InternetReadFile Lib "wininet" _
  (ByVal hFile As Long, ByVal sBuffer As String, _
  ByVal lNumBytesToRead As Long, lNumberOfBytesRead As Long) _
  As Integer

Private Declare Function InternetOpenUrl Lib "wininet" _
  Alias "InternetOpenUrlA" (ByVal hInternetSession As Long, _
  ByVal lpszUrl As String, ByVal lpszHeaders As String, _
  ByVal dwHeadersLength As Long, ByVal dwFlags As Long, _
  ByVal dwContext As Long) As Long

Public Function URL_Lesen(strURL As String, Optional proxy As String)
Dim lngInetConnection As Long
Dim lngInetFile As Long
Dim strInetDummy As String
Dim lngInetBytesCount As Long
Dim lngInetBytesWant As Long
Dim Quelldaten As String
  'Verbindung ins Inet herstellen
  If proxy = "" Then
    'Direkt, ohne proxy
    lngInetConnection = InternetOpen(strMeinAgent, _
    INTERNET_OPEN_TYPE_DIRECT, vbNullString, vbNullString, 0)
  Else
    'Über proxy
    lngInetConnection = InternetOpen(strMeinAgent, _
    INTERNET_OPEN_TYPE_PROXY, proxy, vbNullString, 0)
  End If
  'Handle zur URL holen
  lngInetFile = InternetOpenUrl(lngInetConnection, strURL, _
  vbNullString, ByVal 0&, INTERNET_FLAG_RELOAD, ByVal 0&)
  If lngInetFile <> 0 Then 'Zugriff auf URL möglich
  Do
    lngInetBytesWant = lngInetBytesWant + 100000
    'Buffer erzeugen
    strInetDummy = String(lngInetBytesWant, 0)
    'Daten holen
    InternetReadFile lngInetFile, strInetDummy, _
    lngInetBytesWant, lngInetBytesCount
    'Wenn Buffer zu klein, dann Buffer größer machen
    'und erneut lesen
    If lngInetBytesWant <= lngInetBytesCount Then
      'Handle schließen
      InternetCloseHandle lngInetFile
      'Handle zur URL holen
      lngInetFile = InternetOpenUrl(lngInetConnection, strURL, _
        vbNullString, ByVal 0&, INTERNET_FLAG_RELOAD, ByVal 0&)
    End If
  Loop While lngInetBytesWant <= lngInetBytesCount
  InternetCloseHandle lngInetFile
  Quelldaten = Left$(strInetDummy, lngInetBytesCount)
  End If
  'Verbindung schließen
  InternetCloseHandle lngInetConnection
  URL_Lesen = Quelldaten
End Function

'Und zum Testen
Private Sub cmbUrl_Click()
  MsgBox Mid$(URL_Lesen("http://schwimmer.bei.t-online.de/sonderfunktionen.htm"), 5, 55)
End Sub