<% Dim Rs,SQL,foundstr,ChildStr,channel,classid,img,base_dir Dim tmp_topic,tmp_url,tmp_sort,tmp_tim,tmp_des,tmp_cate Dim HtmlFileName,HtmlFileUrl,RssHomePageUrl,m_ClassUrl call data_load() call check_class() call data_end() sub data_load() channel = ChannelID classid = Newasp.CheckNumeric(Request("classid")) RssHomePageUrl = Newasp.SiteUrl & Newasp.InstallDir & Newasp.ChannelDir & "rssfeed.asp" base_dir=Newasp.SiteUrl end sub Sub check_class() If classid > 0 Then SQL = "SELECT ClassName,ChildStr,HtmlFileDir FROM [NC_Classify] WHERE ChannelID = " & ChannelID & " And ClassID=" & CLng(classid) Set Rs = Newasp.Execute(SQL) If Rs.BOF And Rs.EOF Then tmp_topic = "数据输入错误,请返回重试!" tmp_url = Newasp.SiteUrl tmp_sort = "" tmp_tim = Now() Call data_item(tmp_topic,tmp_url,tmp_sort,tmp_tim,tmp_des,tmp_cate) Rs.Close: Set Rs = Nothing call data_head() Exit Sub Else tmp_topic = Rs("ClassName") tmp_sort = Rs("ClassName") ChildStr = Rs("ChildStr") m_ClassUrl = Newasp.SiteUrl & Newasp.ReadDestination(Newasp.HtmlList, Newasp.ChannelDir, "",Rs("HtmlFileDir"),classid,0,1,"") End If Rs.Close:Set Rs = Nothing foundstr = "And A.ClassID in (" & ChildStr & ") ORDER BY A.WriteTime DESC ,A.ArticleID DESC" Else tmp_topic = "全部"&Newasp.ModuleName&"列表" foundstr = "ORDER BY A.WriteTime DESC ,A.ArticleID DESC" End If call data_head() call data_main() End sub sub data_main() SQL = " A.ArticleID,A.ClassID,A.title,A.WriteTime,A.HtmlFileDate,A.author,A.Content," SQL = "SELECT TOP 100 " & SQL & " C.ClassName,C.HtmlFileDir,C.UseHtml,B.ChannelDir,B.StopChannel,B.ModuleName,B.IsCreateHtml,B.HtmlExtName FROM ([NC_Article] A INNER JOIN [NC_Classify] C On A.ClassID=C.ClassID) INNER JOIN [NC_Channel] B On A.ChannelID=B.ChannelID WHERE A.isAccept>0 And A.ChannelID=" & CLng(ChannelID) & " " & foundstr & "" Set Rs = Newasp.Execute(SQL) If Rs.BOF And Rs.EOF Then tmp_topic = "没有找到你要查看的"&Newasp.ModuleName&"!" tmp_url = Newasp.SiteUrl tmp_sort = "没有分类" tmp_tim = Now() Call data_item(tmp_topic,tmp_url,tmp_sort,tmp_tim,tmp_des,tmp_cate) Rs.Close: Set Rs = Nothing Exit Sub Else Do While Not Rs.EOF If Rs("IsCreateHtml") <> 0 Then HtmlFileUrl = Newasp.ReadDestination(Newasp.HtmlInfo, Newasp.ChannelDir, Rs("HtmlFileDate"),Rs("HtmlFileDir"),Rs("ClassID"),Rs("ArticleID"),1,"") Else HtmlFileUrl = Newasp.GetChannelDir(ChannelID) & "show.asp?id=" & Rs("ArticleID") End If If LCase(Left(HtmlFileUrl,7)) <> "http://" Then HtmlFileUrl = Newasp.SiteUrl & HtmlFileUrl tmp_topic = Rs("title") tmp_sort = Rs("author") tmp_url = HtmlFileUrl tmp_tim = Rs("WriteTime") tmp_des = Newasp.CutString(Rs("Content"), 300) tmp_cate = Rs("ClassName") Call data_item(tmp_topic,tmp_url,tmp_sort,tmp_tim,tmp_des,tmp_cate) Rs.MoveNext Loop End If Rs.Close: Set Rs = Nothing end sub sub data_item(ByVal strtopic, ByVal strlinkurl, ByVal strusername, ByVal strtim, ByVal strdescription, ByVal strcategory) if instr(strlinkurl,":")=0 then if left(strlinkurl,1)="/" then strlinkurl=right(strlinkurl,len(strlinkurl)-1) strlinkurl=base_dir&strlinkurl end if response.write vbcrlf&vbcrlf&" " & _ vbcrlf&" <![CDATA["&strtopic&"]]>" & _ vbcrlf&" " & _ vbcrlf&" " & _ vbcrlf&" " & _ vbcrlf&" " & _ vbcrlf&" " & _ vbcrlf&" " & _ vbcrlf&" " end sub sub data_head() response.clear dim tmpurls tmpurls = RssHomePageUrl response.ContentType="text/xml" response.write "" & _ vbcrlf&"" & _ vbcrlf&"" & _ vbcrlf&"" & _ vbcrlf&" <![CDATA["&Newasp.SiteName&" -- "&tmp_topic&"]]>" & _ vbcrlf&" " & _ vbcrlf&" "&Newasp.SiteUrl&"" & _ vbcrlf&" zh-cn" & _ vbcrlf&" "&m_ClassUrl&"" & _ vbcrlf&" " & _ vbcrlf&" " & _ vbcrlf&" " & _ vbcrlf&" " & _ vbcrlf&" <![CDATA["&Newasp.SiteName&"]]>" & _ vbcrlf&" "&Newasp.SiteUrl&""&Newasp.InstallDir&""&Newasp.SkinPath&"toplogo.gif" & _ vbcrlf&" "&Newasp.SiteUrl&"" & _ vbcrlf&" " end sub sub data_end() response.write vbcrlf&vbcrlf&"" & _ vbcrlf&""&vbcrlf end sub %>