📄 create_listing.asp
字号:
InfoTime = "<FONT color=#999999>" & Month(Rs("InfoTime")) & "/" & Day(Rs("InfoTime")) & "</FONT >"
InfoDate = "<FONT color=#999999>" & FormatDateTime(Rs("InfoTime"), 2) & "</FONT >"
End If
If CInt(DownsysClass.Setting(5)) = 0 Then
ArticleTitle = "<A HREF='" & DownsysClass.SetupDir & "Article/Catalog" & Rs(1) & "/" & Rs(0) & ".html' title='文章标题：" & Rs(2) & "<BR>更新时间：" & Rs(4) & "<BR>浏览次数：" & Rs(5) & "' class='TableLink'>" & DownsysClass.gotTopic(Rs(2), CInt(DownsysClass.mainset(20))) & "</A>"
ClassName = "<A HREF='" & DownsysClass.SetupDir & "Listing/Catalog" & Rs(1) & "/Listing_Indate_Desc_1.html' title='" & Rs("ClassName") & "'>" & Rs("ClassName") & "</A>"
Else
ArticleTitle = "<A HREF='" & DownsysClass.SetupDir & "Article.asp?id=" & Rs(0) & "' title='文章标题：" & Rs(2) & "<BR>更新时间：" & Rs(4) & "<BR>浏览次数：" & Rs(5) & "' class='TableLink'>" & DownsysClass.gotTopic(Rs(2), CInt(DownsysClass.mainset(20))) & "</A>"
ClassName = "<A HREF='" & DownsysClass.SetupDir & "Listing.asp?classid=" & Rs(1) & "' title='" & Rs("ClassName") & "'>" & Rs("ClassName") & "</A>"
End If
HtmlString = HtmlString & DownsysClass.mainset(21)
HtmlString = Replace(HtmlString, "{$ArticleTitle}", ArticleTitle)
HtmlString = Replace(HtmlString, "{$ClassName}", ClassName)
HtmlString = Replace(HtmlString, "{$InfoTime}", InfoTime)
HtmlString = Replace(HtmlString, "{$ArticleHits}", Rs("Hits"))
HtmlString = Replace(HtmlString, "{$InfoDate}", InfoDate)
Rs.movenext
Loop
End If
Rs.Close
Set Rs = Nothing
NewArticle = HtmlString
End Function
'*************************************************************
'函数作用：推荐文章
'*************************************************************
Private Function BestArticle()
Dim Rs, SQL, HtmlString, ArticleTitle, ClassName, InfoTime, InfoDate
Set Rs = Server.CreateObject("adodb.recordset")
SQL = "select Top " & CInt(DownsysClass.TempSet(20)) & " id,classid,Title, ClassName,InfoTime,Hits,isTop from NC_Article where isLock = 0 And isCommend = 1 order by isTop desc, InfoTime desc, id desc"
Rs.Open SQL, Conn, 1, 1
If Rs.bof And Rs.EOF Then
HtmlString = "还没有推荐文章!"
Else
Do While Not Rs.EOF
If Rs("InfoTime") >= Date Then
InfoTime = "<FONT color=red>" & Month(Rs("InfoTime")) & "/" & Day(Rs("InfoTime")) & "</FONT >"
InfoDate = "<FONT color=red>" & FormatDateTime(Rs("InfoTime"), 2) & "</FONT >"
Else
InfoTime = "<FONT color=#999999>" & Month(Rs("InfoTime")) & "/" & Day(Rs("InfoTime")) & "</FONT >"
InfoDate = "<FONT color=#999999>" & FormatDateTime(Rs("InfoTime"), 2) & "</FONT >"
End If
If CInt(DownsysClass.Setting(5)) = 1 Then
ArticleTitle = "<A HREF='" & DownsysClass.SetupDir & "Article.asp?id=" & Rs(0) & "' title='文章标题：" & Rs(2) & "<BR>更新时间：" & Rs(4) & "<BR>浏览次数：" & Rs(5) & "' class='TableLink'>" & DownsysClass.gotTopic(Rs(2), CInt(DownsysClass.TempSet(21))) & "</A>"
ClassName = "<A HREF='" & DownsysClass.SetupDir & "Listing.asp?classid=" & Rs(1) & "' title='" & Rs("ClassName") & "'>" & Rs("ClassName") & "</A>"
Else
ArticleTitle = "<A HREF='" & DownsysClass.SetupDir & "Article/Catalog" & Rs(1) & "/" & Rs(0) & ".html' title='文章标题：" & Rs(2) & "<BR>更新时间：" & Rs(4) & "<BR>浏览次数：" & Rs(5) & "' class='TableLink'>" & DownsysClass.gotTopic(Rs(2), CInt(DownsysClass.TempSet(21))) & "</A>"
ClassName = "<A HREF='" & DownsysClass.SetupDir & "Listing/Catalog" & Rs(1) & "/Listing_Indate_Desc_1.html' title='" & Rs("ClassName") & "'>" & Rs("ClassName") & "</A>"
End If
HtmlString = HtmlString & DownsysClass.TempSet(22)
HtmlString = Replace(HtmlString, "{$BestTopic}", ArticleTitle)
HtmlString = Replace(HtmlString, "{$ClassName}", ClassName)
HtmlString = Replace(HtmlString, "{$InfoTime}", InfoTime)
HtmlString = Replace(HtmlString, "{$ArticleHits}", Rs("Hits"))
HtmlString = Replace(HtmlString, "{$InfoDate}", InfoDate)
Rs.movenext
Loop
End If
Rs.Close
Set Rs = Nothing
BestArticle = HtmlString
End Function
'*************************************************************
'函数作用：图文
'*************************************************************
Private Function PictureNews()
Dim Rs, SQL, HtmlString, ArticleTitle, ClassName, InfoTime, InfoDate
Set Rs = Server.CreateObject("adodb.recordset")
SQL = "select Top " & CInt(DownsysClass.TempSet(7)) & " id,classid,Title, ClassName,InfoTime,Hits from NC_Article where isLock = 0 And isImg = 1 order by InfoTime desc, id desc"
Rs.Open SQL, Conn, 1, 1
If Rs.bof And Rs.EOF Then
HtmlString = "还没有图文信息!"
Else
Do While Not Rs.EOF
If Rs("InfoTime") >= Date Then
InfoTime = "<FONT color=red>" & Month(Rs("InfoTime")) & "/" & Day(Rs("InfoTime")) & "</FONT >"
InfoDate = "<FONT color=red>" & FormatDateTime(Rs("InfoTime"), 2) & "</FONT >"
Else
InfoTime = "<FONT color=#999999>" & Month(Rs("InfoTime")) & "/" & Day(Rs("InfoTime")) & "</FONT >"
InfoDate = "<FONT color=#999999>" & FormatDateTime(Rs("InfoTime"), 2) & "</FONT >"
End If
ArticleTitle = "<A HREF='" & DownsysClass.SetupDir & "Article/Catalog" & Rs("classid") & "/" & Rs("ID") & ".html' title='文章标题：" & Rs(2) & "<BR>更新时间：" & Rs(4) & "<BR>浏览次数：" & Rs(5) & "' class='TableLink'>" & DownsysClass.gotTopic(Rs(2), CInt(DownsysClass.TempSet(8))) & "</A>"
ClassName = "<A HREF='" & DownsysClass.SetupDir & "Listing/Catalog" & Rs(1) & "/Listing_indate_Desc_1.html' title='" & Rs("ClassName") & "'>" & Rs("ClassName") & "</A>"
HtmlString = HtmlString & DownsysClass.TempSet(9)
HtmlString = Replace(HtmlString, "{$Topic}", ArticleTitle)
HtmlString = Replace(HtmlString, "{$ClassName}", ClassName)
HtmlString = Replace(HtmlString, "{$InfoTime}", InfoTime)
HtmlString = Replace(HtmlString, "{$ArticleHits}", Rs("Hits"))
HtmlString = Replace(HtmlString, "{$InfoDate}", InfoDate)
Rs.movenext
Loop
End If
Rs.Close
Set Rs = Nothing
PictureNews = HtmlString
End Function
Private Function SingleImage(orders)
Dim Rs, SQL, HtmlString, Topic, OrderName
Set Rs = Server.CreateObject("adodb.recordset")
If orders = "Hits" Then
OrderName = "Hits"
Else
OrderName = "InfoTime"
End If
SQL = "select Top 1 id,classid,title,images from NC_Article where isLock = 0 And images <>'' order by " & OrderName & " desc, id desc"
Rs.Open SQL, Conn, 1, 1
If Rs.bof And Rs.EOF Then
HtmlString = "<img src=""" & DownsysClass.SetupDir & "images/NoPic.jpg"" width='" & DownsysClass.TempSet(18) & "' height='" & DownsysClass.TempSet(19) & "' border=0>"
Else
HtmlString = "<A HREF='" & DownsysClass.SetupDir & "Article/Catalog" & Rs("ClassID") &"/" & Rs("id") & ".html' title='" & Rs("title") & "'><img src='" & Rs("images") & "' width='" & DownsysClass.TempSet(18) & "' height='" & DownsysClass.TempSet(19) & "' border='0'></A>"
End If
Rs.Close
Set Rs = Nothing
SingleImage = HtmlString
End Function
'*************************************************************
'函数作用：当然位置
'*************************************************************
Private Function NowStation(classid, ClassName, ParentID, strParent)
Dim Rs, SQL, HtmlString
Set Rs = Server.CreateObject("adodb.recordset")
If ParentID <> 0 And Len(strParent) <> 0 Then
SQL = "select classid,ClassName from [NC_Class] where classid in(" & strParent & ")"
Rs.Open SQL, Conn, 1, 1
If Not (Rs.EOF And Rs.bof) Then
Do While Not Rs.EOF
HtmlString = HtmlString & "<a href='" & DownsysClass.SetupDir & "Listing/Catalog" & Rs(0) & "/Listing_indate_Desc_1.html'>" & Rs(1) & "</a>→"
Rs.movenext
Loop
End If
Rs.Close
Set Rs = Nothing
End If
HtmlString = HtmlString & "<a href='" & DownsysClass.SetupDir & "Listing/Catalog" & classid & "/Listing_indate_Desc_1.html'>" & ClassName & "</a>"
NowStation = HtmlString
End Function
'*************************************************************
'函数作用：文章分类
'*************************************************************
Private Function ArticleClass(classid, ParentID, Child)
Dim Rs, SQL, HtmlString, ClassName, ListingName
Set Rs = Server.CreateObject("adodb.recordset")
HtmlString = DownsysClass.TempSet(1)
If classid = "" Then
SQL = "SELECT classid,ClassName,rootid,Child,ArticleNum,Readme FROM NC_Class where depth=0 order by rootid"
Else
If Child = 0 Then
SQL = "SELECT classid,ClassName,rootid,Child,ArticleNum,Readme FROM NC_Class where Parentid=" & ParentID & " order by orders"
Else
SQL = "SELECT classid,ClassName,rootid,Child,ArticleNum,Readme FROM NC_Class where Parentid=" & classid & " order by orders"
End If
End If
Rs.Open SQL, Conn, 1, 1
If Rs.EOF And Rs.bof Then
HtmlString = HtmlString & "<p align=center>还没有任何分类！</p>"
Else
Do While Not Rs.EOF
HtmlString = HtmlString & DownsysClass.TempSet(2)
If CStr(Rs("classid")) = CStr(classid) Then
ListingName = "<A href='" & DownsysClass.SetupDir & "Listing/Catalog" & Rs("classid") & "/Listing_indate_Desc_1.html' class=ShowLink><B><FONT color=red>" & Rs("ClassName") & "</font></B></a>"
ClassName = "<A href='?classid=" & Rs("classid") & "' class=ShowLink><B><FONT color=red>" & Rs("ClassName") & "</font></B></a>"
Else
ListingName = "<A href='" & DownsysClass.SetupDir & "Listing/Catalog" & Rs("classid") & "/Listing_indate_Desc_1.html' title='" & Rs("Readme") & "<BR>共有文章： " & Rs("ArticleNum") & " 篇'>" & Rs("ClassName") & "</a>"
ClassName = "<A href='?classid=" & Rs("classid") & "' title='" & Rs("Readme") & "<BR>共有文章： " & Rs("ArticleNum") & " 篇'>" & Rs("ClassName") & "</a>"
End If
If CInt(DownsysClass.Setting(5)) = 0 Then
HtmlString = Replace(HtmlString, "{$ClassName}", ListingName)
Else
HtmlString = Replace(HtmlString, "{$ClassName}", ClassName)
End If
HtmlString = Replace(HtmlString, "{$ArticleNum}", Rs("ArticleNum"))
Rs.movenext
Loop
End If
HtmlString = HtmlString & DownsysClass.TempSet(3)
Rs.Close
Set Rs = Nothing
ArticleClass = HtmlString
End Function
'*************************************************************
'搜索下拉框选择项目(整体分类部分：供应、求购)
'*************************************************************
Private Function sousuo()
Dim SoftType
Dim HtmlShowPage
Dim ii
HtmlShowPage = HtmlShowPage &" <select name=""action""> "
HtmlShowPage = HtmlShowPage &" <option value=""soft"" selected>全部信息</option>"
SoftType = Split(DownsysClass.Setting(35), ",")
For ii = 0 To UBound(SoftType)
HtmlShowPage = HtmlShowPage & "<option value=""soft"& ii &""">" & Trim(SoftType(ii)) & "</option>"
Next
HtmlShowPage = HtmlShowPage & "<option value=""info"">文章搜索</option></SELECT>"
sousuo = HtmlShowPage
End Function
'*************************************************************
'函数作用：分页
'*************************************************************
Private Function ShowPage(ClassName, maxperpage, CurrentPage, totalnumber)
Dim ii
Dim n
dim page
dim page1
Dim HtmlShowPage
If totalnumber Mod maxperpage = 0 Then
n = totalnumber \ maxperpage
Else
n = totalnumber \ maxperpage + 1
End If
HtmlShowPage = "<TABLE width='100%' border=0 align='center' cellPadding=2 cellSpacing=0><tr><td align=center> " & vbCrLf
If CurrentPage < 2 Then
HtmlShowPage = HtmlShowPage & " <img src=""" & DownsysClass.SetupDir & "Images/but_pre.gif"" width=14 height=12 border=0> <img src=""" & DownsysClass.SetupDir & "Images/but_ago.gif"" width=12 height=12 border=0> "
Else
HtmlShowPage = HtmlShowPage & "<a href=Listing_Indate_Desc_1.html><img src=""" & DownsysClass.SetupDir & "Images/but_pre.gif"" width=14 height=12 border=0></a> "
HtmlShowPage = HtmlShowPage & "<a href=Listing_Indate_Desc_" & CurrentPage - 1 & ".html><img src=""" & DownsysClass.SetupDir & "Images/but_ago.gif"" width=12 height=12 border=0></a> "
End If
if n>10 then
if CurrentPage>5 then
page=CurrentPage-5
else
page=1
end if
if CurrentPage<5 then
page1=10
else
if CurrentPage+5>n then
page1=n
else
page1=CurrentPage+5
end if
end if
else
page=1
page1=n
end if
For ii = page To page1
HtmlShowPage = HtmlShowPage & " <a href=Listing_Indate_Desc_" & ii & ".html>"
If CurrentPage = CInt(ii) Then
HtmlShowPage = HtmlShowPage & "<font color='#FF0000'><strong>"
End If
HtmlShowPage = HtmlShowPage & "" & ii & "</font></strong></a>"
Next
HtmlShowPage = HtmlShowPage & " ……"
If n - CurrentPage < 1 Then
HtmlShowPage = HtmlShowPage & " <img src=""" & DownsysClass.SetupDir & "Images/but_next.gif"" width=12 height=12 border=0> <img src=""" & DownsysClass.SetupDir & "Images/but_after.gif"" width=14 height=12 border=0> </td></FORM></tr>" & vbCrLf
Else
HtmlShowPage = HtmlShowPage & " <a href=Listing_Indate_Desc_" & (CurrentPage + 1) & ".html><img src=""" & DownsysClass.SetupDir & "Images/but_next.gif"" width=12 height=12 border=0></a>"
HtmlShowPage = HtmlShowPage & " <a href=Listing_Indate_Desc_" & n & ".html><img src=""" & DownsysClass.SetupDir & "Images/but_after.gif"" width=14 height=12 border=0></a></td></FORM>" & vbCrLf
End If
HtmlShowPage = HtmlShowPage & "<FORM name=beginPagefrm onsubmit='return onCheckPage()' action=''><td class=C align=center>" & vbCrLf
HtmlShowPage = HtmlShowPage & " 第 <INPUT size=5 name=beginPage> 页 <INPUT type=image src='" & DownsysClass.SetupDir & "images/button_small2_qw.gif' align=absMiddle value='确 定' name=submit2 >" & vbCrLf
HtmlShowPage = HtmlShowPage & "</FORM></tr></table>" & vbCrLf
HtmlShowPage = HtmlShowPage & "<SCRIPT language=javascript>" & vbCrLf
HtmlShowPage = HtmlShowPage & "<!--" & vbCrLf
HtmlShowPage = HtmlShowPage & "function onCheckPage(){" & vbCrLf
HtmlShowPage = HtmlShowPage & " var beginPage = parseInt(document.beginPagefrm.beginPage.value);" & vbCrLf
HtmlShowPage = HtmlShowPage & " if(isNaN(beginPage)){" & vbCrLf
HtmlShowPage = HtmlShowPage & " alert(""请输入数字！（0到" & n & "）"")" & vbCrLf
HtmlShowPage = HtmlShowPage & " return false;" & vbCrLf
HtmlShowPage = HtmlShowPage & " }" & vbCrLf
HtmlShowPage = HtmlShowPage & " if(beginPage < 0 ) {" & vbCrLf
HtmlShowPage = HtmlShowPage & " beginPage = 1;" & vbCrLf
HtmlShowPage = HtmlShowPage & " }" & vbCrLf
HtmlShowPage = HtmlShowPage & " if(beginPage > " & n & "){" & vbCrLf
HtmlShowPage = HtmlShowPage & " beginPage = " & n & ";" & vbCrLf
HtmlShowPage = HtmlShowPage & " }" & vbCrLf
HtmlShowPage = HtmlShowPage & " document.beginPagefrm.action = ""Listing_Indate_Desc_"" + beginPage + "".html"";" & vbCrLf
HtmlShowPage = HtmlShowPage & " return true;" & vbCrLf
HtmlShowPage = HtmlShowPage & "}" & vbCrLf
HtmlShowPage = HtmlShowPage & "-->" & vbCrLf
HtmlShowPage = HtmlShowPage & "</SCRIPT>" & vbCrLf
ShowPage = HtmlShowPage
End Function
End Class
%>
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -