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

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> ") 
Next 
'***************************************************************

End With 
Set RE=Nothing 
ToLink=strContent 
End Function