深圳网站建设技术博客

<%
'********站内链接开始***********
Rem 站内链接
function SiteLink(content)
    Dim  rsKey, sqlKey, i, Keyrow, Keycol, LinkUrl,link_Url
 if isnull(content) then
  'StationLinks() = ""  
  exit function
 end if
    '从数据库中取词和连接地址
 dim words,SLrs
 set SLrs=conn.execute("select * from 站内链接表 order by wt_id desc")
 do while not SLrs.eof
 words= SLrs("链接文字字段")
 link_Url= SLrs("文字链接地址字段")
     '过滤<>里的文字和链接
  '  content=replace(content,"<A","<a")  '将<a 和<A都换成<a
    Keyrow=Keyrow&words&"|||"&link_Url&"@@@"
 SLrs.movenext
 loop
 SLrs.close
 set SLrs=nothing
 
  
    Keyrow = Split(Keyrow, "@@@")
 
    For i = 0 To UBound(Keyrow) - 1
 response.Write Keyrow(i)
        Keycol = Split(Keyrow(i), "|||")
            LinkUrl = "<a class=""linka"" href=""" & Keycol(1) & """ target=""_blank"">" & Keycol(0) & "</a>"
            content = PE_Replace_keylink(content, Keycol(0), LinkUrl, 0)
    Next 
    SiteLink = content 
     '输出结果
 'response.write content
end function
'********站内链接结束***********

'**************************************************
'函数名：PE_Replace_keylink
'作  用：使用正则替换将HTML代码中的非HTML标签内容进行替换
'参  数：expression ---- 主数据
'        find ---- 被替换的字符
'        replacewith ---- 替换后的字符
'        replacenum  ---- 替换次数
'返回值：容错后的替换字符串,如果 replacewith 空字符,被替换的字符 替换成空
'**************************************************
Function PE_Replace_keylink(ByVal expression, ByVal find, ByVal replacewith, ByVal replacenum)
    If IsNull(expression) Or IsNull(find) Or IsNull(replacewith) Then
        PE_Replace_keylink = ""
        Exit Function
    End If

    Dim newStr
    If PE_Clng(replacenum) > 0 Then
        PE_Replace_keylink = Replace(expression, find, replacewith, 1, replacenum)
    Else
        regEx.Pattern = "([][$( )*+.?\\^{|])"  '正则表达式中的特殊字符，要进行转义
        find = regEx.Replace(find, "\$1")
        replacewith = Replace(replacewith, "$", "&#36;") '对$进行处理，特殊情况 
        regEx.Pattern = "(>[^><]*)" & find & "([^><]*<)(?!/a)"
        newStr = regEx.Replace(">" & expression & "<", "$1" & replacewith & "$2")
        PE_Replace_keylink = Mid(newStr, 2, Len(newStr) - 2)
    End If
End Function

'**************************************************
'函数名：PE_CLng
'作  用：将字符转为整型数值
'参  数：str1 ---- 字符
'返回值：如果传入的参数不是数值，返回0，其他情况返回对应的数值
'**************************************************
Function PE_CLng(ByVal str1)
    If IsNumeric(str1) Then
        PE_CLng = Fix(CDbl(str1))
    Else
        PE_CLng = 0
    End If
End Function

%>