Zurück zur Homepage

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