softchannel.asp

网络上经典的图片程序

	'================================================
	'过程名：LoadParentList
	'作  用：装载父级软件列表
	'================================================
	Private Sub LoadParentList()
		Dim rsClslist, strContent, i, showtree
		Dim ClassUrl, ClassNameStr
		
		showtree = Trim(Newasp.HtmlSetting(4))
		PageType = 1
		On Error Resume Next
		TempListContent = Newasp.CutFixContent(HtmlContent, "[ShowRepetend]", "[/ShowRepetend]", 1)
		If Not IsNull(TempListContent) Then
			SQL = "SELECT TOP " & CInt(Newasp.HtmlSetting(5)) & " ClassID,ClassName,HtmlFileDir,UseHtml FROM [NC_Classify] WHERE ChannelID = " & ChannelID & " And TurnLink = 0 And ParentID=" & ClassID & " ORDER BY rootid ASC, ClassID ASC"
			Set rsClslist = Newasp.Execute(SQL)
			If rsClslist.BOF And rsClslist.EOF Then
				Set rsClslist = Nothing
				Exit Sub
			Else
				If showtree <> "1" Then strContent = "<table width=""100%"" align=center border=0 cellpadding=0 cellspacing=0 class=tablist>" & vbCrLf
				Do While Not rsClslist.EOF
					If showtree <> "1" Then strContent = strContent & "<tr valign=""top"">" & vbCrLf
					For i = 1 To 2
						If showtree <> "1" Then strContent = strContent & "<td class=""tdlist"">"
						If Not (rsClslist.EOF) Then
							strContent = strContent & TempListContent
							If CInt(CreateHtml) <> 0 Then
								ClassUrl = ChannelRootDir & rsClslist("HtmlFileDir")
							Else
								ClassUrl = ChannelRootDir & "list.asp?classid=" & rsClslist("ClassID")
							End If
							ClassNameStr = "<a href=""" & ClassUrl & """ class=""showtitle"">" & rsClslist("ClassName") & "</a>"
							strContent = Replace(strContent, "{$ChannelID}", ChannelID)
							strContent = Replace(strContent, "{$ClassifyID}", rsClslist("ClassID"))
							strContent = Replace(strContent, "{$ClassName}", ClassNameStr)
							strContent = Replace(strContent, "{$ClassUrl}", ClassUrl)
							If showtree <> "1" Then strContent = strContent & "</td>" & vbCrLf
							rsClslist.MoveNext
						Else
							If showtree <> "1" Then strContent = strContent & "</td>" & vbCrLf
						End If
					Next
					If showtree <> "1" Then strContent = strContent & "</tr>" & vbCrLf
				Loop
				If showtree <> "1" Then strContent = strContent & "</table>" & vbCrLf
			End If
			HtmlContent = Replace(HtmlContent, TempListContent, strContent)
			HtmlContent = Replace(HtmlContent, "[ShowRepetend]", "")
			HtmlContent = Replace(HtmlContent, "[/ShowRepetend]", "")
			rsClslist.Close: Set rsClslist = Nothing
		End If
	End Sub
	'================================================
	'过程名：LoadChildListHtml
	'作  用：装载子级软件列表HTML
	'================================================
	Private Sub LoadChildListHtml(n)
		Dim HtmlFileName
		Dim Perownum,ii,w
		Perownum = Newasp.ChkNumeric(Newasp.HtmlSetting(8))
		
		If IsNull(TempListContent) Then Exit Sub
		'创建分类目录
		Newasp.CreatPathEx (HtmlFilePath)
		For CurrentPage = n To TotalPageNum
			Rs.MoveFirst
			i = 0
			If TotalPageNum > 1 Then Rs.Move (CurrentPage - 1) * maxperpage
			ListContent = ""
			j = (CurrentPage - 1) * maxperpage + 1
			
			If Perownum > 1 Then 
				ListContent = Newasp.HtmlSetting(9)
				w = FormatPercent(100 / Perownum / 100,0)
			End If
			
			Do While Not Rs.EOF And i < CInt(maxperpage)
				If Not Response.IsClientConnected Then Response.End
				If Perownum > 1 Then
					ListContent = ListContent & "<tr valign=""top"">" & vbCrLf
					For ii = 1 To Perownum
						ListContent = ListContent & "<td width=""" & w & """ class=""shoplistrow"">"
						If Not Rs.EOF Then
							Call LoadListDetail
							Rs.movenext
							i = i + 1
							j = j + 1
						End If
						ListContent = ListContent & "</td>" & vbCrLf
					Next
					ListContent = ListContent & "</tr>" & vbCrLf
				Else
					Call LoadListDetail
					Rs.MoveNext
					i = i + 1
					j = j + 1
				End If
				If i >= maxperpage Then Exit Do
			Loop
			Dim strHtmlFront, strHtmlPage
			strHtmlFront = Newasp.HtmlPrefix & Newasp.Supplemental(ClassID, 3) & "_"
			strHtmlPage = htmlshowpage(CurrentPage, TotalPageNum, TotalNumber, maxperpage, strHtmlFront, Newasp.HtmlExtName, strClassName)
			HtmlTemplate = HtmlContent
			HtmlTemplate = Replace(HtmlTemplate, TempListContent, ListContent)
			HtmlTemplate = Replace(HtmlTemplate, "{$ReadListPage}", strHtmlPage)
			HtmlTemplate = Replace(HtmlTemplate, "[ShowRepetend]", "")
			HtmlTemplate = Replace(HtmlTemplate, "[/ShowRepetend]", "")
			'开始生成子分类的HTML页
			HtmlFileName = HtmlFilePath & ReadListPageName(ClassID, CurrentPage)
			Newasp.CreatedTextFile HtmlFileName, HtmlTemplate
			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
		Next
		
	End Sub

	'================================================
	'过程名：LoadChildListAsp
	'作  用：装载子级软件列表ASP
	'================================================
	Private Sub LoadChildListAsp()
		If IsNull(TempListContent) Then Exit Sub
		
		Dim Perownum,ii,w
		Perownum = Newasp.ChkNumeric(Newasp.HtmlSetting(8))
		
		i = 0
		Rs.MoveFirst
		If TotalPageNum > 1 Then Rs.Move (CurrentPage - 1) * maxperpage
		ListContent = ""
		
		j = (CurrentPage - 1) * maxperpage + 1
		If Perownum > 1 Then 
			ListContent = Newasp.HtmlSetting(9)
			w = FormatPercent(100 / Perownum / 100,0)
		End If
		
		Do While Not Rs.EOF And i < CInt(maxperpage)
			If Not Response.IsClientConnected Then Response.End
			If Perownum > 1 Then
				ListContent = ListContent & "<tr valign=""top"">" & vbCrLf
				For ii = 1 To Perownum
					ListContent = ListContent & "<td width=""" & w & """ class=""shoplistrow"">"
					If Not Rs.EOF Then
						Call LoadListDetail
						Rs.movenext
						i = i + 1
						j = j + 1
					End If
					ListContent = ListContent & "</td>" & vbCrLf
				Next
				ListContent = ListContent & "</tr>" & vbCrLf
			Else
				Call LoadListDetail
				Rs.MoveNext
				i = i + 1
				j = j + 1
			End If
			If i >= maxperpage Then Exit Do
		Loop
		Dim strPagination
		strPagination = ShowListPage(CurrentPage, TotalPageNum, TotalNumber, maxperpage, ASPCurrentPage(PageType), strClassName)
		HtmlContent = Replace(HtmlContent, TempListContent, ListContent)
		HtmlContent = Replace(HtmlContent, "[ShowRepetend]", "")
		HtmlContent = Replace(HtmlContent, "[/ShowRepetend]", "")
		HtmlContent = Replace(HtmlContent, "{$ReadListPage}", strPagination)
	End Sub
	'================================================
	'过程名：LoadListDetail
	'作  用：装载子级软件列表细节
	'================================================
	Private Sub LoadListDetail()
		Dim sTitle, sTopic, softname, ListStyle
		Dim SoftUrl, SoftTime, sClassName, SoftImageUrl, SoftImage
		
		ListContent = ListContent & TempListContent
		If (i Mod 2) = 0 Then
			ListStyle = 1
		Else
			ListStyle = 2
		End If
		If strlen > 0 Then
			sTitle = Newasp.GotTopic(Rs("SoftName") & " " & Rs("SoftVer"),strlen)
		Else
			sTitle = Rs("SoftName") & " " & Rs("SoftVer")
		End If
		sTitle = Newasp.ReadFontMode(sTitle, Rs("ColorMode"), Rs("FontMode"))
		On Error Resume Next
		If CInt(CreateHtml) <> 0 Then
			SoftUrl = ShowChannelPath(Newasp.ChannelPath,Rs("HtmlFileDir")) & Newasp.ShowDatePath(Rs("HtmlFileDate"), Newasp.HtmlPath) & ReadPagination(0)
			sClassName = ChannelRootDir & Rs("HtmlFileDir")
		Else
			SoftUrl = ChannelRootDir & "show.asp?id=" & Rs("SoftID")
			sClassName = ChannelRootDir & "list.asp?classid=" & Rs("ClassID")
		End If
		SoftImageUrl = Newasp.GetImageUrl(Rs("SoftImage"), Newasp.ChannelDir)
		SoftImage = Newasp.GetFlashAndPic(SoftImageUrl, CInt(Newasp.HtmlSetting(6)), CInt(Newasp.HtmlSetting(7)))
		SoftImage = "<a href='" & SoftUrl & "' title='" & Rs("SoftName") & "'>" & SoftImage & "</a>"
		sClassName = "<a href='" & sClassName & "' title='" & Rs("ClassName") & "'>" & Rs("ClassName") & "</a>"
		softname = "<a href='" & SoftUrl & "' title='" & Rs("SoftName") & " " & Rs("SoftVer") & "' class=showtopic>" & sTitle & "</a>"
		
		SoftIntro = Newasp.CutString(Rs("Content"), CInt(Newasp.HtmlSetting(3)))
		
		SoftTime = Newasp.ShowDateTime(Rs("SoftTime"), CInt(Newasp.HtmlSetting(2)))
		ListContent = Replace(ListContent, "{$ClassifyName}", sClassName)
		ListContent = Replace(ListContent, "{$SoftName}", softname)
		ListContent = Replace(ListContent, "{$SoftTopic}", sTitle)
		ListContent = Replace(ListContent, "{$SoftUrl}", SoftUrl)
		ListContent = Replace(ListContent, "{$SoftImage}", SoftImage)
		ListContent = Replace(ListContent, "{$SoftID}", Rs("softid"))
		ListContent = Replace(ListContent, "{$SoftHits}", Rs("AllHits"))
		ListContent = Replace(ListContent, "{$UserName}", Rs("username"))
		ListContent = Replace(ListContent, "{$Star}", Rs("star"))
		ListContent = Replace(ListContent, "{$SoftDateTime}", SoftTime)
		ListContent = Replace(ListContent, "{$SoftContent}", SoftIntro)
		ListContent = Replace(ListContent, "{$ListStyle}", ListStyle)
		ListContent = Replace(ListContent, "{$SoftSize}", ReadSoftsize(Rs("SoftSize")))
		ListContent = Replace(ListContent, "{$RunSystem}", Rs("RunSystem"))
		ListContent = Replace(ListContent, "{$Impower}", Rs("impower"))
		ListContent = Replace(ListContent, "{$SoftType}", Rs("SoftType"))
		ListContent = Replace(ListContent, "{$IsTop}", Rs("IsTop"))
		ListContent = Replace(ListContent, "{$IsBest}", Rs("IsBest"))
		ListContent = Replace(ListContent, "{$Order}", j)
		ListContent = Replace(ListContent, "{$PageID}", CurrentPage)
	End Sub

	Public Function ASPCurrentPage(stype)
		Dim CurrentUrl
		Select Case stype
			Case "1"
				CurrentUrl = "&amp;classid=" & Trim(Request("classid")) & "&amp;order=" & Trim(Request("order"))
			Case "2"
				CurrentUrl = "&amp;sid=" & Trim(Request("sid"))
			Case "3"
				CurrentUrl = ""
			Case "4"
				CurrentUrl = ""
			Case "6"
				CurrentUrl = "&amp;type=" & Newasp.CheckStr(Request("type"))
			Case Else
				If Trim(Request("word")) <> "" Then
					CurrentUrl = "&amp;word=" & Trim(Request("word"))
				Else
					CurrentUrl = "&amp;act=" & Trim(Request("act")) & "&amp;classid=" & Trim(Request("classid")) & "&amp;keyword=" & Trim(Request("keyword"))
				End If
		End Select
		ASPCurrentPage = CurrentUrl
	End Function
	
	Private Function ReadListPageName(ClassID, CurrentPage)
		ReadListPageName = Newasp.ClassFileName(ClassID, Newasp.HtmlExtName, Newasp.HtmlPrefix, CurrentPage)
	End Function
	'#############################\\执行专题软件开始//#############################
	Public Sub ShowDownSpecial()
		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 = CLng(Request("page"))
			Else
				CurrentPage = 1
			End If
			SpecialID = Newasp.ChkNumeric(Request("sid"))
			Response.Write CreateSoftSpecial(SpecialID, 1)
		End If
	End Sub
	Public Function CreateSoftSpecial(sid, n)
		On Error Resume Next
		Dim rsPecial
		Dim HtmlFileName
		
		PageType = 2
		If Not IsNumeric(SpecialID) Then Exit Function
		Set rsPecial = Newasp.Execute("SELECT SpecialID,SpecialName,SpecialDir FROM [NC_Special] WHERE ChannelID = " & ChannelID & " And SpecialID=" & sid)
		If rsPecial.BOF And rsPecial.EOF Then
			Response.Write ("错误的系统参数!")
			Set rsPecial = Nothing
			Exit Function