regular expression til at "fange" url´er samt email adresser

Jeg plejer at bruge den her:

' *************************************
' LAVER LINKS OM TIL KLIKBARE LINKS
' *************************************

function makeLink(str)
    '*** Make the reqular expr object
    Set objRegExp = New RegExp
    objRegExp.IgnoreCase = True
    objRegExp.Global = True

    '***Make html links
    objRegExp.Pattern = "(\bhttp\:\/\/)?(\bw{3}\.\S+\.[a-z][a-z]+\b)(\/\S+\b)?(\?\S+\b)?"
    str = objRegExp.Replace(str, "<a href="&chr(34)&"http://$2$3$4"&chr(34)&" target='_blank'>$1$2$3$4</a>")

    '***Make html mailto
    objRegExp.Pattern = "(\S+@{1}\S+\.[a-z][a-z]+\b)"
    str = objRegExp.Replace(str, "<a href="&chr(34)&"mailto:$1"&chr(34)&">$1</a>")
    Set objRegExp = Nothing
    makelink = str
end function

og så kalder jeg den f.eks. ved et udtræk fra databasen:

tekst = makelink(rs("tekst"))
response.write tekst

/Goose

Function FormatText(strHTML)

    Dim str
    str = Server.HTMLEncode(strHTML)

    'Make the regular expr. object
    Set objRegExp = New RegExp
    objRegExp.IgnoreCase = True
    objRegExp.Global = True
    'objRegExp.Multiline = True

    'Replace trailing spaces with "&nbsp;"
    objRegExp.Pattern = "(\s) "
    str = objRegExp.Replace(str,"$1&nbsp;")

    'Link automatic converter:
    objRegExp.Pattern = "(\bhttp\:\/\/)?(\bw{3}\.\S+\.[a-z][a-z]+\b)(\/\S+\b)?(\?\S+\b)?"
    str = objRegExp.Replace(str, "<a target='_blank' href='http://$2$3$4'>$1$2$3$4</a>")

    'Mail automatic converter:
    objRegExp.Pattern = "(\S+@{1}\S+\.[a-z][a-z]+\b)"
    str = objRegExp.Replace(str, "<a target='_blank' href='mailto:$1'>$1</a>")

    Set objRegExp = Nothing

    FormatText = Replace(str,vbNewLine,"<br>")

End Function

<%=FormatText(RS("text"))%>

Alle e-mails og URL's fra RS("text") bliver omdannet til sktive links og e-mails. Desuden er der også linieskift med :)

<%%> skal jo med :)

<%
Function FormatText(strHTML)

    Dim str
    str = Server.HTMLEncode(strHTML)

    'Make the regular expr. object
    Set objRegExp = New RegExp
    objRegExp.IgnoreCase = True
    objRegExp.Global = True
    'objRegExp.Multiline = True

    'Replace trailing spaces with "&nbsp;"
    objRegExp.Pattern = "(\s) "
    str = objRegExp.Replace(str,"$1&nbsp;")

    'Link automatic converter:
    objRegExp.Pattern = "(\bhttp\:\/\/)?(\bw{3}\.\S+\.[a-z][a-z]+\b)(\/\S+\b)?(\?\S+\b)?"
    str = objRegExp.Replace(str, "<a target='_blank' href='http://$2$3$4'>$1$2$3$4</a>")

    'Mail automatic converter:
    objRegExp.Pattern = "(\S+@{1}\S+\.[a-z][a-z]+\b)"
    str = objRegExp.Replace(str, "<a target='_blank' href='mailto:$1'>$1</a>")

    Set objRegExp = Nothing

    FormatText = Replace(str,vbNewLine,"<br>")

End Function
%>

<%=FormatText(RS("text"))%>

Jeg smider lige min også :o)

<%
Function LinkString(strInput)
dim arrPattern, arrReplaceString, Rx, intIndex
  arrPattern = Array("([\w\._-]+@[\w\._-]+\.[A-Za-z]{2,4}\S*)", _
  "(http|https|ftp)(:\/\/[\w\._-]+\.[\w\._-]+\S*)", _
  "(^|[^\/])(www[^\.\s]?\.[\w\._-]+\.[A-Za-z]{2,4}\S*)")

  arrReplaceString = Array(" <a href='mailto:$1'>$1</a> ", _
  " <a href='$1$2' target='_blank'>$1$2</a> ", _
  " <a href='http://$2' target='_blank'>$2</a> ")

  Set Rx = New RegExp
  Rx.Global = True
  Rx.IgnoreCase = True
  For intIndex = 0 To UBound(arrPattern)
    Rx.Pattern = arrPattern(intIndex)
    strInput = Rx.Replace(strInput, arrReplaceString(intIndex))
  Next
  Set Rx = Nothing
  LinkString = strInput
End Function

response.write LinkString("Her er en tekst med link www.test.dk http://www.test.dk og en email en@mail.dk")
%>

super lækkert - har ikke lige fået testet endnu....

Virker udtrykkene også hvis bruger undlader http://

altså på f.eks.

www.jubii.dk

Min gør i hvert fald. Den virker også ved https:// og ftp://

hej igen

Tak for jeres input - jeg valgte at benytte goose´s funktion.

Hilsen David