📄 create_catalog全列显示.asp

📁 大型黄页系统,精美黄页flash演示,10m
💻 ASP
字号:
<!--#include file="setup.asp" -->
<%
Dim DownloadClass_Ads
Dim NowStats
Dim HtmlTitle
Dim Style_CSS
Dim HtmlTempStr


NC_Admin.AdminChk = "36"
NC_Admin.Check
DownsysClass.admin_header
If Not(DownsysClass.IsObjectFSO(DownsysClass.Script_FSO) And CInt(DownsysClass.Setting(5)) = 0 ) Then
	NC_Admin.Error_Msg ("<b><font color=red>你的服务器不支持 FSO(Scripting.FileSystemObject)或你后台没有选择为html方式</font></b>")
	DownsysClass.admin_footer
	Response.End
End If
Init_CreateCatalog
DownsysClass.admin_footer
NothingObject
CloseConn

Public Sub Init_CreateCatalog()
	Dim FSO,Fout,CreateHtml
	On Error Resume Next
	Server.ScriptTimeOut = 99999
	DownsysClass.LoadTemplates ("")
	Set DownloadClass_Ads = New Adcolumn_Cls
	NowStats = "信息分类"
	HtmlTitle = "信息分类"
	Style_CSS = Replace(Replace(DownsysClass.Style_CSS, "{$SetupDir}", DownsysClass.SetupDir), "{$PicUrl}", DownsysClass.TempDir)
	HtmlTempStr = DownsysClass.mainhtml(0) & DownsysClass.mainhtml(1) & DownsysClass.mainhtml(2) & DownsysClass.mainhtml(3) & DownsysClass.mainhtml(5) & DownsysClass.mainhtml(4)
	HtmlTempStr = Replace(HtmlTempStr, "{$NavMenu}", DownsysClass.SortingMenu)
	HtmlTempStr = Replace(HtmlTempStr, "{$Width}", DownsysClass.mainset(0))
	HtmlTempStr = Replace(HtmlTempStr, "{$Style_CSS}", Style_CSS)
	If CInt(DownsysClass.Setting(5)) = 0 Then
		HtmlTempStr = Replace(HtmlTempStr, "{$TopMeun}", DownsysClass.mainset(9))
	Else
		HtmlTempStr = Replace(HtmlTempStr, "{$TopMeun}", DownsysClass.mainset(10))
	End If
	If CInt(DownsysClass.Setting(5)) = 1 Then
	HtmlTempStr = Replace(HtmlTempStr, "{$FootMeun}", DownsysClass.mainset(11))
	Else 
	HtmlTempStr = Replace(HtmlTempStr, "{$FootMeun}", DownsysClass.mainset(44))
	End If
	HtmlTempStr = Replace(HtmlTempStr, "{$NowStats}", NowStats)
	HtmlTempStr = Replace(HtmlTempStr, "{$Title}", HtmlTitle)
	HtmlTempStr = Replace(HtmlTempStr, "{$Catalog}", CatalogInfo)
	HtmlTempStr = Replace(HtmlTempStr, "{$sousuo}", sousuo)
	HtmlTempStr = Replace(HtmlTempStr, "{$DayNewSoft}", DayNewSoft)
	HtmlTempStr = Replace(HtmlTempStr, "{$CommendSoft}", CommendSoft)
	HtmlTempStr = Replace(HtmlTempStr, "{$Message}", WebMessage(1))
	HtmlTempStr = Replace(HtmlTempStr, "{$Adcolumn(0)}", DownloadClass_Ads.RunScriptAds(7))
	HtmlTempStr = Replace(HtmlTempStr, "{$Adcolumn(1)}", DownloadClass_Ads.BannerAds(7))
	HtmlTempStr = Replace(HtmlTempStr, "{$Adcolumn(2)}", DownloadClass_Ads.AdsColumn(7, 2))
	HtmlTempStr = Replace(HtmlTempStr, "{$Adcolumn(3)}", DownloadClass_Ads.AdsColumn(7, 3))
	HtmlTempStr = Replace(HtmlTempStr, "{$Adcolumn(6)}", DownloadClass_Ads.AdsColumn(7, 7))
	HtmlTempStr = Replace(HtmlTempStr, "{$Adcolumn(4)}", DownloadClass_Ads.ScriptFloatAds(7))
	HtmlTempStr = Replace(HtmlTempStr, "{$Adcolumn(5)}", DownloadClass_Ads.ScriptFixedAds(7))
	Set FSO = Server.CreateObject("ADODB.STREAM")
	CreateHtml = Server.MapPath(DownsysClass.SetupDir & "Sorting0/Index.html")
	With FSO
		.Open
		.Charset = "GB2312"
		.WriteText HtmlTempStr
		.SaveToFile CreateHtml,2
		.Close
	End With
	Set FSO = Nothing
	NC_Admin.Succeed_Msg ("生成总分类的HTML页完成!")
End Sub
Private Function CatalogInfo()
	Dim Rs
	Dim Rs_c
	Dim HtmlString
	Dim TotalNumber
	Dim TotalNum
	Dim i,m
	Set Rs = CreateObject("adodb.recordset")
	Set Rs_c = CreateObject("adodb.recordset")
	HtmlString = HtmlString & "<TABLE width=""99%"" cellSpacing=1 cellPadding=5  border=0>" & vbCrLf

	Rs.Open "select * from NC_softSort Where depth = 0 order by sortid asc", conn, 1, 1
	If Not (Rs.bof And Rs.EOF) Then
		Do While Not Rs.EOF
		for m = 1 to 2
		if not Rs.eof then
			HtmlString = HtmlString & " <td><table><TR>" & vbCrLf
			HtmlString = HtmlString & "    <TD width=""15%""  class=Border1>"
			If CInt(DownsysClass.Setting(5)) = 0 Then
				HtmlString = HtmlString & "<a href='" & DownsysClass.SetupDir & "Sorting0/Catalog" & Rs("sortid") & "/Sorting_Indate_Desc_1.html' title='" & Rs("readme") & "<BR>共有信息：" & Rs("SoftNum") & " 个'><b>" & Rs("sortName") & "</b></a> "
			Else
				HtmlString = HtmlString & "<a href='" & DownsysClass.SetupDir & "Sorting.Asp?sortid=" & Rs("sortid") & "' title='" & Rs("readme") & "<BR>共有信息：" & Rs("SoftNum") & " 个'>" & Rs("sortName") & "</a> "
			End If
			HtmlString = HtmlString & "</TD></tr><tr><TD width=""400"" class=Border2>" & vbCrLf
			'二级目录循环开始
			Rs_c.Open "select  * from NC_softSort where depth = 1 and rootid=" & Rs("rootid") & " order by sortid asc", conn, 1, 1
			If Rs_c.bof And Rs_c.EOF Then
				HtmlString = HtmlString & "没有添加分类"
			Else
				TotalNumber = Rs_c.recordcount
				i = 1
				Do While Not Rs_c.EOF
					If CInt(DownsysClass.Setting(5)) = 0 Then
						HtmlString = HtmlString & "<a href='" & DownsysClass.SetupDir & "Sorting0/Catalog" & Rs_c("sortid") & "/Sorting_Indate_Desc_1.html' title='" & Rs_c("readme") & "<BR>共有信息：" & Rs_c("SoftNum") & " 个'>" & Rs_c("sortName") & "</a> &nbsp; " & vbCrLf
					Else
						HtmlString = HtmlString & "<a href='" & DownsysClass.SetupDir & "Sorting.Asp?sortid=" & Rs_c("sortid") & "' title='" & Rs_c("readme") & "<BR>共有信息：" & Rs_c("SoftNum") & " 个'>" & Rs_c("sortName") & "</a> &nbsp; " & vbCrLf
					End If
					If (i Mod CInt(DownsysClass.mainset(28))) = 0 And i <> TotalNumber Then
						HtmlString = HtmlString & " <br></tr>"
					End If
					i = i + 1
					Rs_c.movenext
				Loop
			End If
			Rs_c.Close
'二级目录循环结束
			
			HtmlString = HtmlString & " </TR></table>"
			Rs.movenext
'分列排序，开始
		else
				HtmlString = HtmlString & " </TR>" & vbCrLf
				HtmlString = HtmlString & "    <td></td>"
		end if
		next
				HtmlString = HtmlString & " </TR>" & vbCrLf
				HtmlString = HtmlString & " <tr><td height=1   ></td></tr><tr >"
		Loop
	End If
	Rs.Close
	Set Rs_c = Nothing
	Set Rs = Nothing
	CatalogInfo = 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 DayNewSoft()
		Dim Rs, SQL, HtmlString, SoftName, SortName, SoftTime, SoftDate
		Set Rs = Server.CreateObject("adodb.recordset")
		SQL = "select Top " & CInt(DownsysClass.mainset(22)) & " softid,sortid,SoftName, SoftVer,SortName,SoftTime,Hits from NC_SoftInfo where isLock = 0 order by SoftTime desc, softid desc"
		Rs.Open SQL, Conn, 1, 1
		If Rs.bof And Rs.EOF Then
			HtmlString = "还没有更新信息!"
		Else
			Do While Not Rs.EOF
				If Rs("SoftTime") >= Date Then
					SoftTime = "<FONT color=red>" & Month(Rs("SoftTime")) & "/" & Day(Rs("SoftTime")) & "</FONT >"
					SoftDate = "<FONT color=red>" & FormatDateTime(Rs("SoftTime"), 2) & "</FONT >"
				Else
					SoftTime = "<FONT color=#999999>" & Month(Rs("SoftTime")) & "/" & Day(Rs("SoftTime")) & "</FONT >"
					SoftDate = "<FONT color=red>" & FormatDateTime(Rs("SoftTime"), 2) & "</FONT >"
				End If
				If CInt(DownsysClass.Setting(5)) = 0 Then
					SoftName = "<A HREF='" & DownsysClass.SetupDir & "Software/Catalog" & Rs(1) & "/" & Rs(0) & ".html' title='" & Rs("SoftName") & Rs("SoftVer") & "' class='TableLink'>" & DownsysClass.gotTopic(Rs("SoftName") & " " & Rs("SoftVer"), CInt(DownsysClass.mainset(23))) & "</A>"
					SortName = "<A HREF='" & DownsysClass.SetupDir & "Sorting0/Catalog" & Rs(1) & "/Sorting_Indate_Desc_1.html' title='" & Rs("SortName") & "'>" & Rs("SortName") & "</A>"
				Else
					SoftName = "<A HREF='" & DownsysClass.SetupDir & "Software.asp?id=" & Rs(0) & "' title='" & Rs("SoftName") & " " & Rs("SoftVer") & "' class='TableLink'>" & DownsysClass.gotTopic(Rs("SoftName") & " " & Rs("SoftVer"), CInt(DownsysClass.mainset(23))) & "</A>"
					SortName = "<A HREF='" & DownsysClass.SetupDir & "Sorting.asp?sortid=" & Rs(1) & "' title='" & Rs("SoftName") & " " & Rs("SoftVer") & "'>" & Rs("SortName") & "</A>"
				End If
				HtmlString = HtmlString & DownsysClass.mainset(24)
				HtmlString = Replace(HtmlString, "{$SoftName}", SoftName)
				HtmlString = Replace(HtmlString, "{$SortName}", SortName)
				HtmlString = Replace(HtmlString, "{$SoftTime}", SoftTime)
				HtmlString = Replace(HtmlString, "{$SoftHits}", Rs("Hits"))
				HtmlString = Replace(HtmlString, "{$SoftDate}", SoftDate)
				Rs.movenext
			Loop
		End If
		Rs.Close
		Set Rs = Nothing
		DayNewSoft = HtmlString
	End Function
	'*************************************************************
	'函数作用：推荐信息
	'*************************************************************
	Private Function CommendSoft()
		Dim Rs, SQL, HtmlString, SoftName, SortName, SoftTime, SoftDate
		Set Rs = Server.CreateObject("adodb.recordset")
		SQL = "select Top " & CInt(DownsysClass.mainset(22)) & " softid,sortid,SoftName, SoftVer,SortName,SoftTime,Hits,isTop from NC_SoftInfo where isLock = 0 And isCommend = 1 order by SoftTime desc, softid desc"
		Rs.Open SQL, Conn, 1, 1
		If Rs.bof And Rs.EOF Then
			HtmlString = "还没有推荐信息!"
		Else
			Do While Not Rs.EOF
				If Rs("SoftTime") >= Date Then
					SoftTime = "<FONT color=red>" & Month(Rs("SoftTime")) & "/" & Day(Rs("SoftTime")) & "</FONT >"
					SoftDate = "<FONT color=red>" & FormatDateTime(Rs("SoftTime"), 2) & "</FONT >"
				Else
					SoftTime = "<FONT color=#999999>" & Month(Rs("SoftTime")) & "/" & Day(Rs("SoftTime")) & "</FONT >"
					SoftDate = "<FONT color=#999999>" & FormatDateTime(Rs("SoftTime"), 2) & "</FONT >"
				End If
				If CInt(DownsysClass.Setting(5)) = 0 Then
					SoftName = "<A HREF='" & DownsysClass.SetupDir & "Software/Catalog" & Rs(1) & "/" & Rs(0) & ".html' title='" & Rs("SoftName") & " " & Rs("SoftVer") & "' class='TableLink'>" & DownsysClass.gotTopic(Rs("SoftName") & " " & Rs("SoftVer"), CInt(DownsysClass.mainset(23))) & "</A>"
					SortName = "<A HREF='" & DownsysClass.SetupDir & "Sorting0/Catalog" & Rs(1) & "/Sorting_Indate_Desc_1.html' title='" & Rs("SortName") & "'>" & Rs("SortName") & "</A>"
				Else
					SoftName = "<A HREF='" & DownsysClass.SetupDir & "Software.asp?id=" & Rs(0) & "' title='" & Rs("SoftName") & " " & Rs("SoftVer") & "' class='TableLink'>" & DownsysClass.gotTopic(Rs("SoftName") & " " & Rs("SoftVer"), CInt(DownsysClass.mainset(23))) & "</A>"
					SortName = "<A HREF='" & DownsysClass.SetupDir & "Sorting.asp?sortid=" & Rs(1) & "' title='" & Rs("SoftName") & " " & Rs("SoftVer") & "'>" & Rs("SortName") & "</A>"
				End If
				If Rs("isTop") = 1 Then SoftName = "<FONT color=red>" & SoftName & "</Font>"
				HtmlString = HtmlString & DownsysClass.mainset(24)
				HtmlString = Replace(HtmlString, "{$SoftName}", SoftName)
				HtmlString = Replace(HtmlString, "{$SortName}", SortName)
				HtmlString = Replace(HtmlString, "{$SoftTime}", SoftTime)
				HtmlString = Replace(HtmlString, "{$SoftHits}", Rs("Hits"))
				HtmlString = Replace(HtmlString, "{$SoftDate}", SoftDate)
				Rs.movenext
			Loop
		End If
		Rs.Close
		Set Rs = Nothing
		CommendSoft = HtmlString
	End Function
	'*************************************************************
	'函数作用：站内公告
	'*************************************************************
	Private Function WebMessage(statid)
		Dim Rs, SQL, HtmlString, MsgTitle, PostTime
		Set Rs = Server.CreateObject("adodb.recordset")
		SQL = "select Top " & CInt(DownsysClass.mainset(25)) & " * from NC_Message where statid in (0, " & statid & ") order by isTop desc, Postime 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("Postime") >= Date Then
					PostTime = "<FONT color=red>" & FormatDateTime(Rs("Postime"), 2) & "</FONT ><br>"
				Else
					PostTime = "<FONT color=#999999>" & FormatDateTime(Rs("Postime"), 2) & "</FONT ><br>"
				End If
				MsgTitle = "<A HREF=""javascript:openScript('" & DownsysClass.SetupDir & "message.asp?id=" & Rs("id") & "',400,300)"" title='" & Rs("title") & "'>" & DownsysClass.gotTopic(Rs("title"), CInt(DownsysClass.mainset(26))) & "</A>"
				HtmlString = HtmlString & DownsysClass.mainset(27)
				HtmlString = Replace(HtmlString, "{$MsgTitle}", MsgTitle)
				HtmlString = Replace(HtmlString, "{$PostTime}", PostTime)
				Rs.movenext
			Loop
		End If
		Rs.Close
		Set Rs = Nothing
		WebMessage = HtmlString
	End Function

%>
⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -