Find All Links in Document

Date: 02-16-2022

Return to Index

 
Credit: 
http://www.powerbasic.com/support/pbforums/showthread.php?t=39275
 
'Compilable Example:  (Jose Includes)
#Compile Exe
#Dim All
%Unicode = 1
%UseWebBrowser = 1            ' // Use the WebBrowser control
#Include Once "CWindow.inc"   ' // CWindow class
 
%IDC_WebBrowser  = 1001
%IDC_FindByLinks = 1002
%IDC_FindBytag   = 1003
%IDC_Tag         = 1004
 
Function PBMain
   Local hDlg As Dword, bstrURL As WString
   Dialog New Pixels, 0, "WebBrowser Search Test", , , 800, 1000, %WS_OverlappedWindow To hDlg
   Control Add Button, hDlg, %IDC_FindByLinks, "Find Links By .Links", 10,10,140,20
   Control Add Button, hDlg, %IDC_FindByTag, "Find Links ByTagName", 160,10,140,20
   Control Add TextBox, hDlg, %IDC_Tag, "a", 310,10,100,20
 
   Local pWindow As IWindow
   pWindow = Class "CWindow"
   bstrURL = "http://www.powerbasic.com/support/pbforums/showthread.php?t=40946"
   pWindow.AddWebBrowserControl(hDlg, %IDC_WEBBROWSER, bstrURL, Nothing, 0, 40, 600,350)
 
   Dialog Show Modal hDlg, Call DlgProc
End Function
 
CallBack Function DlgProc() As Long
   Local hBrowser As Dword
   Local pIWebBrowser2 As IWebBrowser2
   Local pIHTMLDocument2 As IHTMLDocument2
   Local pIHTMLDocument3 As IHTMLDocument3
   Local Elems As IHTMLElementCollection
   Local E As IHTMLElement
   Local temp$,tmp$$, V As Variant, i,j,k,iCount,iResult As Long
   Local oEnum As IEnumVARIANT
 
   Select Case CbMsg
      Case %WM_Command
         Select Case Cb.Ctl
            Case %IDC_FindByLinks
               hBrowser = GetDlgItem(Cb.Hndl,%IDC_WebBrowser)
               pIWebBrowser2 = OC_GetDispatch(hBrowser) 'reference to webbrowser control default interface
               pIHTMLDocument2 = pIWebBrowser2.Document
               Elems = pIHTMLDocument2.links                            'get links collection
 
               For i = 0 To Elems.Length - 1   'zero based element count
                  V = i
                  pIWebBrowser2 = Elems.item(ByVal V, ByVal V)
                  E = pIWebBrowser2
                  tmp$$ = E.toString
                  temp$ = temp$ + $CrLf + tmp$$
               Next i
               ? "Links: " + Str$(Elems.Length) + $CrLf + temp$
               
            Case %IDC_FindByCOM
               hBrowser = GetDlgItem(Cb.Hndl,%IDC_WebBrowser)
               pIWebBrowser2 = OC_GetDispatch(hBrowser) 'reference to webbrowser control default interface
               pIHTMLDocument2 = pIWebBrowser2.Document
               Elems = pIHTMLDocument2.links                            'get links collection
               oEnum = Elems.newEnum
               Do
                  oEnum.Next 1, V, iCount
                  If iCount = 0 Then Exit Do
                  E = V
                  tmp$$ = E.toString
                  temp$ = temp$ + $CrLf + tmp$$
               Loop
               ? "Links: " + Str$(Elems.Length) + $CrLf + temp$
 
            Case %IDC_FindByTag
               hBrowser = GetDlgItem(Cb.Hndl,%IDC_WebBrowser)
               pIWebBrowser2 = OC_GetDispatch(hBrowser) 'reference to webbrowser control default interface
               pIHTMLDocument2 = pIWebBrowser2.Document
               Control Get Text Cb.Hndl, %IDC_Tag To tmp$$  'tag to search for
               pIHTMLDocument3 = pIHTMLDocument2
               Elems = pIHTMLDocument3.GetElementsByTagName(tmp$$)
 
               For i = 0 To Elems.Length - 1   'zero based element count
                  V = i
                  pIWebBrowser2 = Elems.item(ByVal V, ByVal V)
                  E = pIWebBrowser2
                  tmp$$ = E.toString
                  temp$ = temp$ + $CrLf + tmp$$
               Next i
               ? "Links: " + Str$(Elems.Length) + $CrLf + temp$
 
         End Select
      Case %WM_Size
         If Cb.WParam <> %Size_Minimized Then
            Local w,h As Long
            Dialog Get Client Cb.Hndl To w,h
            Control Set Size Cb.Hndl, %IDC_WebBrowser, w, h-40
            Control Set Size Cb.Hndl, %IDC_Tag, w-320, 20
         End If
   End Select
End Function
 
'gbs_01318
'Date: 05-11-2013

created by gbSnippets
http://www.garybeene.com/sw/gbsnippets.htm