Mengakses Element WebBrowser Dari Visual Basic 6.0

Option Explicit

Private Sub cmdBack_Click()
    On Error Resume Next
    WebBrowser1.GoBack
End Sub

Private Sub cmdForward_Click()
    On Error Resume Next
    WebBrowser1.GoForward
End Sub

Private Sub cmdGo_Click()
    WebBrowser1.Navigate txtAddress
End Sub

Private Sub Form_Load()
    WebBrowser1.Navigate "http://www.microsoft.com"
End Sub

Private Sub WebBrowser1_DocumentComplete(ByVal pDisp As Object, URL As Variant)

    On Error Resume Next
    If (pDisp Is WebBrowser1.object) Then

        txtAddress = WebBrowser1.LocationURL
        Me.Caption = WebBrowser1.LocationName
        txtText = ""
        tvTreeView.Nodes.Clear
        RecurseFrames WebBrowser1.Document, Nothing
    End If
End Sub

Private Sub RecurseFrames(ByVal iDoc As HTMLDocument, ByVal iNode As node)
    Dim I As Integer
    Dim Range As IHTMLTxtRange
    Dim Title As String
    Dim TextInfo As String
    Dim tvNode As node

    On Error Resume Next

    Title = iDoc.Title
    If Title = "" Then
        Title = iDoc.parentWindow.Name
        If Title = "" Then Title = iDoc.location
    End If

    If iNode Is Nothing Then
        Set tvNode = tvTreeView.Nodes.Add(, , , Title)
    Else
        Set tvNode = tvTreeView.Nodes.Add(iNode.Index, tvwChild, , Title)
    End If

    TextInfo = "Frame: " & Title & vbCrLf & "{" + vbCrLf

    If iDoc.body.tagName = "BODY" Then
        FillTree iDoc, "OBJECT", tvNode, "ActiveX Controls"
        FillTree iDoc, "A", tvNode, "Anchors"
        FillTree iDoc, "IMG", tvNode, "Images"
        FillTree iDoc, "", tvNode, "All"

        Set Range = iDoc.body.createTextRange
        TextInfo = TextInfo & Range.Text & vbCrLf
        Set Range = Nothing
    ElseIf iDoc.frames.length > 0 Then
        For I = 0 To iDoc.frames.length - 1
            TextInfo = TextInfo & "FRAME: " & iDoc.frames(I).Document.nameProp & vbCrLf
            Dim doc As New HTMLDocument
            Dim eCollection As IHTMLElementCollection
            Dim uElement As HTMLUnknownElement
            Set eCollection = iDoc.frames(I).Document.All
            For Each uElement In eCollection
                If uElement.tagName = "HTML" Then
                    doc.All(0).insertAdjacentHTML "BeforeBegin", uElement.innerHTML
                    doc.Title = "Frame: " & iDoc.frames(I).Document.nameProp
                    FillTree doc, "FRAME", tvNode, "FRAME"
                    RecurseFrames doc, tvNode
                    Set doc = Nothing
                End If
            Next uElement
        Next I
    End If

    txtText.Text = txtText.Text & TextInfo & "}" & vbCrLf

End Sub

Private Sub FillTree(iDoc As HTMLDocument, iMatchTag As String, iNode As node, iCategory As String)
    Dim Element As Object
    Dim Info As String
    Dim tvNode As node
    Dim tvCatNode As node

    On Error Resume Next

    Set tvCatNode = Nothing
    For Each Element In iDoc.All
        If iMatchTag = "" Or Element.tagName = iMatchTag Then

            Info = Element.tagName & " "

            If Element.tagName = "IMG" Then
                Info = Info & Element.href
            ElseIf Element.tagName = "A" Then
                Info = Info & Element.innerText & " (" & Element.href & ")"
            ElseIf Element.tagName = "INPUT" Then
                Info = Info & Element.Type
            ElseIf Element.tagName = "META" Then
                Info = Info & Element.nodeName
            ElseIf Element.tagName = "FRAMESET" Then
                Info = Info & Element.Name
            ElseIf Element.tagName = "FRAME" Then
                Info = Info & ": " & Element.src
            Else
                Info = Info & Element.Id
            End If

            If tvCatNode Is Nothing Then
                Set tvCatNode = tvTreeView.Nodes.Add(iNode.Index, tvwChild, , iCategory)
            End If
            Set tvNode = tvTreeView.Nodes.Add(tvCatNode.Index, tvwChild, , Info)
        End If
        If Element.tagName = "FRAME" Then
            Dim I As Long
            For I = 0 To iDoc.frames.length - 1
                If iDoc.frames(I).Document.nameProp = Element.Document.nameProp Then
                    Dim doc As New HTMLDocument
                    Dim eCollection As IHTMLElementCollection
                    Dim uElement As HTMLUnknownElement
                    Set eCollection = iDoc.frames(I).Document.All
                    For Each uElement In eCollection
                        If uElement.tagName = "HTML" Then
                            doc.All(0).insertAdjacentHTML "BeforeBegin", uElement.innerHTML
                            doc.Title = "Frame: " & iDoc.frames(I).Document.nameProp
                            RecurseFrames doc, tvNode
                            Set doc = Nothing
                        End If
                    Next uElement
                End If
            Next I
        End If
    Next
End Sub