Philip skrev:
> Er der nogle, der kan fortælle, hvordan man laver det sådan,
> at når en bruger i en formular skriver noget, der begynder med
> "
http://", bliver det i visningen på skærmen automatisk
> omdannet til et hyperlink?
Den funktion er lavet adskillige gange tidligere - så der er
ikke grund at bruge tid på det selv (med mindre man gerne vil
lære hvordan det gøres).
Herunder er den funktion jeg bruger (jeg har den liggende som
includefil, så den kan benyttes på mange forskellige sider):
<!-- InsertHyperlink-funktion -->
<%
'----------------------------------------------
' InsertHyperlinks(inText)
' Returns a inText with "<a href="URL" target="_BLANK">URL</a>"
' inserted where there is URL found.
'
' URL can start with "www" or "http"
' or
' URL can be a email address "*@*"
'----------------------------------------------
Function InsertHyperlinks(inText)
Dim objRegExp, strBuf
Dim objMatches, objMatch
Dim Value, ReplaceValue, iStart, iEnd
strBuf = ""
iStart = 1
iEnd = 1
Set objRegExp = New RegExp
objRegExp.Pattern = "\b(www|http|\S+@)\S+\b" ' Match URLs and emails
objRegExp.IgnoreCase = True ' Set case
insensitivity. objRegExp.Global = True ' Set
global applicability. Set objMatches = objRegExp.Execute(inText)
For Each objMatch in objMatches
iEnd = objMatch.FirstIndex
strBuf = strBuf & Mid(inText, iStart, iEnd-iStart+1)
If InStr(1, objMatch.Value, "@") Then
strBuf = strBuf & GetHref(objMatch.Value, "EMAIL", "_BLANK")
Else
strBuf = strBuf & GetHref(objMatch.Value, "WEB", "_BLANK")
End If
iStart = iEnd+objMatch.Length+1
Next
strBuf = strBuf & Mid(inText, iStart)
InsertHyperlinks = strBuf
End Function
Function GetHref(url, urlType, Target)
Dim strBuf
strBuf = "<a href="""
If UCase(urlType) = "WEB" Then
If LCase(Left(url, 3)) = "www" Then
strBuf = "<a href=""http://" & url & """ target=""" & _
Target & """>" & url & "</a>"
Else
strBuf = "<a href=""" & url & """ target=""" & _
Target & """>" & url & "</a>"
End If
ElseIf UCase(urlType) = "EMAIL" Then
strBuf = "<a href=""mailto:" & url & """>" & url & "</a>"
End If
GetHref = strBuf
End Function
%>
--
Jens Gyldenkærne Clausen
MF (medlem af FIDUSO -
www.fiduso.dk)
I ovenstående tekst benyttes nyt komma.