%
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&" " & _
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&" " & _
vbcrlf&" " & _
vbcrlf&" "&Newasp.SiteUrl&"" & _
vbcrlf&" zh-cn" & _
vbcrlf&" "&m_ClassUrl&"" & _
vbcrlf&" " & _
vbcrlf&" " & _
vbcrlf&" " & _
vbcrlf&" " & _
vbcrlf&" " & _
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
%>