softchannel.asp

网络上经典的图片程序

				strContent = Replace(strContent, "{$SoftName}", softname)
				strContent = Replace(strContent, "{$AllHits}", rsHot("AllHits"))
				strContent = Replace(strContent, "{$WriteTime}", Newasp.ShowDateTime(rsHot("SoftTime"), CInt(Newasp.HtmlSetting(3))))
				ArrayTemp(i) = strContent
				rsHot.MoveNext
				i = i + 1
			Loop
		End If
		rsHot.Close
		Set rsHot = Nothing
		strRearrange = Join(ArrayTemp, vbCrLf)
		ShowHotSoft = strRearrange
	End Function
	'================================================
	'函数名：SoftComment
	'作  用：软件评论
	'参  数：SoftID ----软件ID
	'================================================
	Private Function SoftComment(softid)
		Dim rsComment, SQL, strContent, strComment
		Dim i, Resize, strRearrange
		Dim ArrayTemp()
		
		On Error Resume Next
		Set rsComment = Newasp.Execute("SELECT TOP " & CInt(Newasp.HtmlSetting(5)) & " content,Grade,username,postime,postip FROM NC_Comment WHERE ChannelID=" & ChannelID & " And postid = " & softid & " ORDER BY postime DESC,CommentID DESC")
		If Not (rsComment.EOF And rsComment.BOF) Then
			i = 0
			Resize = 0
			Do While Not rsComment.EOF
				ReDim Preserve ArrayTemp(i + Resize)
				strContent = ArrayTemp(i) & Newasp.HtmlSetting(7)
				strComment = Newasp.CutString(rsComment("content"), CInt(Newasp.HtmlSetting(6)))
				strContent = Replace(strContent, "{$Comment}", Newasp.HTMLEncode(strComment))
				strContent = Replace(strContent, "{$UserName}", Newasp.HTMLEncode(rsComment("username")))
				strContent = Replace(strContent, "{$UserGrade}", rsComment("Grade"))
				strContent = Replace(strContent, "{$postime}", rsComment("postime"))
				strContent = Replace(strContent, "{$postip}", rsComment("postip"))
				ArrayTemp(i) = strContent
				rsComment.MoveNext
				i = i + 1
			Loop
		End If
		rsComment.Close
		strRearrange = Join(ArrayTemp, vbCrLf)
		Set rsComment = Nothing
		SoftComment = strRearrange
	End Function
	'================================================
	'函数名：CurrentStation
	'作  用：当前位置
	'参  数：...
	'================================================
	Public Function CurrentStation(ChannelID, ClassID, ClassName, ParentID, strParent, HtmlFileDir, Compart)
		Dim rsCurrent, SQL, strContent, ChannelDir
		
		ChannelDir = ChannelRootDir
		On Error Resume Next
		If ParentID <> 0 And Len(strParent) <> 0 Then
			SQL = "SELECT ClassID,ClassName,HtmlFileDir,UseHtml FROM [NC_Classify] WHERE ChannelID = " & ChannelID & " And ClassID in(" & strParent & ")"
			Set rsCurrent = Newasp.Execute(SQL)
			If Not (rsCurrent.EOF And rsCurrent.BOF) Then
				Do While Not rsCurrent.EOF
					If CInt(Newasp.IsCreateHtml) <> 0 Then
						strContent = strContent & "<a href='" & ChannelDir & rsCurrent("HtmlFileDir") & "'>" & rsCurrent(1) & "</a>" & Compart & ""
					Else
						strContent = strContent & "<a href='" & ChannelDir & "list.asp?classid=" & rsCurrent("ClassID") & "'>" & rsCurrent("ClassName") & "</a>" & Compart & ""
					End If
					rsCurrent.MoveNext
				Loop
			End If
			rsCurrent.Close
			Set rsCurrent = Nothing
		End If
		If CInt(Newasp.IsCreateHtml) <> 0 Then
			strContent = strContent & "<a href='" & ChannelDir & HtmlFileDir & "'>" & ClassName & "</a>"
		Else
			strContent = strContent & "<a href='" & ChannelDir & "list.asp?classid=" & ClassID & "'>" & ClassName & "</a>"
		End If
		CurrentStation = strContent
	End Function
	'================================================
	'函数名：ReadCurrentStation
	'作  用：读取当前位置
	'参  数：str ----原字符串
	'================================================
	Public Function ReadCurrentStation(str, ChannelID, ClassID, ClassName, ParentID, strParent, HtmlFileDir)
		Dim strTemp, i, sTempContent, nTempContent
		Dim arrTempContent, arrTempContents
		
		strTemp = str
		sTempContent = Newasp.CutMatchContent(strTemp, "{#CurrentStation(", ")}", 1)
		nTempContent = Newasp.CutMatchContent(strTemp, "{#CurrentStation(", ")}", 0)
		arrTempContents = Split(sTempContent, "|||")
		arrTempContent = Split(nTempContent, "|||")
		For i = 0 To UBound(arrTempContents)
			strTemp = Replace(strTemp, arrTempContents(i), CurrentStation(ChannelID, ClassID, ClassName, ParentID, strParent, HtmlFileDir, arrTempContent(i)))
		Next
		ReadCurrentStation = strTemp
	End Function

	'#############################\\执行软件列表开始//#############################
	Public Sub ShowDownList()
		On Error Resume Next
		If CreateHtml <> 0 Then
			Response.Redirect (ChannelRootDir & "index" & Newasp.HtmlExtName)
			Exit Sub
		Else
			Newasp.PreventInfuse
			If Not IsNumeric(Request("page")) And Len(Request("page")) <> 0 Then
				Response.Write ("错误的系统参数!请输入整数")
				Response.End
			End If
			If Not IsEmpty(Request("page")) And Len(Request("page")) <> 0 Then
				CurrentPage = Newasp.ChkNumeric(Request("page"))
			Else
				CurrentPage = 1
			End If
			ClassID = Newasp.ChkNumeric(Request("ClassID"))
			Response.Write CreateSoftList(ClassID, 1)
		End If
		
	End Sub
	'================================================
	'函数名：ReadSoftList
	'作  用：读取软件列表
	'================================================
	Public Function CreateSoftList(clsid, n)
		On Error Resume Next
		Dim rsClass, TemplateContent, strTemplate, strOrder
		Dim ParentTemplate, ChildTemplate, HtmlFileName
		Dim MaxListnum, strMaxListop, showtree
		Dim AdsCode,stopad
		
		If Not IsNumeric(clsid) Then Exit Function
		Set rsClass = Newasp.Execute("SELECT ClassID,ClassName,ChildStr,ParentID,ParentStr,Child,skinid,HtmlFileDir,UseHtml,AdsCode,stopad FROM [NC_Classify] WHERE ChannelID = " & ChannelID & " And ClassID=" & clsid)
		If rsClass.BOF And rsClass.EOF Then
			If CreateHtml = 0 Then
				Response.Write "<meta http-equiv=""refresh"" content=""2;url='/"">" & vbNewLine
				Response.Write "<p align=""center"" style=""font-size: 12px;color: red;"">对不起，该页面发生了错误，无法访问! 系统两秒后自动转到网站首页......</p>" & vbNewLine
			End If
			Set rsClass = Nothing
			Exit Function
		Else
			strClassName = rsClass("ClassName")
			ClassID = rsClass("ClassID")
			ChildStr = rsClass("ChildStr")
			Child = rsClass("Child")
			strFileDir = rsClass("HtmlFileDir")
			ParentID = rsClass("ParentID")
			strParent = rsClass("ParentStr")
			If rsClass("skinid") <> 0 Then
				skinid = rsClass("skinid")
			Else
				skinid = CLng(Newasp.ChannelSkin)
			End If
			AdsCode = rsClass("AdsCode")
			stopad = rsClass("stopad")
		End If
		rsClass.Close: Set rsClass = Nothing
		
		PageType = 1
		
		Newasp.LoadTemplates ChannelID, 2, skinid
		HtmlFilePath = Newasp.InstallDir & Newasp.ChannelDir & strFileDir
		strTemplate = Split(Newasp.HtmlContent, "|||@@@|||")
		'-- 大类列表显示方式
		showtree = Newasp.ChkNumeric(Newasp.HtmlSetting(4))
		'-- 最多列表数
		MaxListnum = Newasp.ChkNumeric(Newasp.HtmlSetting(5))
		
		strlen = Newasp.ChkNumeric(Newasp.HtmlSetting(10))
		
		ParentTemplate = strTemplate(1)
		ChildTemplate = strTemplate(0)
		If Child <> 0 And showtree <> 9 Then
			TemplateContent = ParentTemplate
		Else
			TemplateContent = ChildTemplate
		End If
		
		HtmlContent = TemplateContent
		'-- 新增分类广告代码
		HtmlContent = AdsReplace(HtmlContent,AdsCode, stopad)
		HtmlContent = Replace(HtmlContent, "{$ChannelRootDir}", ChannelRootDir)
		HtmlContent = Replace(HtmlContent, "{$InstallDir}", strInstallDir)
		HtmlContent = Replace(HtmlContent, "{$ChannelID}", ChannelID)
		HtmlContent = Replace(HtmlContent, "{$ModuleName}", Newasp.ModuleName)
		HtmlContent = Replace(HtmlContent, "{$ClassID}", ClassID)
		'HtmlContent = Replace(HtmlContent, "{$PageTitle}", strPageTitle)
		HtmlContent = Replace(HtmlContent, "{$SoftIndex}", strIndexName)
		If Child <> 0 And showtree <> 9 Then
			Call LoadParentList
			Call ReplaceContent
			If CInt(CreateHtml) <> 0 Then
				'创建分类目录
				Newasp.CreatPathEx (HtmlFilePath)
				'开始生成父级分类的HTML页
				HtmlFileName = HtmlFilePath & ReadListPageName(ClassID, 0)
				Newasp.CreatedTextFile HtmlFileName, HtmlContent
				If IsShowFlush = 1 Then
					Response.Write "<li style=""font-size: 16px;"">生成" & Newasp.ModuleName & "列表HTML完成... <a href=" & HtmlFileName & " target=_blank>" & Server.MapPath(HtmlFileName) & "</a></li>" & vbNewLine
					Response.Flush
				End If
			End If
		Else
			Call ReplaceContent
			'每页显示软件数
			maxperpage = Newasp.ChkNumeric(Newasp.HtmlSetting(1))
			If CLng(CurrentPage) = 0 Then CurrentPage = 1
			If Newasp.CheckStr(LCase(Request("order"))) = "hits" Then
				strOrder = "ORDER BY A.isTop DESC, A.AllHits DESC ,A.SoftID DESC"
			ElseIf Newasp.CheckStr(LCase(Request("order"))) = "name" Then
				strOrder = "ORDER BY A.isTop DESC, A.SoftName DESC ,A.SoftID DESC"
			ElseIf Newasp.CheckStr(LCase(Request("order"))) = "size" Then
				strOrder = "ORDER BY A.isTop DESC, A.SoftSize DESC ,A.SoftID DESC"
			Else
				strOrder = "ORDER BY A.isTop DESC, A.SoftTime DESC ,A.SoftID DESC"
			End If
			
			TotalNumber = Newasp.Execute("SELECT COUNT(SoftID) FROM NC_SoftList WHERE ChannelID = " & ChannelID & " And isAccept > 0 And ClassID in (" & ChildStr & ")")(0)
			totalrec = TotalNumber
			'-- 如果开启了父分类显示功能,限制显示数
			If Child > 0 And TotalNumber > MaxListnum And MaxListnum <> 999 Then
				strMaxListop = " TOP " & MaxListnum
				TotalNumber = MaxListnum
			Else
				strMaxListop = vbNullString
			End If
			TotalPageNum = CLng(TotalNumber / maxperpage)  '得到总页数
			If TotalPageNum < TotalNumber / maxperpage Then TotalPageNum = TotalPageNum + 1
			If CurrentPage < 1 Then CurrentPage = 1
			If CurrentPage > TotalPageNum Then CurrentPage = TotalPageNum
			Set Rs = CreateObject("ADODB.Recordset")
			SQL = "SELECT " & strMaxListop & " A.SoftID,A.ClassID,A.ColorMode,A.FontMode,A.SoftName,A.SoftVer,A.content,A.Related,A.SoftType,A.RunSystem,A.impower,A.SoftSize,A.star,A.SoftTime,A.username,A.IsTop,A.IsBest,A.Allhits,A.SoftImage,A.HtmlFileDate,C.ClassName,C.ParentID,C.ParentStr,C.skinid,C.HtmlFileDir,C.ChildStr,C.UseHtml FROM [NC_SoftList] A INNER JOIN [NC_Classify] C On A.ClassID=C.ClassID where A.ChannelID=" & ChannelID & " And A.isAccept > 0 And A.ClassID in (" & ChildStr & ") " & strOrder & ""
			If isSqlDataBase = 1 Then
				Set Rs = Newasp.Execute(SQL)
			Else
				Rs.Open SQL, Conn, 1, 1
			End If
			'If Err.Number <> 0 Then Response.Write "SQL 查询错误"
			If Rs.BOF And Rs.EOF Then
				HtmlContent = Replace(HtmlContent, "{$ReadListPage}", "还没有找到任何" & Newasp.ModuleName & "")
				HtmlContent = Replace(HtmlContent, Newasp.CutFixContent(HtmlContent, "[ShowRepetend", "[/ShowRepetend]", 1), "")
				If CreateHtml <> 0 Then
					Newasp.CreatPathEx (HtmlFilePath)
					HtmlFileName = HtmlFilePath & ReadListPageName(ClassID, CurrentPage)
					Newasp.CreatedTextFile HtmlFileName, HtmlContent
					If IsShowFlush = 1 Then Response.Write "<li style=""font-size: 12px;"">生成" & Newasp.ModuleName & "列表HTML完成... <a href=" & HtmlFileName & " target=_blank>" & Server.MapPath(HtmlFileName) & "</a></li>" & vbNewLine
					Response.Flush
				End If
			Else
				TotalNumber = totalrec
				TempListContent = Newasp.CutFixContent(HtmlContent, "[ShowRepetend]", "[/ShowRepetend]", 1)
				If CreateHtml <> 0 Then
					Call LoadChildListHtml(n)
				Else
					Call LoadChildListAsp
				End If
			End If
			Rs.Close: Set Rs = Nothing
		End If
		If CreateHtml = 0 Then CreateSoftList = HtmlContent
	End Function
	'================================================
	'过程名：ReplaceContent
	'作  用：替换模板内容
	'================================================
	Private Sub ReplaceContent()
		HtmlContent = HTML.ReadCurrentStation(HtmlContent, ChannelID, ClassID, strClassName, ParentID, strParent, strFileDir)
		HtmlContent = HTML.ReadAnnounceContent(HtmlContent, ChannelID)
		HtmlContent = ReadClassMenubar(HtmlContent)
		HtmlContent = ReadClassMenu(HtmlContent)
		HtmlContent = HTML.ReadSoftPic(HtmlContent)
		HtmlContent = HTML.ReadSoftList(HtmlContent)
		HtmlContent = HTML.ReadNewsPicAndText(HtmlContent)
		HtmlContent = HTML.ReadSoftPicAndText(HtmlContent)
		HtmlContent = HTML.ReadPopularArticle(HtmlContent)
		HtmlContent = HTML.ReadPopularSoft(HtmlContent)
		HtmlContent = HTML.ReadStatistic(HtmlContent)
		Dim strPageTitle : strPageTitle = HTML.CurrentClass & Newasp.HtmlSetting(11)
		HtmlContent = Replace(HtmlContent, "{$PageTitle}", strPageTitle)
		HtmlContent = Replace(HtmlContent, "{$SkinPath}", Newasp.SkinPath)
		HtmlContent = Replace(HtmlContent, "{$InstallDir}", strInstallDir)
		HtmlContent = Replace(HtmlContent, "{$ChannelID}", ChannelID)
	End Sub