为字符串中的网址加上链接的程序例子

王朝asp·作者佚名 2006-01-08

Function ToLink(Str)

Dim RE '正则表达式对象

Dim strContent

If IsNull(Str) Then Str=""

Set RE = New RegExp '创建正则表达式对象

With RE

.Global = True '搜索应用于整个字符串

.IgnoreCase = True '搜索不区分大小写的

strContent=Str

'***************************************************************

'邮件地址链接自动设置

'***************************************************************

.Pattern="([\w]*)@([\w\.]*)"

strContent=.Replace(strContent,"<A Href='mailto:$1@$2'>$1@$2</A> ")

'***************************************************************

'链接自动设置

'***************************************************************

'======根据要求再添加协议名称=======

Dim D(3),I

D(0)="http"

D(1)="ftp"

D(2)="news"

D(3)="mms"

'===================================

For I=0 To UBound(D)

.Pattern=D(I) + ":\/\/([\w\.]*)"

strContent=.Replace(strContent,"<A Href='" + D(I) + "://$1' target=_blank>" + D(I) + "://$1</A> ")

'***************************************************************

End With

Set RE=Nothing

ToLink=strContent

End Function