Startseite / Tipps / VB 5/6-Tipp 0480: Wetterinfos laden (Seite laden und Inhalt isolieren)

VB 5/6-Tipp 0480: Wetterinfos laden (Seite laden und Inhalt isolieren)

 von Tim Braun

'Dieser Quellcode stammt von http://www.activevb.de
'und kann frei verwendet werden. Für eventuelle Schäden
'wird nicht gehaftet.

'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
'Ansonsten viel Spaß und Erfolg mit diesem Source!

'-------------- Anfang Projektdatei Laden.vbp  --------------
' Die Komponente ' (MSINET.OCX)' wird benötigt.

'--------- Anfang Formular "Form1" alias Laden.frm  ---------
' Steuerelement: Rahmensteuerelement "Frame1"
' Steuerelement: Textfeld "Text1" auf Frame1
' Steuerelement: Textfeld "Text2" auf Frame1
' Steuerelement: Textfeld "Text3" auf Frame1
' Steuerelement: Beschriftungsfeld "Label1" auf Frame1
' Steuerelement: Beschriftungsfeld "Label2" (Index von 0 bis 1) auf Frame1
' Steuerelement: Textfeld "Text4"
' Steuerelement: Schaltfläche "Command1"
' Steuerelement: Internetsteuerelement "Inet1"
' Steuerelement: Beschriftungsfeld "Label3"
' Autor: Tim Braun
' E-Mail: ttbraun@web.de
'
' Aktualisierungen durch Florian Rittmeier <florian@activevb.de>
' Am 27.08.2004 auf Basis der bisher geposteten Notizen.
' Am 25.03.2005 um endlich das Problem zu lösen, dass bei
' einigen Nutzern die Seite nicht komplett geladen wird und
' es dadurch zu Fehlern kommt.
' Ich möchte aber darauf hinweisen, dass man etwaige Fehler
' schlicht selbst abfangen sollte.

Option Explicit

Private databuffer As String

Function GetRawInfos(HTML As String) As String
' Diese Funktion nimmt ein paar Anpassungen am herausgeschittenen
' HTML-Quellcode vor damit die Anzeige von ehr unnötigen Zeichen
' befreit ist.

    On Error Resume Next
    Dim Pos As Long, Pos2 As Long
    Dim strTemp1 As String, strTemp2 As String
    
    ' HTML-Tags entfernen
    Pos = InStr(1, HTML, "<")
    
    Do While Pos > 0
        Pos2 = InStr(Pos + 1, HTML, ">")
        strTemp1 = Mid$(HTML, 1, Pos - 1)
        strTemp2 = Mid$(HTML, Pos2 + 1)
        HTML = strTemp1 & " " & strTemp2
        Pos = InStr(1, HTML, "<")
    Loop
    
    ' Zeilenumbrüche konform machen (wetter.net spezifisch)
    HTML = Replace$(HTML, vbLf, vbCrLf, , , vbTextCompare)
    
    ' doppelte Leerzeichen entfernen
    While InStr(1, HTML, "  ", vbTextCompare) > 0
        HTML = Replace$(HTML, "  ", " ", , , vbTextCompare)
    Wend
    
    ' Umwandlung einiger HTML-Entitäten in ihre Repräsentationen
    HTML = Replace$(HTML, "ä", "ä", , , vbTextCompare)
    HTML = Replace$(HTML, "ö", "ö", , , vbTextCompare)
    HTML = Replace$(HTML, "ü", "ü", , , vbTextCompare)
    HTML = Replace$(HTML, "Ä", "Ä", , , vbTextCompare)
    HTML = Replace$(HTML, "Ö", "Ö", , , vbTextCompare)
    HTML = Replace$(HTML, "Ü", "Ü", , , vbTextCompare)
    
    GetRawInfos = Trim$(HTML)
End Function

Private Sub Command1_Click()
    On Error Goto ErrHANDLER
    Dim SiteHTML As String
    Dim ErgStr As String
    Dim Pos1 As Long, Pos2 As Long
    Dim W1 As String, W2 As String
    
    Inet1.Cancel
    
    ' Marker für das Herausschneiden/Extrahieren
    W1 = Trim$(Text2.Text)
    W2 = Trim$(Text3.Text)
    
    ' Aus der Registry auslesen ob ein Proxyserver
    ' verwendet werden soll oder nicht
    Inet1.AccessType = icUseDefault
    
    ' Seite anfordern
    Inet1.Execute Trim$(Text1.Text)
    
    ' Und warten bis sie geladen wurde
    While Inet1.StillExecuting
        DoEvents
    Wend
    
    ' In der Zwischenzeit sollte databuffer im StateChanged-Ereignis
    ' aufgefüllt worden sein
    SiteHTML = databuffer
    
    ' ersten Marker suchen
    Pos1 = InStr(1, SiteHTML, W1)
    
    ' zweiten Marker suchen
    Pos2 = InStr(Pos1 + Len(W1), SiteHTML, W2)
    
    ' Text zwischen den Markern herausschneiden
    ErgStr = Mid$(SiteHTML, Pos1 + Len(W1), Pos2 - (Pos1 + Len(W1)))
    
    ' Text von uninteressanten Daten befreien ...
    Text4.Text = GetRawInfos(ErgStr)
    
    Exit Sub
    
ErrHANDLER:
    Inet1.Cancel
    Call MsgBox("Fehler " & Err.Number & ": " & Err.Description, _
                 vbCritical + vbOKOnly, App.Title)
End Sub

Private Sub Inet1_StateChanged(ByVal State As Integer)
    ' Wenn Daten komplett erhalten, alle Daten abrufen
    If State = icResponseCompleted Then
        Dim chunk As String
        
        chunk = Inet1.GetChunk(1024, icString)
        databuffer = chunk
        While Len(chunk) > 0
            chunk = Inet1.GetChunk(1024, icString)
            databuffer = databuffer & chunk
        Wend
    End If
End Sub
'---------- Ende Formular "Form1" alias Laden.frm  ----------
'--------------- Ende Projektdatei Laden.vbp  ---------------

Tipp-Kompatibilität:

Windows/VB-Version	Win32s	Win95	Win98	WinME	WinNT4	Win2000	WinXP
VB4
VB5
VB6

Hat dieser Tipp auf Ihrem Betriebsystem und mit Ihrer VB-Version funktioniert?

Ja, funktioniert!

Nein, funktioniert nicht bei mir!

VB-Version: VB6 VB5 VB4

Windows-Version: Windows XP Windows 2000 Windows NT4 Windows Me Windows 98 Windows 95 Win32s

Archivierte Nutzerkommentare 

Klicken Sie diesen Text an, wenn Sie die 6 archivierten Kommentare ansehen möchten.
Diese stammen noch von der Zeit, als es noch keine direkte Forenunterstützung für Fragen und Kommentare zu einzelnen Artikeln gab.
Aus Gründen der Vollständigkeit können Sie sich die ausgeblendeten Kommentare zu diesem Artikel aber gerne weiterhin ansehen.

SiteHTML = Inet1.OpenURL(Trim$("http://quizbot.gacksi.de/version.html"), icString)

HTML = Replace$(HTML, "°", " ", , , vbTextCompare)