Long大哥省事了，我忙了，服务器抓狂了，连500的“未知错误”都出来了。改了一下午，总算完成了。方便一下大家，把这个东西帖出来
原有函数过程改为
'*********************************************************
' 目的：相关文章和增加评论连接的生成，用于优化Feed和增加评论连接
'*********************************************************
Function getRelateList(intID,strTag,strTitle,strURL)
If (intID=0) Then Exit Function
If strTag<>"" Then
Dim strCC_Count,strCC_ID,strCC_Name,strCC_Url,strCC_PostTime,strCC_Title
Dim strCC
Dim i
Dim j
Dim objRS
Dim strSQL
Dim strOutput
strOutput=""
Set objRS=Server.CreateObject("ADODB.Recordset")
strSQL="SELECT top 10 [log_ID],[log_Tag],[log_CateID],[log_Title],[log_Intro],[log_Level],[log_AuthorID],[log_PostTime],[log_Url] FROM [blog_Article] WHERE ([log_Level]>2) AND [log_ID]<>"& intID &" "
Dim aryTAGs
If InStr(strTag,"}{") > 0 Then
aryTAGs = Split(strTag,"}{")
Else
ReDim aryTAGs(0)
aryTAGs(0) = strTag
End If
strSQL = strSQL & " AND ("
For j = 0 To UBound(aryTAGs)
If Not (IsNull(aryTAGs(j)) Or IsEmpty(aryTAGs(j)) Or aryTAGs(j) = "" Or Len(aryTAGs(j)) < 1) Then
aryTAGs(j) = Replace(Replace(aryTAGs(j),"}",""),"{","")
If IsNumeric(aryTAGs(j)) Then
If j > 0 Then strSQL = strSQL & " OR "
strSQL = strSQL & "([log_Tag] Like '%{"&aryTAGs(j)&"}%')"
End If
End If
Next
strSQL = strSQL & ")"
strSQL = strSQL + " ORDER BY [log_PostTime] DESC "
Set objRS=Server.CreateObject("ADODB.Recordset")
objRS.CursorType = adOpenKeyset
objRS.LockType = adLockReadOnly
objRS.ActiveConnection=objConn
objRS.Source=strSQL
objRS.Open()
If (not objRS.bof) And (not objRS.eof) Then
For i=1 To 5 '相关文章数目，可自行设定
strCC_Count=strCC_Count+1
strCC_ID=objRS("log_ID")
strCC_Url=objRS("log_Url")
strCC_PostTime=objRS("log_PostTime")
strCC_Title=objRS("log_Title")
Application.Lock
strCC=Application(ZC_BLOG_CLSID & "TEMPLATE_ARTICLE_Mutuality")
Application.UnLock
If IsNull(strCC_Url) Or IsEmpty(strCC_Url) Or strCC_Url="" Then
strCC_Url=strCC_ID
end if
strCC=Replace(strCC,"<#article/mutuality/id#>",strCC_ID)
strCC=Replace(strCC,"<#article/mutuality/url#>",ZC_BLOG_HOST & ZC_STATIC_DIRECTORY & "/" & CStr(strCC_Url))
strCC=Replace(strCC,"<#article/mutuality/posttime#>",strCC_PostTime)
strCC=Replace(strCC,"<#article/mutuality/name#>",strCC_Title)
strOutput=strOutput & strCC
objRS.MoveNext
If objRS.eof Then Exit For
Next
End if
objRS.Close()
Set objRS=Nothing
End If
strOutput=Replace(strOutput,vbCrlf,"")
getRelateList= "<br/><a href="""+strURL+"#comment"" target=""_blank"">《"+strTitle+"》这篇文章挺有意思的，我也想来评论两句</a>"
IF strOutput<>"" then
getRelateList= getRelateList+"<br/>----<br/>相关文章：<ul>" + strOutput + "</ul> "
end if
End Function
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
打开c_system_event.asp文件
找到Function ExportRSS函数
把原有objArticle.HtmlIntro改为
objArticle.HtmlIntro+getRelateList(objArticle.ID,objArticle.Tag,objArticle.Title,objArticle.URL)
把原有objArticle.HtmlContent改为
objArticle.HtmlContent+getRelateList(objArticle.ID,objArticle.Tag,objArticle.Title,objArticle.URL)
当然了，主要是最后几行的改动，其实很简单的，只是我比较笨－_－ 预览效果和LONG大哥的一样。
UPDATA:1.7正式版后此方法已经不可用,1.7正式版改法请见
http://bbs.rainbowsoft.org/viewthread.php?tid=11793
[
本帖最后由 Zx.MYS 于 2007-2-7 16:12 编辑 ]
