欢迎来到科站长!

编程10000问

当前位置: 主页 > 网络编程 > 编程10000问

如何把URL和邮件地址转换为超级链接?

时间:2018-08-02 19:35:38|栏目:编程10000问|点击:

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" 

判断URLsemails.
  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


上一篇:暂无

栏    目:编程10000问

下一篇:如何把一个Excel文件放到ASP页面中去?

本文标题:如何把URL和邮件地址转换为超级链接?

本文地址:https://fushidao.cc/wangluobiancheng/574.html

广告投放 | 联系我们 | 版权申明

申明:本站所有的文章、图片、评论等,均由网友发表或上传并维护或收集自网络,属个人行为,与本站立场无关。

如果侵犯了您的权利,请与我们联系,我们将在24小时内进行处理、任何非本站因素导致的法律后果,本站均不负任何责任。

联系QQ:1205677645 | 邮箱:1205677645@qq.com

Copyright © 2018-2024 科站长 版权所有冀ICP备14023439号