Plocka ut länk

Det blir rätt knivigt med tanke på att denna sida är fylld med länkar.

Men annars blir det ju att öppna sidan med filobjekt... låta den läsa rad för rad, leta efter en <a> tag och roffa åt sig den med nån inbyggd strängfunktion.
Och sen stänga filen och spara strängen nånstans.

"Does this sound perplex to you?" :)

------------------
//
SPike.CoM
Hemsida | E-mail

Det här scriptet använder jag.. det kan omkoda http mailto ftp m.m.

' Nedanstånde kod kommer från [url="http://www.ojmnet.com"]www.ojmnet.com[/url] 
'----------------------------------------------------
Function ConvertLinks(svalue)

svalue = ConvertLinksHREF(svalue, "http://")
svalue = ConvertLinksHREF(svalue, "ftp://")
svalue = ConvertLinksHREF(svalue, "news://")
svalue = ConvertLinksHREF(svalue, "mailto:")

ConvertLinks = svalue
End Function

Function ConvertLinksHREF(svalue, sHREF)

Dim iPos1, iPos2, sTemp, sTemp1, sTemp2

iPos2 = 1
iPos1 = InStr(1, svalue, sHREF, 1)
Do While iPos1 > 0
iPos2 = FindLinkEnd(svalue, iPos1 + Len(sHREF))
If iPos2 > 0 Then
sTemp1 = Mid(svalue, iPos1, iPos2 - iPos1)
sTemp2 = "<A target=_blank HREF=" & sTemp1 & ">" & sTemp1 & "</A>"
svalue = Left(svalue, iPos1 - 1) & sTemp2 & Mid(svalue, iPos2)
iPos2 = iPos1 & Len(sTemp2) + 1
Else
iPos2 = iPos1 + Len(sHREF)
End If
iPos1 = InStr(iPos2, svalue, sHREF, 1)
Loop

ConvertLinksHREF = svalue
End Function
Function FindLinkEnd(svalue, iPos1)
Dim iPos2, i, iLen, iTempPos
Dim sValidChars

sValidChars = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz1234567890-.@/"
iLen = iPos1 + Len(Mid(svalue, iPos1)) - 1
iPos2 = -1
For i = iPos1 To iLen
iTempPos = InStr(1, sValidChars, Mid(svalue, i, 1), 1)
If iTempPos = 0 Then
If i < iPos1 + 4 Then
iPos2 = -1
Else
iPos2 = i
End If
Exit For
End If
Next
If iPos2 = 0 Then
iPos2 = Len(svalue) + 1
End If

FindLinkEnd = iPos2

End Function

//M@rtin

Har testat det där scriptet. Men för att det ska fungera så får inte länken stå bredvid ett annat tecken.

Ex:

1http://
1 http://

------------------
Hälsningar Ricki
www.ricki.nu