vb@rchiv · Tipps & Tricks · Link-Klick im WebBrowser-Control abfangen

Rubrik: HTML/Internet/Netzwerk · WebBrowser | VB-Versionen: VB4, VB5, VB6

28.10.04

Link-Klick im WebBrowser-Control abfangen Hier erfahren Sie, wie man Mausklicks auf externe Links, wie Download- oder EMail-Adressen, im WebBrowser-Control abfangen kann.
Autor: Dieter Otter	Bewertung:	Views: 15.927
www.tools4vb.de	System: Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11	Beispielprojekt auf CD

Sie haben Ihren eigenen Browser programmiert? Dann wäre es doch schön, auch entsprechend auf Mausklicks auf externe Links reagieren zu können, um so bspw. beim Klick auf einen EMail-Link ein eigenes Fenster zu öffnen, um eine Nachricht zu versenden.

Hierzu brauchen Sie lediglich den URL-Parameter im BeforeNavigate2-Ereignis auszuwerten.
Gleichzeitig zeigt nachfolgender Code auch, wie man einen EMail-Link in seine Bestandteile "Empfänger" und evtl. zusätzlich angegebene Parameter, wie "Subject", "Body", etc. zerlegen kann.

Private Sub WebBrowser1_BeforeNavigate2(ByVal pDisp As Object, URL As Variant, _
  Flags As Variant, TargetFrameName As Variant, PostData As Variant, _
  Headers As Variant, Cancel As Boolean)
 
  ' Klick auf EMail-Adresse?
  If LCase$(Left$(URL, 7)) = "mailto:" Then
    ' Vorgang abbrechen
    Cancel = True
 
    Dim sEMail As String
    Dim sParam As Variant
    Dim i As Long
    Dim nPos As Long
 
    ' EMail-Adresse extrahieren
    sEMail = Mid$(URL, 8)
 
    ' Parameter extrahieren
    If InStr(sEMail, "?") > 0 Then
      sParam = Split(Mid$(sEMail, InStr(sEMail, "?") + 1), "&")
      sEMail = Left$(sEMail, InStr(sEMail, "?") - 1)
    End If
 
    ' Eigenen Dialog zum Versenden von Nachrichten anzeigen
    Load frmNewMail
    With frmNewMail
      ' Empfänger
      .txtTo.Text = sEMail
 
      ' Zusätzliche Parameter, wie Subject etc. auswerten
      If IsArray(sParam) Then
        For i = 0 To UBound(sParam)
          nPos = InStr(sParam(i), "=")
          If nPos > 0 Then
            Select Case LCase$(Left$(sParam(i), nPos - 1))
              Case "subject"
                .txtSubject = Mid$(sParam(i), nPos + 1)
              Case "body"
                .txtBody = Mid$(sParam(i), nPos + 1)
            End Select
          End If
        Next i
 
        ' Dialog anzeigen
        .Show
      End If
    End With
 
  ElseIf UCase$(Right$(URL, 4)) = ".EXE" Or UCase$(Right$(URL, 4)) = ".ZIP" Then
    ' File-Download
    If MsgBox("File-Download: " & URL & vbCrLf & vbCrLf & _
      "Download jetzt starten?", vbQuestion + vbYesNo) = vbNo Then
      ' Vorgang abbrechen
      Cancel = True
    End If
 
  Else
    ' Sonstiger Link
    If Me.Visible Then
      If MsgBox("Link: " & URL & vbCrLf & vbCrLf & _
        "Jetzt ausführen?", vbQuestion + vbYesNo) = vbNo Then
        ' Vorgang abbrechen
        Cancel = True
      End If
    End If
  End If
End Sub