|
Eine der einfachsten Möglichkeiten, eine Datei aus dem Internet herunter zu laden, hatte bereits mit dem Internet Explorer 3 bzw. Windows 95 OSR 2 (in der IE 4-Installation enthalten) zur Verfügung gestanden, mit der API-Funktion URLDownloadToFile aus der URLMON.DLL. Im einfachsten Fall brauchen Sie dieser Funktion nur die gewünschte Download-Adresse (Parameter URL) und den Dateinamen (Parameter FileName) anzugeben, unter dem die herunter geladene Datei gespeichert werden soll.
Declare Function URLDownloadToFile Lib "urlmon" _
Alias "URLDownloadToFileA" (ByVal Caller As Long, _
ByVal URL As String, ByVal FileName As String, _
ByVal Reserved As Long, ByVal fnCB As Long) As Long
Auch HTML-Seiten lassen sich so herunter laden. Sie kommen allerdings an, wie der angesprochene Server sie tatsächlich ausliefert. Auch fehlen natürlich Grafiken und andere Inhalte (externe Stylesheets, Script-Dateien, Media-Dateien usw.), auf die von einer Seite verwiesen wird.
Die Festlegung des Dateinamens, unter dem gespeichert werden soll, liegt in Ihrer Verantwortung. Eine bereits im gewünschten Pfad vorhandene Datei des gewünschten Namens wird überschrieben. Auch wenn der Original-Name der Datei beibehalten werden soll, müssen Sie den Speicherpfad aus dem gewünschten lokalen Pfad und dem Dateinamen selbst zusammensetzen.
Die folgende Hilfsfunktion URLDownload hilft Ihnen bei der Festlegung und Verwaltung des Speicherzieles und entschlüsselt auch die möglichen Fehlerrückgabewerte der Funktion. Hier können Sie im Parameter Path als Zielpfad entweder einen Ordner-Pfad angeben - dann baut die Funktion den Speicherpfad aus diesem Pfad und dem Original-Dateinamen zusammen. Oder Sie geben bereits einen konkreten, beliebigen Pfaddateinamen an. Im optionalen Parameter Overwrite legen Sie fest, wie sich die Funktion verhalten soll, falls sich unter dem sich ergebenden Pfad bereits eine Datei befinden sollte: Entweder wird die Datei einfach überschrieben (udOverWriteForce). Oder es wird ein Fehler ausgelöst (udOverWriteRaiseErr) oder die Funktion wird ohne Download verlassen (udOverwriteNoAction). Als letzte Möglichkeit bietet die Funktion an, den Dateinamen mit einer Nummerierung zu versehen, wobei ab 2 beginnend die erste freie mögliche Nummer gesucht und dann vergeben wird.
Als Rückgabewert liefert Ihnen die Funktion schließlich den Pfad, unter dem die Datei schließlich und tatsächlich gespeichert worden ist. Konnte sie nicht gespeichert werden, wird ein leerer String zurückgegeben. Die als Rückgabewert der API-Funktion übermittelten möglichen Fehler beim Download selbst werden in abfangbare Laufzeitfehler (URLDownloadErrConstants) umgesetzt.
Die Prüfung, ob eine Datei bereits existiert, wird indirekt mittels der API-Funktion FindExecutable in der privaten Hilfsfunktion zPathExists umgesetzt (siehe  "Sein oder nicht sein (2)"). Den Zusammenbau aus Pfad und Original-Dateiname übernimmt die private Hilfsfunktion zBuildPath (siehe "Pfade komponieren").
Public Declare Function URLDownloadToFile Lib "urlmon" _
Alias "URLDownloadToFileA" (ByVal Caller As Long, _
ByVal URL As String, ByVal FileName As String, _
ByVal Reserved As Long, ByVal fnCB As Long) As Long
Private Declare Function FindExecutable Lib "shell32.dll" _
Alias "FindExecutableA" (ByVal File As String, _
ByVal Directory As String, ByVal Result As String) As Long
Public Enum URLDownloadErrConstants
udErrAborted = &H80004004
udErrDestFileExists = &H800C0001
udErrInvalidUrl = &H800C0002
udErrNoSession = &H800C0003
udErrCannotConnect = &H800C0004
udErrResourceNotFound = &H800C0005
udErrObjectNotFound = &H800C0006
udErrDataNotAvailable = &H800C0007
udErrDownloadFailure = &H800C0008
udErrAuthenticationRequired = &H800C0009
udErrNoValidMedia = &H800C000A
udErrConnectionTimeout = &H800C000B
udErrInvalidRequest = &H800C000C
udErrUnknownProtocol = &H800C000D
udErrSecurityProblem = &H800C000E
udErrCannotLoadData = &H800C000F
udErrCannotInstantiateObject = &H800C0010
udErrRedirectFailed = &H800C0014
udErrRedirectToDir = &H800C0015
udErrCannotLockRequest = &H800C0016
End Enum
Public Enum URLDownloadOverwriteConstants
udOverwriteEnumerate
udOverwriteNoAction
udOverWriteRaiseErr
udOverWriteForce
End Enum
Public Function URLDownload(URL As String, Path As String, _
Optional ByVal Overwrite As URLDownloadOverwriteConstants = _
udOverwriteEnumerate) As String
Dim nPath As String
Dim nPos As Long
Dim nHResult As Long
Dim nCount As Long
Dim nExtension As String
Dim nFileName As String
Dim nDir As String
Dim nIsDir As Boolean
If zPathExists(Path) Then
If (GetAttr(Path) And vbDirectory) = vbDirectory Then
nIsDir = True
End If
End If
If Overwrite = udOverwriteEnumerate Then
If nIsDir Then
nDir = Path
nPos = InStrRev(URL, "/")
If nPos Then
nFileName = Mid$(URL, nPos + 1)
Else
Err.Raise udErrInvalidUrl, "modURLDownload.URLDownload"
End If
Else
nPos = InStrRev(Path, "\")
nDir = Left$(Path, nPos - 1)
nFileName = Mid$(Path, nPos + 1)
nPath = Path
End If
nPos = InStrRev(nFileName, ".")
If nPos Then
nExtension = Mid$(nFileName, nPos)
nFileName = Left$(nFileName, nPos - 1)
End If
nPath = zBuildPath(nDir, nFileName & nExtension)
nCount = 1
Do While zPathExists(nPath)
nCount = nCount + 1
nPath = _
zBuildPath(nDir, nFileName & " (" & nCount & ")" & nExtension)
Loop
Else
If nIsDir Then
nPos = InStrRev(URL, "/")
If nPos Then
nPath = zBuildPath(Path, Mid$(URL, nPos + 1))
Else
Err.Raise udErrInvalidUrl, "modURLDownload.URLDownload"
End If
Else
nPath = Path
End If
If zPathExists(nPath) Then
Select Case Overwrite
Case udOverWriteForce
Case udOverwriteNoAction
Exit Function
Case udOverWriteRaiseErr
Err.Raise udErrDestFileExists, "modURLDownload.URLDownload"
End Select
End If
End If
nHResult = URLDownloadToFile(0, URL, nPath, 0, 0)
If nHResult Then
Err.Raise nHResult, "modURLDownload.URLDownload"
Else
URLDownload = nPath
End If
End Function
Private Function zBuildPath(Path As String, File As String) As String
If Len(Path) Then
If Right$(Path, 1) = "\" Then
zBuildPath = Path & File
Else
zBuildPath = Path & "\" & File
End If
Else
zBuildPath = File
End If
End Function
Private Function zPathExists(Path As String) As Boolean
zPathExists = CBool(FindExecutable(Path, "", Space$(255)) <> 2)
End Function
|