AW: Benzinpreise auslesen
08.10.2021 14:42:54
Peter
Hallo Christian,
DEN Teil meines Tankstellenprogramms hatte ich schon vor einem Jahr geschrieben und vergessen, dass ich es da NICHT mit dem typischen IE-Aufruf mache, sondern mit
Declare Function InternetCheckConnection Lib "wininet.dll" Alias _
"InternetCheckConnectionA"
Ich weiß allerdings nicht, ob diese API doch irgendwie den IE braucht...
Das Modul "LadeDateiAusInternet" siehr bei mir wie folgt aus:
Option Explicit
Const INTERNET_OPEN_TYPE_PRECONFIG = 0
'Const INTERNET_FLAG_EXISTING_CONNECT = &H20000000
Const INTERNET_FLAG_HYPERLINK = &H400&
Const FLAG_ICC_FORCE_CONNECTION = &H1
Private Declare Function InternetCheckConnection Lib "wininet.dll" Alias _
"InternetCheckConnectionA" (ByVal lpszUrl As String, ByVal dwFlags As Long, _
ByVal dwReserved As Long) As Long
Private Declare Function InternetOpen Lib "wininet.dll" Alias _
"InternetOpenA" (ByVal lpszAgent As String, ByVal dwAccessType As Long, _
ByVal lpszProxyName As String, _
ByVal lpszProxyBypass As String, _
ByVal dwFlags As Long) As Long
Private Declare Function InternetOpenUrl Lib "wininet.dll" 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
Private Declare Function InternetCloseHandle Lib "wininet.dll" _
(ByVal hInet As Long) As Integer
Private Declare Function InternetReadFile Lib "wininet.dll" _
(ByVal hFile As Long, ByVal lpBuffer As String, _
ByVal dwNumberOfBytesToRead As Long, _
lNumberOfBytesRead As Long) As Integer
Function DownloadURL(ByVal URL As String, A$) As String
'Lädt Daten aus der URL aus Internet in A$.
'Funktioniert hier auch für große Datenmengen, eine Zerlegung mit Mid$ aber nur bis 32767 Zeichen!
Const TimeOut As Single = 3 'Timeout nach x Sekunden
Dim hInternetSession As Long, hURL As Long, DatNum As Integer, ByteAnz As Long
Dim Buffer As String * 4096, DatInhalt As String, TimerStart As Single, StatusT$
Dim ii As Integer
DoEvents 'Mal kurz Screen updaten lassen
'Open an Internet session, and retrieve its handle
On Error GoTo ErrInternetOpen
hInternetSession = InternetOpen("dummy", INTERNET_OPEN_TYPE_PRECONFIG, vbNullString, vbNullString, 0)
On Error GoTo 0
If hInternetSession = 0 Then GoTo ErrInternetOpen
'Open the file and retrieve its handle
On Error GoTo ErrInternetOpenUrl
hURL = InternetOpenUrl(hInternetSession, URL, vbNullString, 0, INTERNET_FLAG_HYPERLINK, 0)
On Error GoTo 0
If hURL = 0 Then GoTo ErrInternetOpenUrl
'Jetzt Inhalt der URL in Blöcken von 4096 Byte einlesen
StatusT$ = "Downloading from """ & URL & """ - Bytes: "
Application.StatusBar = StatusT$ & "0"
Do
TimerStart = Timer 'Warte maximal TimeOut, dass sich die URL wieder meldet
Do While InternetCheckConnection(URL, FLAG_ICC_FORCE_CONNECTION, 0) = False
DoEvents
If Timer > TimerStart + TimeOut Or Timer 0 Then
A$ = DatInhalt
DownloadURL = vbNullString 'Alles OK
Else
DownloadURL = "Konnte von URL nichts Laden"
End If
Raus:
InternetCloseHandle hURL
Raus2:
On Error Resume Next
InternetCloseHandle hInternetSession
On Error GoTo 0
Application.StatusBar = False
Exit Function
ErrInternetOpen:
DownloadURL = "Fehler beim Öffnen des Internets."
GoTo Raus2
ErrInternetOpenUrl:
DownloadURL = "Fehler beim Öffnen der URL" & vbLf & " """ & URL & """."
GoTo Raus2
ErrReadFromURL:
DownloadURL = "Fehler beim Laden von der URL" & vbLf & " """ & URL & """."
GoTo Raus
ErrWriteFile:
DownloadURL = "Fehler beim Schreiben der URL-Inhalte in Datei" & vbLf & " """ & A$ & """."
If Err Then DownloadURL = DownloadURL & vbLf & "Fehler " & Err.Number & ": " & Err.Description
GoTo Raus
End Function
Schau' mal, ob das bei dir auf Win11 noch funktioniert! Ein Feedback würde mich freuen, da hätte ich dann was über Win11 gelernt (das ich nicht habe)!