如何把URL和邮件地址转换为超级链接?
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"
' 判断URLs和emails.
objRegExp.IgnoreCase = True
' 设置大小写不敏感..
objRegExp.Global = True
' 全局适用.
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=""URL:" & url & """超级链接:""" & _
Target & """>" & url & "</a>"
Else
strBuf = "<a href=""" & url & """超级链接:""" & _
Target & """>" & url & "</a>"
End If
ElseIf UCase(urlType) = "EMAIL" Then
strBuf = "<a href=""电子邮件地址:" & url & """链接目标:""" & _
Target & """>" & url & "</a>"
End If
GetHref = strBuf
End Function
您可能感兴趣的文章
- 08-02问题解析:为什么数组下标从0 开始而不是 1 ?
- 08-02如何编写高质量的前端代码(快手电商前端前端代码规范)
- 08-02如何显示最后十名来访者?
- 08-02如何显示数据库的结构?
- 08-02如何取得服务器上的用户组列表?
- 08-02如何判断URL格式是否符合规范?
- 08-02如何计算下载一个文件需要多长时间?
- 08-02如何计算ASP页面的载入时间?
- 08-02如何读取一个.ini文件?
- 08-02如何显示最后十名来访者?
阅读排行
推荐教程
- 08-02如何取得服务器上的用户组列表?
- 08-02如何显示最后十名来访者?
- 08-02如何把URL和邮件地址转换为超级链接?
- 08-02如何把一个Excel文件放到ASP页面中去?
- 08-02如何编写高质量的前端代码(快手电商前端前端代码规范)
- 08-02如何显示最后十名来访者?
- 08-02如何计算ASP页面的载入时间?
- 08-02如何显示数据库的结构?
- 08-02如何判断URL格式是否符合规范?
- 08-02如何计算下载一个文件需要多长时间?