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

所属分类: 网络编程 / 编程10000问 阅读数: 1934
收藏 0 赞 0 分享

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

 

 

[1]

更多精彩内容其他人还在看

如何实现强制登录?

如何实现强制登录?
收藏 0 赞 0 分享

如何制作一个安全的页面?

如何制作一个安全的页面?
收藏 0 赞 0 分享

如何最大限度地实现安全登录功能?

如何最大限度地实现安全登录功能?
收藏 0 赞 0 分享

如何防止未经注册的用户绕过注册界面直接进入应用系统?

如何防止未经注册的用户绕过注册界面直接进入应用系统?
收藏 0 赞 0 分享

怎样避免直接在地址栏敲入URL即可绕过登录页的错误?

怎样避免直接在地址栏敲入URL即可绕过登录页的错误?
收藏 0 赞 0 分享

如何编制一个产生随机密码的函数?

如何编制一个产生随机密码的函数?
收藏 0 赞 0 分享

如何利用当前时间生成随机函数?

如何利用当前时间生成随机函数?
收藏 0 赞 0 分享

如何做一个密码“生成器”?

如何做一个密码“生成器”?
收藏 0 赞 0 分享

如何做一个随机密码产生器?

如何做一个随机密码产生器?
收藏 0 赞 0 分享

如何将产生的密码记录并发送给用户并通过点击链接激活?

如何将产生的密码记录并发送给用户并通过点击链接激活?
收藏 0 赞 0 分享
查看更多