Hyperlinks

[Shark]

How do you get all the Hyperlinks in a web page and list it in a listbox?

[Edited by Shark on 09-22-2000 at 06:07 PM]

[Jop]

You could use this code from the book SAMS Teach Yourself Internet Programming with Visual Basic 6 in 21 days so all credits go to them, they rule I don't and I really recommend this book. (Ok enough commercial brabbling)

Option Explicit


Public Function GetLinks(s As String, baseUrl As String)
Dim pos As Long, pos1 As Long, pos2 As Long
Dim buf As String, temp As String
Dim sq As String, dq As String
Dim qc As String, Start As Long

buf = ""

'Make sure a nonempty string has been passed.
If s = Null Or Len(s) = 0 Then
    GetLinks = buf
    Exit Function
End If

'Make sure there is at least one link
Start = InStr(1, s, "<a href=", vbTextCompare)
If Start = 0 Then
    GetLinks = buf
    Exit Function
End If

'Define the single
dq = Chr$(34)
sq = Chr$(39)

Do
    'get the first Dq or Sq
    pos = InStr(Start, s, dq, vbTextCompare)
    pos2 = InStr(Start, s, sq, vbTextCompare)
    If pos = 0 And pos2 = 0 Then Exit Do 'Nothing found
    
    If pos > 0 And pos2 > 0 Then
        If pos < pos2 Then 'It's a Dq
            qc = dq
        Else
            qc = sq
            pos = pos2
        End If
    ElseIf pos = 0 Then 'Only Signle
        qc = sq
        pos = pos2
    ElseIf pos2 = 0 Then
        qc = dq
    End If
    
    pos1 = InStr(pos + 1, s, qc, vbTextCompare)
    If pos1 = 0 Then Exit Do
    temp = Mid$(s, pos + 1, pos1 - pos - 1)
    'Forget about FTP and Mailto links
    If LCase(Left(temp, 7)) = "mailto:" Or LCase(Left(temp, 3)) = "ftp" Then
        GoTo DoNotAdd
    End If
    'See if it's a full URL, if not add the base Url
    If LCase(Left(temp, 7)) <> "http://" Then
        temp = baseUrl & temp
    End If
    'Strip off anything following a # or ?
    pos = InStr(1, temp, "#")
    If pos > 0 Then
        temp = Left(temp, pos - 1)
    End If
    pos = InStr(1, temp, "?")
    If pos > 0 Then
        temp = Left(temp, pos - 1)
    End If
    buf = buf & temp & "|"
DoNotAdd:
    'Locate the next link
    pos = InStr(pos1, s, "<a href=", vbTextCompare)
    Start = pos
    'If there a no more links then quit
    If pos = 0 Then Exit Do
    DoEvents
Loop While True

'Strip off the trailing |
GetLinks = Left(buf, Len(buf) - 1)
'MsgBox buf
End Function

Again, all respect, flowers, presents, money, kisses, pies and ofcourse the new ferrari goes to the great Peter Aitken, the author of the book Sams Teach Yourself Internet Programming with VB6 in 21 days! BUY IT!!!

Hope it helped ya!

[Shark]

You help, you get the credit in my book.

Hmmm... I never tried it before, but try this:

'sPage contains the HTML of the page.
'You can use some kind of an internet control to get it. Eg: Winsock, Inet, MS Internet Controls...

Dim sPage As String
Dim sResult As String
Dim A As Integer
Dim I As Integer

For A = 1 To Len(sPage)
    If UCase(Mid(sPage, A, 9)) = "<A HREF=" & Chr(34) Then
        I = InStr(A + 10, sPage, Chr(34))
        sResult = sResult & "(*) " & Mid(sPage, A + 9, I - A - 9) & vbCrLf
    End If
Next A

MsgBox "Hyperlinks:" & vbCrLf & vbCrLf & sResult, vbInformation, "Hyperlinks"

I hope it works, let me know.

[Edited by Sc0rp on 09-22-2000 at 06:33 PM]

[Shark]

How do you use it Jop?

[Edited by Shark on 09-22-2000 at 06:21 PM]

[Jop]

you get the credit in my book.

Don't use this code in a book please, I got it from a book so it will be copyright infringment... please don't use it man!

But anyway, if you want to use Scorps code, be sure to add some stuff with Single and Double quotes, base urls, # and ? (for CGI scripts).

How do you use it?
ehrmm..

pass the HTML source to s, and the Base url (like http://www.vb-world.net).

'This will open the URL with The ITC control
mystr = Inet1.OpenUrl("http://www.vb-world.net/blabla")
'This will display all links delimited with |
Text1.Text = GetLinks(mystr,"http://www.vb-world.net")

'Also, I saw I made a mistake, the first line of the function should be
Public Function GetLinks(ByVal s As String, baseUrl As String)

Add me to ICQ for more help (18818940)

[Jop]

I'm going to sleep now, so speak to you tomorrow, hope you'll figure it out in the time...

Jop's code seems more detailed, but it's up to you.
Just notice I made some changes to my code, so if you want to use it, make sure you take the updated one.

[Shark]