Die Community zu .NET und Classic VB.
Menü

VB 5/6-Tipp 0022: Ressource via Inet-Steuerelement aus dem Internet herunterladen

 von 

Beschreibung 

Unter Verwendung des Inet-Steuerelement lässt sich recht einfach das Herunterladen einer Ressource aus dem Internet bewerkstelligen. Hier demonstriert an Hand einer HTML-Seite und eines Gif-Bildes. Der HTML-Quellcode kann dann zum Beispiel weiterverarbeitet oder in ihm nach einer bestimmten Textpassage gesucht werden.

Update am 27. April 2003: Der Tipp wurde vereinfacht, da er zusätzlich Tipp 21 enthielt.
Update am 07. April 2005: Dieser Tipp wurde von Florian Rittmeier komplett überarbeitet.

Schwierigkeitsgrad:

Schwierigkeitsgrad 2

Verwendete API-Aufrufe:

keine

Download:

Download des Beispielprojektes [3,72 KB]

'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 Project1.vbp -------------
' Die Komponente ' (MSINET.OCX)' wird benötigt.

'--------- Anfang Formular "Form1" alias Form1.frm  ---------
' Steuerelement: Internetsteuerelement "Inet1"
' Steuerelement: Textfeld "Text3"
' Steuerelement: Bildfeld-Steuerelement "Picture1"
' Steuerelement: Schaltfläche "Command2"
' Steuerelement: Schaltfläche "Command1"
' Steuerelement: Textfeld "Text2"
' Steuerelement: Textfeld "Text1"

Option Explicit

Private textbuffer As String
Private binarybuffer() As Byte
Private mode As Integer

Public Function GetHTML(ByVal WWW_Adresse As String) As String
  On Error Goto GetHTMLERR
    
  mode = 1
  textbuffer = ""
    
  Inet1.AccessType = icDirect
  Inet1.Protocol = icHTTP
  Inet1.Execute WWW_Adresse
    
  While Inet1.StillExecuting
    DoEvents
  Wend
    
  GetHTML = textbuffer
  Exit Function

GetHTMLERR:
  MsgBox (Err.Description)
  Resume Next
End Function

Public Sub GetRESOURCE(ByVal WWW_Adresse As String)
  On Error Goto GetRESOURCEERR
  
  Dim filename As String
  Dim fnum As Long
  
  filename = App.Path
  If Not Right(filename, 1) = "\" Then filename = filename & "\"
  filename = filename & LastPath(WWW_Adresse)
    
  MousePointer = vbHourglass
  Picture1.Picture = LoadPicture()
  DoEvents

  mode = 2

  Inet1.Execute WWW_Adresse
  
  While Inet1.StillExecuting
    DoEvents
  Wend
  
  If UBound(binarybuffer) - LBound(binarybuffer) + 1 > 1 Then
    fnum = FreeFile
    Open filename For Binary Access Write As #fnum
      Put #fnum, , binarybuffer()
    Close #fnum
    
    ReDim binarybuffer(0)
    
    Picture1.Picture = LoadPicture(filename)
  End If
    
  MousePointer = vbDefault
  Exit Sub
  
GetRESOURCEERR:
  MsgBox (Err.Description)
  Resume Next
End Sub

Private Sub Command1_Click()
    Text1.Text = ""
    
    MousePointer = vbHourglass
    DoEvents
    
    Text1.Text = GetHTML(Text2.Text)

    MousePointer = vbDefault
End Sub

Private Sub Command2_Click()
    Call GetRESOURCE(Text3.Text)
End Sub

Private Sub Inet1_StateChanged(ByVal State As Integer)
  If State = icResponseCompleted Then
    If mode = 1 Then
        ' Textdaten abrufen
        Dim data As String
        
        textbuffer = ""
        data = "dummy"
        
        While Len(data) > 0
            data = Inet1.GetChunk(1024, icString)
            textbuffer = textbuffer & data
        Wend
    ElseIf mode = 2 Then
        ' Binärdaten abrufen
        Dim binbuf() As Byte
        Dim s1 As String, s2 As String
        binbuf = Inet1.GetChunk(1024, icByteArray)
        
        ' Überprüfung auf Dimensionierung
        ' wahrscheinlich Inet-Steuerelement spezifisch
        If LBound(binbuf) <= UBound(binbuf) Then
            binarybuffer = binbuf
            
            While LBound(binbuf) <= UBound(binbuf)
                binbuf = Inet1.GetChunk(1024, icByteArray)
                
                If LBound(binbuf) <= UBound(binbuf) Then
                    s1 = StrConv(binarybuffer, vbUnicode)
                    s2 = StrConv(binbuf, vbUnicode)
                    binarybuffer = StrConv(s1 & s2, vbFromUnicode)
                End If
            Wend
        Else
            ReDim binarybuffer(0)
        End If
    Else
        Call MsgBox("Ungültiger Modus im Inet1_StateChanged!", _
                    vbExclamation + vbOKOnly, App.Title)
    End If
  End If

  If Inet1.ResponseCode <> 0 Then _
     MsgBox (Inet1.ResponseCode & " : " & Inet1.ResponseInfo)
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Inet1.Cancel
End Sub

Private Function LastPath(ByVal Path As String) As String
    Dim aa As String, BB As String
    Dim x As Long
    
    For x = Len(Path) To 1 Step -1
        aa = Mid$(Path, x, 1)
        If aa = "/" Or aa = "\" Then
            Exit For
        Else
            BB = aa & BB
        End If
    Next x
    LastPath = BB
End Function
'---------- Ende Formular "Form1" alias Form1.frm  ----------
'-------------- Ende Projektdatei Project1.vbp --------------

Tipp-Kompatibilität:

Windows/VB-VersionWin32sWin95Win98WinMEWinNT4Win2000WinXP
VB4
VB5
VB6

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

Ja, funktioniert!

Nein, funktioniert nicht bei mir!

VB-Version:

Windows-Version:

Ihre Meinung  

Falls Sie Fragen zu diesem Artikel haben oder Ihre Erfahrung mit anderen Nutzern austauschen möchten, dann teilen Sie uns diese bitte in einem der unten vorhandenen Themen oder über einen neuen Beitrag mit. Hierzu können sie einfach einen Beitrag in einem zum Thema passenden Forum anlegen, welcher automatisch mit dieser Seite verknüpft wird.

Archivierte Nutzerkommentare 

Klicken Sie diesen Text an, wenn Sie die 8 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.

Kommentar von Balthasar am 06.07.2006 um 10:43

Hallo Leute,
ich sitze hinter einem Firmenproxy mit Passwort und Username.
Obwohl ich die entsprechenden Werte im Inet setzte:

Inet1.AccessType = icNamedProxy
Inet1.Proxy = "proxy.meinefirma.de"
Inet1.UserName = "Balthasar"
Inet1.Password = "lol"

funzt der Zugriff nicht.
Gibt's da noch was einzustellen, was ich nicht weiß?

Danke.

Kommentar von Matthias Dietel am 02.06.2005 um 14:50

Ist ein schönes Script, ich habe jedoch noch ein Problem.
Und zwar will ich auf ein dymaisches Bild zugreifen.
Das Bild wird per PHP generiert, daher sieht der Dateiname so aus: bild.php?value=1&value2=2
Damit kann das Script aber nicht umgehen.

Wäre dankbar, wenn mir da jmd weiterhelfen kann.

Matthias

Kommentar von DOMINIC am 15.05.2005 um 18:12

Hallo können Sie mir bitte sagen wie ich ein PC Programm vom Internet herunter lade!

ich dnke für Ihres verstendnis!

Kommentar von Thunder am 19.02.2005 um 20:27

Hallo!
Gibt es auch eine Möglichkeit herauszufinden wieviel Bytes bereits heruntergeladen wurden. Damit das ganze auch eine Progressbar bekommt.

Danke,
Rudi

Kommentar von Gregor Ruoss am 29.10.2004 um 06:19

Danke!

Kommentar von xinorcimo am 28.10.2004 um 12:51

So nun hab ich mir das mal genauer angeschaut und blieb anfangs auch bei dieser 4K-Grenze hängen. Der Hintergrund dafür ist die Begrenzung beim Datentyp String!!!

Ändert also diese Zeile ab:

Public Function GetHTML(ByVal WWW_Adresse$) As String

in

Public Function GetHTML(ByVal WWW_Adresse$)

um somit den Datentyp Variant zu verwenden, der diese Begrenzung nicht hat.

Xinorcimo(a)buha.info

Kommentar von Hendrik Jordt am 12.12.2002 um 09:00

Es funktioniert nicht unter NT4.0

Grund: Die .dll Datei RasApi32.dll ist bei NT4.0 nicht dabei. Ein nachträgliches herunterladen und registrieren (RegSvr32) lässt sich nicht durchführen.

Grüsse,

H. Jordt

Kommentar von Daniel Fiedler am 03.03.2001 um 18:29

Gib es auch ein Beispiel für das Uploaden?