ERFORDERLICHE
OBJEKTE
1 Commandbutton (Command1)
1 Textbox (Text1) - Multiline auf True setzen !
1 Label (Label1)
FORM-CODE
Private Declare Function DeleteUrlCacheEntry Lib "wininet" Alias _
"DeleteUrlCacheEntryA" (ByVal lpszUrlName As String) As Long
Private Declare Function URLDownloadToFile Lib "urlmon" Alias _
"URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, _
ByVal szFileName As String, ByVal dwReserved As Long, _
ByVal lpfnCB As Long) As Long
Private Const ERROR_SUCCESS As Long = 0
Private Function WebDownload(URL As String) As String
Dim targetFile As String
Dim hFile As Long
On Error Resume Next
'Datei aus Cache leeren
Call DeleteUrlCacheEntry(URL)
'temporärer Dateiname auf der Festplatte
targetFile = App.Path
If Right(targetFile, 1) <> "\" Then targetFile = targetFile & "\"
targetFile = targetFile & "download.tmp"
If Dir(targetFile) <> "" Then Kill targetFile
'Download staren
If DownloadFile(URL, targetFile) Then
hFile = FreeFile
Open targetFile For Input As #hFile
WebDownload = Input$(LOF(hFile), hFile)
Close #hFile
Kill targetFile
Else
WebDownload = "Error"
End If
If Err.Number <> 0 Then WebDownload = "Error"
End Function
Private Function DownloadFile(ByVal sURL As String, _
ByVal sLocalFile As String) As Boolean
Dim lngRetVal As Long
DownloadFile = URLDownloadToFile(0&, sURL, _
sLocalFile, 0&, 0&) = ERROR_SUCCESS
End Function
Private Sub Form_Load()
Command1.Caption = "Download"
Text1 = ""
End Sub
Private Sub Command1_Click()
Dim URL As String
'Datei zum Downloaden
URL="http://www.schmittis-page.de/vb/beispieldatei.txt"
'Download durchführen
tmp = WebDownload(URL)
'Zeilenumbrüche setzen
tmp = Replace(tmp, Chr(10), vbNewLine)
Text1.Text = tmp
Label1.Caption = URL
End Sub
|