Function InsertHyperlinks(inText)Dim objRegExp, strBufDim objMatches, objMatchDim 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 = strBufEnd FunctionFunction 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 = strBufEnd Function
[1]
您可能感兴趣的文章:
- 易语言将指定的主机名与IP地址转换功能
- PHP实现将优酷土豆腾讯视频html地址转换成flash swf地址的方法
- 将IP地址转换为整型数字的PHP方法、Asp方法和MsSQL方法、MySQL方法
- 两端口路由器地址转换的例子
- Cisco 路由器动态和静态地址转换
- FormatRemoteUrl函数之asp实现格式化成当前网站完整的URL-将相对地址转换为绝对地址的代码
- 使用网络地址转换实现多服务器负载均衡
- NAT网络地址转换详情
