Hej!

Jag skulle vilja hämta ut alla länkar från en html sida och lägga de i en sträng ungefär så här:

sträng = "http://www.sida1.com/;http://www.sida2.com/;"

alla sidorna måste börja med http, men det får även ligga sidor med underkataloger i strängen:

sträng = "http://www.sida1.com/underkatalog1;http://www.sida2.com/underkatalog1/underkatalog2;"


nu är det ju så att olika html programmerare/designers/utvecklare (kalla det vad ni vill) gör länkar på olika sätt:

<a href=http://www.sidan.com>
<a href='http://www.sidan.com'>
<a href="http://www.sidan.com">
<a href =http://www.sidan.com>
<a href ='http://www.sidan.com'>
<a href ="http://www.sidan.com">
<a href =http://www.sidan.com>
<a href ='http://www.sidan.com'>
<a href ="http://www.sidan.com">
<a href = http://www.sidan.com>
<a href = 'http://www.sidan.com'>
<a href = "http://www.sidan.com">

sen kan man ju även hänvisa till en underkatalog på den egna servern:
<a href = "/hej.html">
och då ska det se ut så här i strängen (serveradressen har jag i en variabel från början men man måste ju veta när och om den ska infogas): http://www.egenserver.com/hej.html

ja det finns massor av varianter. Därför undrar jag om det finns något smidigt sätt att få ut alla länkar ur html dokumentet? Annars skulle det vara snällt om någon kunde berätta hur jag ska angripa problemet. Lite exempelkod skulle vara jättesnällt!

Jag började lite men min kod kan inte ta ut alla de här varianterna, se kod nedan. Fast den är kass så titta ändå inte på den =)

/Johan



Do Until InStr(1, tmpAktivSida, "href") = 0

tmpAktivSida = Mid(tmpAktivSida, InStr(1, tmpAktivSida, "href") + 4)
If InStr(1, tmpAktivSida, "http") < 15 Then
tmpAktivSida = Mid(tmpAktivSida, InStr(1, tmpAktivSida, "http://") + 7)
If (InStr(1, tmpAktivSida, Chr(34)) < InStr(1, tmpAktivSida, "'", vbBinaryCompare) And InStr(1, tmpAktivSida, Chr(34), vbBinaryCompare) <> 0) Or InStr(1, tmpAktivSida, "'", vbBinaryCompare) = 0 Then
If (InStr(1, tmpAktivSida, Chr(34)) < InStr(1, tmpAktivSida, ">", vbBinaryCompare) And InStr(1, tmpAktivSida, Chr(34), vbBinaryCompare) <> 0) Or InStr(1, tmpAktivSida, ">", vbBinaryCompare) = 0 Then
' avslutar med nöff nöff7
Länkar = Länkar & "http://" & Mid(tmpAktivSida, 1, InStr(1, tmpAktivSida, Chr(34)) - 1) & ";"
Else
' avslutar med >
Länkar = Länkar & "http://" & Mid(tmpAktivSida, 1, InStr(1, tmpAktivSida, ">") - 1) & ";"
End If
Else
If (InStr(1, tmpAktivSida, "'") < InStr(1, tmpAktivSida, ">", vbBinaryCompare) And InStr(1, tmpAktivSida, "'", vbBinaryCompare) <> 0) Or InStr(1, tmpAktivSida, ">", vbBinaryCompare) = 0 Then
' avslutar med '
Länkar = Länkar & "http://" & Mid(tmpAktivSida, 1, InStr(1, tmpAktivSida, "'") - 1) & ";"
Else
' avslutar med >
Länkar = Länkar & "http://" & Mid(tmpAktivSida, 1, InStr(1, tmpAktivSida, ">") - 1) & ";"
End If
End If
Else

End If

Knappade ihop följande lilla kod som fixar dina kombinationer plus om man inte har nån domän angiven (root).

Public Function GetUrl(ByVal vText As String, ByVal vRoot As String) As String

Dim varA As Variant
Dim strHref As String
Dim lngIterator As Long

' Se till att href= sitter ihop.
vText = Replace(vText, "href =", "href=")

' Splitta strängen ifall target osv. finns med i a-taggen.
varA = Split(vText, " ")

' Plocka ut href-attributet.
For lngIterator = 0 To UBound(varA)
If LCase(Left(varA(lngIterator), 4)) = "href" Then
strHref = varA(lngIterator)
Exit For
End If
Next lngIterator

' Plocka bort href=.
strHref = Mid(strHref, 6)

' Plocka bort ev >.
If Right(strHref, 1) = ">" Then strHref = Left(strHref, Len(strHref) - 1)

' Plocka bort " och '.
strHref = Replace(strHref, """", "")
strHref = Replace(strHref, "'", "")

' Lägg till root om den saknas.
If LCase(Left(strHref, 4)) <> "http" And LCase(Left(strHref, 3)) <> "ftp" Then
If Left(strHref, 1) = "/" Then
strHref = vRoot & strHref
Else
strHref = vRoot & "/" & strHref
End If
End If

GetUrl = strHref

End Function


Du anropar den med root attributet utan avslutande slash.

List1.AddItem GetUrl("<a href=""http://www.sidan.com"">", "http://wennerberg.nu")
List1.AddItem GetUrl("<a href =/blaha.asp>", "http://wennerberg.nu")
List1.AddItem GetUrl("<a href ='minsida.asp'>", "http://wennerberg.nu")


Mvh,
Håkan Wennerberg
http://wennerberg.nu/

Tackar så mycket!

Svar direkt, kl 3 på natten dessutom!

Nu fungerar mitt program ännu bättre, jag håller nämligen på att ladda ner hela internet... jag började på www.expressen.se och har fått hem några tusen sidor i min databas som bara växer!

Med Wennerbergs kod får jag med många fler länkar än med koden jag använde så jag ska nog rensa databasen och börja om från början!

Om någon vill ha programmet så är det bara att säga till, det är förhoppningsvis helt klart vid gryningen! Ska bara fixa så att den inte laddar hem alla bilder och musikfiler den kommer över, man ska inte behöva skippa dem manuellt...

/Johan

Ah! Fick just en strålande idé!

Jag ska sälja internet på CD-rom när jag har laddat hem det.

"Köp Internet på CD-rom och släng ditt gamla modem! Snabbare än fiber och inga månadsavgifter!"

Nä nu är det verkligen sent, gonatt!

/Johan

hmm, är inte Internet lite för stort för att sälja på CD-rommer? Jag skulle tipsa om DVD.... :-)

MvH Dan "DaPe" Persson