繁體中文当前位置: 首页 > 图文教程 > 网络编程 > 编程10000问 > 如何把URL和邮件地址转换为超级链接？
- 编程10000问
- 如何计算下载一个文件需要多长时间？
- 如何检测用户第一次访问我的网站并显示友好信息？
- 如何判断URL格式是否符合规范？
- 如何取得服务器上的用户组列表？
- 如何显示数据库的结构？
- 如何显示最后十名来访者？
- 如何显示随机信息？
- 如何向前端推送用户请求的信息？
- 如何修改被表单引用的ASP页面？
- 如何验证IP地址？
- 如何用ASP建立Index Server查询对象并为其参数赋值？
- 如何用ASP输出HTML文件？
- 如何用表单的方式推送请求的信息？
- 如何远程读取数据库页面？
- 如何在ASP里显示进度条？
- 如何自动更新导航栏？
- 如何阻止别人非法链接你网站的图片？
- 怎样获知数据库的连接属性？
- 如何按时间显示最新标志
- 禁止站外提交表单(author:killer)
编程10000问 中的 如何把URL和邮件地址转换为超级链接？
出处:互联网 整理: 软晨网（RuanChen.com） 发布: 2010-01-10 浏览: 105 ::
收藏到网摘: 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
