lav et link når man skriver webadresse

Du skal havde en function som kan lave links i tekst om til klikbare links:

Der har været en konkurrence på www.netkoders.dk og vinder script er her:
http://www.netcoders.dk/sources.asp?mode=view_source&cat_id=9&id=859&tech_id=1

Runner ups:
http://www.netcoders.dk/sources.asp?mode=view_source&cat_id=9&id=860&tech_id=1


Jeg har selv brugt denne som laver www adresser om til trykbare links.


Function LinkString2(strInput)
Set objRegExpHTTP1 = New RegExp
Set objRegExpHTTP2 = New RegExp

objRegExpHTTP1.Pattern = "(http|ftp)(:\/\/[\w\._-]+\.[\w\._-]+\S*)"
objRegExpHTTP2.Pattern = "(^|[^\/])(www[^\.\s]?\.[\w\._-]+\.[A-Za-z]{2,3}[\w\S]*)"

objRegExpHTTP1.Global = True
objRegExpHTTP2.Global = True

objRegExpHTTP1.IgnoreCase = True
objRegExpHTTP2.IgnoreCase = True

strOutput = objRegExpHTTP1.Replace(strInput, " <a href='$1$2' target='_blank'>$1$2</a> ")
strOutput = objRegExpHTTP2.Replace(strOutput, " $1<a href='http://$2' target='_blank'>$2</a> ")

objRegExpHTTP2.Pattern = "(<br>|[,.)\]\}])('>)"
strOutput = objRegExpHTTP2.Replace(strOutput, "$2")
objRegExpHTTP2.Pattern = "(<br>|[,.)\]\}])(' target=)"
strOutput = objRegExpHTTP2.Replace(strOutput, "$2")
objRegExpHTTP2.Pattern = "(<br>|[,.)\]\}])(</a>)"
strOutput = objRegExpHTTP2.Replace(strOutput, "$2$1")

Set objRegExpHTTP2 = Nothing
set objRegExpHTTP1 = Nothing

LinkString2 = strOutput
End Function


Og den kaldes sådan her:

str = "En steng som indeholder links (www.eksperten.dk) som skal laves om til klikbare links."
response.write linkString2 (str)

det var godt nok noget langhåret kode, synes bare ikke den ser spledes ud andre steder hvor det virker... :o)
Kigger på det sener

Fandt lige ud af at jeg havde en liggende i mit forum som laver det om som jeg kalder via include i toppen af side.

Denne i toppen

<!--#Include file="link.asp"-->

Link.asp ser således ud.

<%Function FixaLankar(s)
On error resume next
Set objRE = new RegExp
objRE.IgnoreCase = True : objRE.Global = True
objRE.Pattern = "(http:\/\/|www\.)(\w|\&|\:|\;|\.|\/|\?|\~|\=|-)+"
Set m = objRE.Execute(s)
For Each o In m
If Right(o.Value, 1)="." Or Right(o.Value, 1)="!" Or Right(o.Value, 1)="?" Or Right(o.Value, 1)="," Then
If Left(o.Value, 3) = "www" Then s = Replace(s, o.Value, "<A HREF=""http://" & Left(o.Value, Len(o.Value)-1) & """ target=""_blank"">" & Left(o.Value, Len(o.Value)-1) & "</A>" & Right(o.Value, 1)) Else s = Replace(s, o.Value, "<A HREF=""" & Left(o.Value, Len(o.Value)-1) & """>" & Left(o.Value, Len(o.Value)-1) & "</A>" & Right(o.Value, 1))
Else
If Left(o.Value, 3) = "www" Then s = Replace(s, o.Value, "<A HREF=""http://" & o.Value & """ target=""_blank"">" & o.Value & "</A>") Else s = Replace(s, o.Value, "<A HREF=""" & o.Value & """ target=""_blank"">" & o.Value & "</A>")
End If
Next
Set objRE = Nothing

    ' Gyldig HTML kode
s    = Replace(s,"[f]","<b>")
s    = Replace(s,"[/f]","</b>")
s    = Replace(s,"[k]","<i>")
s    = Replace(s,"[/k]","</i>")
s    = Replace(s,"[farg]","<font color=#800000>")
s    = Replace(s,"[/farg]","</font>")
s    = Replace(s, vbCrLf, "<br>")
s    = Replace(s,"","")

FixaLankar = s

End Function%>

Og kaldet ser således ud: <%=FixaLankar(Server.HTMLEncode(RecSet("inlagg")))%>

Ok, grunden til de sidset linjer med  .Pattern = "(<br>|[,.)\]\}])('>)" er fordi det pattern jeg har brugt, tager  ) ] } med som en del af linket når det står som (www.xx.dk)

Jeg har prøvet den funktion (FixaLankar) og den laver en fejl hvis man skriver samme web-adresse mere end 1 gang i strengen..

str = "Dette er en godt side www.eksperten.dk som skal ses. På www.eksperten.dk han man få hjælp til..."



Så jeg ledte lidt rundt omkring og kom til denne funktion:

Function LinkString2(strInput)
Set objRegExpHTTP1 = New RegExp
objRegExpHTTP1.Global = True
objRegExpHTTP1.IgnoreCase = True

objRegExpHTTP1.Pattern = "(http|ftp|https)(:\/\/[\w]+)(.[\w]+)([\w\-\.,@?^=%&:/~\+#]*[\w\-\@?^=%&/~\+#])?"
strOutput = objRegExpHTTP1.Replace(strInput, "<a href='$1$2$3$4' target='_blank'>$1$2$3$4</a>")

objRegExpHTTP1.Pattern = "(^|[^\/])(www)(.[\w]+)([\w\-\.,@?^=%&:/~\+#]*[\w\-\@?^=%&/~\+#])?"
strOutput = objRegExpHTTP1.Replace(strOutput, " $1<a href='http://$2$3$4' target='_blank'>$2$3$4</a>")

set objRegExpHTTP1 = Nothing

LinkString2 = strOutput
End Function