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