shopchannel.asp

来自「小游戏网站演示www.4399.io 拥有4万条游戏数据」· ASP 代码 · 共 1,632 行 · 第 1/5 页

ASP
1,632
字号
				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
			classid = Newasp.ChkNumeric(Request("classid"))
			Response.Write LoadShopList(ClassID, 1)
		End If
	End Sub
	'=================================================
	'过程名:LoadShopList
	'作  用:载入商城列表
	'=================================================
	Public Function LoadShopList(clsid, n)
		Dim rsClass
		Dim HtmlFileName,maxparent,strMaxParent
		Dim AdsCode,stopad,m_strFilePath
		
		PageType = 1
		
		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 = Newasp.ChkNumeric(Newasp.ChannelSkin)
			End If
			AdsCode = rsClass("AdsCode")
			stopad = rsClass("stopad")
		End If
		rsClass.Close: Set rsClass = Nothing

		Newasp.LoadTemplates ChannelID, 2, skinid
		m_strFilePath = Newasp.ReadDestination(Newasp.SortDestination, Newasp.ChannelDir, "",strFileDir,ClassID,0,1,"")
		HtmlFilePath = Newasp.HtmlFilesPath
		m_strFileDir = strFileDir
		
		HtmlContent = Replace(Newasp.HtmlContent, "|||@@@|||", "")
		'-- 新增分类广告代码
		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}", strClassName)
		HtmlContent = Replace(HtmlContent, "{$ShopIndex}", strIndexName)
		HtmlContent = Replace(HtmlContent, "{$IndexTitle}", strIndexName)
		
		ReplaceContent
		maxparent = Newasp.ChkNumeric(Newasp.HtmlSetting(5))
		maxperpage = CInt(Newasp.HtmlSetting(1))
		
		If CLng(CurrentPage) = 0 Then CurrentPage = 1
		TotalNumber = Newasp.Execute("SELECT COUNT(shopid) FROM NC_ShopList WHERE ChannelID = " & ChannelID & " And isAccept > 0 And ClassID in (" & ChildStr & ")")(0)
		If maxparent > 0 And Child > 0 And TotalNumber > maxparent Then
			strMaxParent = " TOP " & maxparent
			TotalNumber = maxparent
		Else
			strMaxParent = ""
		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" & strMaxParent & " A.ShopID,A.ClassID,A.TradeName,A.Explain,A.PastPrice,A.NowPrice,A.star,A.ProductImage,A.addTime,A.AllHits,A.HtmlFileDate,A.isBest,A.IsTop,C.ClassName,C.ParentID,C.ParentStr,C.skinid,C.HtmlFileDir,C.ChildStr,C.UseHtml FROM [NC_ShopList] A INNER JOIN [NC_Classify] C On A.ClassID=C.ClassID where A.ChannelID=" & ChannelID & " And A.isAccept > 0 And A.ClassID in (" & ChildStr & ") ORDER BY A.isTop DESC, A.addTime DESC ,A.shopid DESC"
		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 (strBasicPath & HtmlFilePath)
				HtmlFileName = m_strFilePath
				Newasp.CreatedTextFile strBasicPath & 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
			End If
		Else
			TempListContent = Newasp.CutFixContent(HtmlContent, "[ShowRepetend]", "[/ShowRepetend]", 1)
			If CreateHtml <> 0 Then
				Call LoadShopHtmlList(n)
			Else
				Call LoadShopAspList
			End If
		End If
		Rs.Close: Set Rs = Nothing
		
		LoadShopList = 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.ReadNewsPicAndText(HtmlContent)
		HtmlContent = HTML.ReadPopularArticle(HtmlContent)
		HtmlContent = HTML.ReadShopList(HtmlContent)
		HtmlContent = HTML.ReadShopPic(HtmlContent)
		HtmlContent = HTML.ReadStatistic(HtmlContent)
		HtmlContent = HTML.ReadArticlePic(HtmlContent)
		HtmlContent = HTML.ReadSoftPic(HtmlContent)
		HtmlContent = HTML.ReadArticleList(HtmlContent)
		HtmlContent = HTML.ReadSoftList(HtmlContent)
		HtmlContent = Replace(HtmlContent, "{$SkinPath}", Newasp.SkinPath)
		HtmlContent = Replace(HtmlContent, "{$InstallDir}", strInstallDir)
		HtmlContent = Replace(HtmlContent, "{$ChannelID}", ChannelID)
	End Sub
	'================================================
	'过程名:LoadShopHtmlList
	'作  用:装载商城列表HTML
	'================================================
	Private Sub LoadShopHtmlList(n)
		Dim HtmlFileName
		Dim Perownum,ii,w
		
		Perownum = Newasp.ChkNumeric(Newasp.HtmlSetting(4))
		
		If IsNull(TempListContent) Then Exit Sub
		
		Newasp.CreatPathEx (strBasicPath & 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(6)
				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
			
			HtmlFileName = Newasp.ReadDestination(Newasp.SortDestination, Newasp.ChannelDir, "",m_strFileDir,ClassID,0,CurrentPage,"page")
			strHtmlPage = showhtmlpage(CurrentPage, TotalPageNum, TotalNumber, maxperpage, Newasp.HtmlFilesName, strClassName)
			HtmlTemplate = HtmlContent
			HtmlTemplate = Replace(HtmlTemplate, TempListContent, ListContent)
			HtmlTemplate = Replace(HtmlTemplate, "{$ReadListPage}", strHtmlPage)
			HtmlTemplate = Replace(HtmlTemplate, "[ShowRepetend]", "")
			HtmlTemplate = Replace(HtmlTemplate, "[/ShowRepetend]", "")
			'开始生成子分类的HTML页
			Newasp.CreatedTextFile strBasicPath & 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
			End If
		Next
		
	End Sub
	'================================================
	'过程名:LoadShopAspList
	'作  用:装载商城列表ASP
	'================================================
	Private Sub LoadShopAspList()
		Dim Perownum,ii,w
		
		If IsNull(TempListContent) Then Exit Sub
		
		Perownum = Newasp.ChkNumeric(Newasp.HtmlSetting(4))
		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(6)
			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
		If Perownum > 1 Then ListContent = ListContent & "</table>" & vbCrLf
		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, TradeName, ListStyle
		Dim ShopUrl, ShopTime, sClassName,strProductImage
		Dim ProductImageUrl, ProductImage,ProductIntro
		Dim strlen
		strlen = Newasp.ChkNumeric(Newasp.HtmlSetting(9))
		ListContent = ListContent & TempListContent
		If (i Mod 2) = 0 Then
			ListStyle = 1
		Else
			ListStyle = 2
		End If
		If strlen > 0 Then
			sTitle = Newasp.GotTopic(Rs("TradeName"),strlen)
		Else
			sTitle = Rs("TradeName")
		End If
		
		If CInt(CreateHtml) <> 0 Then
			ShopUrl = Newasp.ReadDestination(Newasp.InfoDestination, Newasp.ChannelDir, Rs("HtmlFileDate"),Rs("HtmlFileDir"),Rs("ClassID"),Rs("shopid"),1,"")
			sClassName = Newasp.ReadDestination(Newasp.SortDestination, Newasp.ChannelDir, Rs("HtmlFileDate"),Rs("HtmlFileDir"),Rs("ClassID"),Rs("shopid"),1,"")
		Else
			If IsURLRewrite Then
				ShopUrl = ChannelRootDir & Rs("shopid") & Newasp.HtmlExtName
				sClassName = ChannelRootDir & "list_1_" & Rs("ClassID") & Newasp.HtmlExtName
			Else
				ShopUrl = ChannelRootDir & "show.asp?id=" & Rs("shopid")
				sClassName = ChannelRootDir & "list.asp?classid=" & Rs("ClassID")
			End If
		End If
		If Not IsNull(Rs("ProductImage")) Then
			strProductImage = Rs("ProductImage")
		End If
		ProductImageUrl = Newasp.GetImageUrl(strProductImage, Newasp.ChannelDir)
		ProductImage = Newasp.GetFlashAndPic(ProductImageUrl, CInt(Newasp.HtmlSetting(7)), CInt(Newasp.HtmlSetting(8)))
		ProductImage = "<a href='" & ShopUrl & "' title='" & Rs("TradeName") & "'>" & ProductImage & "</a>"
		sClassName = "<a href='" & sClassName & "' title='" & Rs("ClassName") & "'>" & Rs("ClassName") & "</a>"
		TradeName = "<a href='" & ShopUrl & "' title='" & Rs("TradeName") & "' class=showtopic>" & sTitle & "</a>"

		ProductIntro = Newasp.CutString(Rs("Explain"), CInt(Newasp.HtmlSetting(3)))
		
		ShopTime = Newasp.ShowDateTime(Rs("addTime"), CInt(Newasp.HtmlSetting(2)))
		ListContent = Replace(ListContent, "{$ClassifyName}", sClassName)
		ListContent = Replace(ListContent, "{$TradeName}", TradeName)
		ListContent = Replace(ListContent, "{$ShopTopic}", sTitle)
		ListContent = Replace(ListContent, "{$ShopUrl}", ShopUrl)
		ListContent = Replace(ListContent, "{$ProductImage}", ProductImage)
		ListContent = Replace(ListContent, "{$ShopID}", Rs("shopid"))
		ListContent = Replace(ListContent, "{$ShopHits}", Rs("AllHits"))
		ListContent = Replace(ListContent, "{$Star}", Rs("star"))
		ListContent = Replace(ListContent, "{$ShopDateTime}", ShopTime)
		ListContent = Replace(ListContent, "{$ProductIntro}", ProductIntro)
		ListContent = Replace(ListContent, "{$ListStyle}", ListStyle)
		ListContent = Replace(ListContent, "{$PastPrice}", FormatNumber(Rs("PastPrice"),2,-1))
		ListContent = Replace(ListContent, "{$NowPrice}", FormatNumber(Rs("NowPrice"),2,-1))
		ListContent = Replace(ListContent, "{$IsTop}", Rs("IsTop"))
		ListContent = Replace(ListContent, "{$IsBest}", Rs("IsBest"))
		ListContent = Replace(ListContent, "{$Order}", j)
	End Sub
	'///---商城列表结束
	'///----------------------------------------------
	'///---购物车过程开始
	'=================================================
	'过程名:BuildShopping

⌨️ 快捷键说明

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