繁體中文当前位置: 首页 > 图文教程 > 网络编程 > 编程10000问 > 如何把URL和邮件地址转换为超级链接？
- 编程10000问
- 如何获知文件被改动的情况？
- 如何获知文件最后的修改日期和时间？
- 如何在线查询本地机的文件？
- 如何制作一个文本文件编辑器？
- 如何简单地上传文件？
- 如何上传一个单纯的HTML文件？
- 如何实现文件上传并自动归类功能？
- 如何实现无组件上传二进制文件？
- 在无组件的情况下，如何上传图片？
- 如何限制上传文件的大小？
- 如何用拦截表单的方法上传图片？
- 如何对用户进行授权？
- 如何更好地保护我的网页？
- 如何实现某些页面只让特定的用户浏览？
- 如何实现某一页面只让特定的用户浏览？
- 如何实现强制登录？
- 如何制作一个安全的页面？
- 如何最大限度地实现安全登录功能？
- 如何防止未经注册的用户绕过注册界面直接进入应用系统？
- 怎样避免直接在地址栏敲入URL即可绕过登录页的错误？
编程10000问 中的 如何把URL和邮件地址转换为超级链接？
出处:互联网 整理: 软晨网（RuanChen.com） 发布: 2010-01-10 浏览: 106 ::
收藏到网摘: n/a
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
[1]
评论 (0) All
