我要评论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]
发表评论