AW: Webseiten-HTML downloaden
28.08.2008 07:24:00
Erich
Hi Markus,
wenn du nur den reinen HTML-Quelltext einer Seite haben möchtest
(also auch ohne die Quelltexte eingebundener Frames), brauchst du gar keinen Browser.
Mit der Fkt. Get_Webfile(sURL As String) kannst du dir den Quelltext direkt abholen.
An zwei Stellen steht hxxp - die tt habe ich ersetzt, damit aus diesem Beitrag kein Link wird.
Die Quellen stehen oben im Code.
Option Explicit
' www.activevb.de/tipps/vb6tipps/tipp0227.html
' www.softgames.de/forum/frage114440.html
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 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
Private Declare Function InternetReadFile Lib "wininet" ( _
ByVal hFile As Long, ByVal sBuffer As String, ByVal lNumBytesToRead As Long, _
lNumberOfBytesRead As Long _
) As Long
Private Declare Function InternetCloseHandle Lib "wininet" ( _
ByVal hInet As Long _
) As Long
Private Const INTERNET_OPEN_TYPE_DIRECT = 1
Private Const INTERNET_FLAG_RELOAD = &H80000000
Sub Save_Webfile() ' speichert als Textfile
Dim strU As String, strE As String, kk As Integer
strU = "hxxp://www.herber.de/cgi-bin/tag1.pl" ' URL anpassen
strE = Get_Webfile(strU)
kk = FreeFile(1)
Open "c:\temp\xxyycc.htm" For Output As #kk ' Dateinamen anpassen
Print #kk, strE
Close kk
End Sub
Sub Test_Get_Webfile() ' speichert in Exceltabelle
Dim strU As String, strE As String, jj As Long
strU = "hxxp://www.herber.de/cgi-bin/tag1.pl"
strE = Get_Webfile(strU)
Columns(1).Clear
Columns(1).NumberFormat = "@"
jj = 0
While Len(strE) > 100 * jj
Cells(jj + 1, 1) = Replace(Mid(strE, 100 * jj + 1, 100), vbLf, "")
jj = jj + 1
Wend
End Sub
Function Get_Webfile(sURL As String) As String
Dim hOpen As Long, hFile As Long, strBuff As String, intA As Long
Const lngS As Long = 2048
hOpen = InternetOpen("ABC", INTERNET_OPEN_TYPE_DIRECT, vbNullString, vbNullString, 0)
If hOpen Then
hFile = InternetOpenUrl( _
hOpen, sURL, vbNullString, ByVal 0&, INTERNET_FLAG_RELOAD, ByVal 0&)
If hFile Then
strBuff = Space(lngS)
Do
InternetReadFile hFile, strBuff, lngS, intA
Get_Webfile = Get_Webfile & Left(strBuff, intA)
Loop While intA > 0
InternetCloseHandle hFile
Else
Get_Webfile = "FEHLER hFile: " & hFile
End If
InternetCloseHandle hOpen
Else
Get_Webfile = "FEHLER hOpen: " & hOpen
End If
End Function
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort