הדוגמא הבאה יודעת לקחת טקסט מסויים ובעזרת פונקציה להפוך את כל כתובות האתרים והדואר אלקטרוני לקישורים. דוגמא זו שימושית כאשר אנו רוצים לעבור על טקסט שגולש מכניס וכמו כל תוכנות הדוא"ל להפוך את הכתובות לקישורים חיים. <%@ Language=VBScript %>
<%
' InsertHyperlinks(inText)
' Returns a inText with "URL"
' inserted where there is URL found.
'
' URL can start with "www" or "http"
' or
' URL can be a email address "*@*"
'----------------------------------------------
TEXT = Request.QueryString("text")
'The text that you wish to check for hyperlinks
if TEXT <> "" Then
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 = "" & url & ""
Else
strBuf = "" & url & ""
End If
ElseIf UCase(urlType) = "EMAIL" Then
strBuf = "" & url & ""
End If
GetHref = strBuf
End Function
Response.Write "After changin urls to hyperlinks: "
Response.Write InsertHyperlinks(TEXT) & ""
End if
%>
|