En funktion:
'----------------------------------------------------
' * ConvertLinks *
' Fixa så att länkar blir länkade i HTML-koden.
' 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 HREF=" & Chr(34) & sTemp1 & Chr(34) & ">" & 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
End Function
------------------
Det prasslas i säven
www.webeye.nu
[Redigerat av Vide den 20 jul 2000]
