shopchannel.asp

来自「小游戏网站演示www.4399.io 拥有4万条游戏数据」· ASP 代码 · 共 1,632 行 · 第 1/5 页
ASP
1,632 行
<!--#include file="ubbcode.asp"-->
<%
Dim NewCloud
Set NewCloud = New ShopChannel_Cls

Class ShopChannel_Cls

	Private ChannelID, CreateHtml, IsShowFlush
	Private Rs,SQL,ChannelRootDir,HtmlContent,strIndexName,HtmlFilePath
	private shopid,classid,skinid,TradeExplain,TradeName,strInstallDir
	Private strFileDir, ParentID, strParent, strClassName, ChildStr, Child
	Private maxperpage, TotalNumber, TotalPageNum, CurrentPage, i,j
	private ForbidEssay,ListContent,HtmlTemplate,TempListContent
	Private FoundErr,PageType,m_strFileDir,m_strCurrPageName
	Public strBasicPath

	Public Property Let Channel(ChanID)
		ChannelID = ChanID
	End Property
	Public Property Let ShowFlush(para)
		IsShowFlush = para
	End Property

	Private Sub Class_Initialize()
		On Error Resume Next
		ChannelID = 3
		PageType = 0
		FoundErr = False
	End Sub

	Private Sub Class_Terminate()
		Set HTML = Nothing
	End Sub

	Public Sub MainChannel()
		Newasp.ReadChannel(ChannelID)
		CreateHtml = CInt(Newasp.IsCreateHtml)
		If Newasp.BindDomain = "0" Then
			ChannelRootDir = Newasp.InstallDir & Newasp.ChannelDir
			strBasicPath = ""
			strInstallDir = Newasp.InstallDir
		Else
			ChannelRootDir = "/"
			strInstallDir = Newasp.SiteUrl & "/"
			If Len(Newasp.NamedPath) > 2 Then
				strBasicPath = Newasp.NamedPath
			Else
				strBasicPath = Server.MapPath(Newasp.InstallDir & Newasp.ChannelDir)
			End If
			
		End If
		strIndexName = "<a href=""" & ChannelRootDir & """>" & Newasp.ChannelName & "</a>"
		ubb.BasePath = ChannelRootDir
		ubb.setUbbcode = Join(Newasp.setUserEditor,"|")
		ubb.Keyword = Newasp.ContentKeyword
	End Sub
	'=================================================
	'过程名：BuildShopIndex
	'作  用：显示商城首页
	'=================================================
	Public Sub BuildShopIndex()
		LoadShopIndex
		If CreateHtml <> 0 Then
			Response.Write "<meta http-equiv=""refresh"" content=""0;url=index" & Newasp.HtmlExtName & """ />"
		Else
			Response.Write HtmlContent
		End If
	End Sub
	'=================================================
	'过程名：CreateShopIndex
	'作  用：生成商城首页的HTML
	'=================================================
	Public Sub CreateShopIndex()
		LoadShopIndex
		Dim FilePath
		If Newasp.BindDomain = "0" Then
			FilePath = ChannelRootDir & "index" & Newasp.HtmlExtName
		Else
			FilePath = "\index" & Newasp.HtmlExtName
		End If
		Newasp.CreatedTextFile strBasicPath & FilePath, HtmlContent
		If IsShowFlush = 1 Then Response.Write "<li style=""font-size: 12px;"">生成" & Newasp.ModuleName & "首页HTML完成... " & Server.MapPath(FilePath) & "</li>" & vbNewLine
		Response.Flush
	End Sub
	Private Sub LoadShopIndex()
		Newasp.LoadTemplates ChannelID, 1, Newasp.ChkNumeric(Newasp.ChannelSkin)
		HtmlContent = Newasp.HtmlContent
		HtmlContent = Replace(HtmlContent,"{$ChannelRootDir}", ChannelRootDir)
		HtmlContent = Replace(HtmlContent,"{$InstallDir}", strInstallDir)
		HtmlContent = Replace(HtmlContent,"{$ChannelID}", ChannelID)
		HtmlContent = Replace(HtmlContent,"{$PageTitle}", Newasp.ChannelName)
		HtmlContent = Replace(HtmlContent, "{$ChannelName}", Newasp.ChannelName)
		HtmlContent = Replace(HtmlContent,"{$ModuleName}", Newasp.ModuleName)
		HtmlContent = Replace(HtmlContent,"{$ShopIndex}", strIndexName)
		HtmlContent = Replace(HtmlContent, "{$IndexTitle}", strIndexName)
		HtmlContent = HTML.ReadAnnounceContent(HtmlContent,ChannelID)
		HtmlContent = ReadClassMenu(HtmlContent)
		HtmlContent = ReadClassMenubar(HtmlContent)
		HtmlContent = HTML.ReadArticlePic(HtmlContent)
		HtmlContent = HTML.ReadSoftPic(HtmlContent)
		HtmlContent = HTML.ReadSoftList(HtmlContent)
		HtmlContent = HTML.ReadArticleList(HtmlContent)
		HtmlContent = HTML.ReadShopList(HtmlContent)
		HtmlContent = HTML.ReadShopPic(HtmlContent)
		HtmlContent = HTML.ReadFlashList(HtmlContent)
		HtmlContent = HTML.ReadFlashPic(HtmlContent)
		HtmlContent = HTML.ReadFriendLink(HtmlContent)
		HtmlContent = HTML.ReadGuestList(HtmlContent)
		HtmlContent = HTML.ReadAnnounceList(HtmlContent)
		HtmlContent = HTML.ReadPopularArticle(HtmlContent)
		HtmlContent = HTML.ReadStatistic(HtmlContent)
		HtmlContent = HTML.ReadPopularFlash(HtmlContent)
		HtmlContent = HTML.ReadUserRank(HtmlContent)
		HtmlContent = Replace(HtmlContent, "{$SkinPath}", Newasp.SkinPath)
		HtmlContent = Replace(HtmlContent,"{$InstallDir}", Newasp.InstallDir)
		HtmlContent = HtmlContent
	End Sub

	'#############################\\执行商品信息开始//#############################
	'=================================================
	'过程名：BuildShopInfo
	'作  用：显示商城信息页面
	'=================================================
	Public Sub BuildShopInfo()
		If CreateHtml <> 0 Then
			Response.Redirect (ChannelRootDir & "index" & Newasp.HtmlExtName)
			Exit Sub
		Else
			Newasp.PreventInfuse
			shopid = Newasp.ChkNumeric(Request("id"))
			Response.Write LoadShopInfo(shopid)
		End If
	End Sub

	Public Function LoadShopInfo(shopid)
		Dim PastPrice,NowPrice,strLinkSite,ThisUrl
		Dim strProductImage,ProductImageUrl,arrImageSize
				
		SQL = "SELECT A.*,C.ClassName,C.ParentID,C.ParentStr,C.skinid,C.HtmlFileDir,C.ChildStr,C.UseHtml,C.AdsCode,C.stopad FROM [NC_ShopList] A INNER JOIN [NC_Classify] C On A.ClassID=C.ClassID WHERE A.ChannelID=" & ChannelID & " And A.isAccept > 0 And A.shopid=" & shopid
		Set Rs = Newasp.Execute(SQL)
		If Rs.BOF And Rs.EOF Then
			LoadShopInfo = ""
			If CreateHtml = 0 Then
				Response.Write "<meta http-equiv=""refresh"" content=""2;url=/"" />" & vbNewLine
				Response.Write "<p align=""center"" style=""font-size: 16px;color: red;"">对不起，该页面发生了错误，无法访问! 系统两秒后自动转到网站首页......</p>" & vbNewLine
			End If
			Set Rs = Nothing
			Exit Function
		End If

		If Rs("skinid") <> 0 Then
			skinid = Rs("skinid")
		Else
			skinid = Newasp.ChkNumeric(Newasp.ChannelSkin)
		End If
		'--当前页URL
		If CreateHtml <> 0 Then
			ThisUrl = Newasp.ReadDestination(Newasp.InfoDestination, Newasp.ChannelDir, Rs("HtmlFileDate"),Rs("HtmlFileDir"),Rs("ClassID"),Rs("shopid"),1,"")
		Else
			If IsURLRewrite Then
				ThisUrl = ChannelRootDir & Rs("shopid") & Newasp.HtmlExtName
			Else
				ThisUrl = ChannelRootDir & "show.asp?id=" & Rs("shopid")
			End If
		End If
		
		Newasp.LoadTemplates ChannelID, 3, skinid
		TradeExplain = Rs("Explain")
		TradeExplain = ubb.UbbCode(TradeExplain)
		
		arrImageSize = Split(Newasp.HtmlSetting(9), "|")
		If Newasp.CheckNull(Rs("ProductImage")) Then
			ProductImageUrl = Newasp.GetImageUrl(Rs("ProductImage"), Newasp.ChannelDir)
			strProductImage = Newasp.GetFlashAndPic(ProductImageUrl, CInt(arrImageSize(0)), CInt(arrImageSize(1)))
			strProductImage = "<a href=""" & ChannelRootDir & "Previewimg.asp?shopid=" & shopid & """ title='" & Rs("TradeName") & "' target=_blank>" & strProductImage & "</a>"
		Else
			strProductImage = Newasp.HtmlSetting(8)
		End If
		
		If Newasp.CheckNull(Rs("LinkSite")) Then
			strLinkSite = Replace(Newasp.HtmlSetting(11),"{$Linking}",Trim(Rs("LinkSite")))
		Else
			strLinkSite = Trim(Newasp.HtmlSetting(10))
		End If
		
		HtmlContent = Newasp.HtmlContent
		'-- 新增分类广告代码
		HtmlContent = AdsReplace(HtmlContent,Rs("AdsCode"),Rs("stopad"))
		HtmlContent = Replace(HtmlContent, "{$InstallDir}", strInstallDir)
		HtmlContent = Replace(HtmlContent, "{$ChannelID}", ChannelID)
		HtmlContent = Replace(HtmlContent,"{$ShopIndex}", strIndexName)
		HtmlContent = Replace(HtmlContent, "{$IndexTitle}", strIndexName)
		HtmlContent = Replace(HtmlContent, "{$Marque}", Newasp.ChkNull(Rs("Marque")))
		HtmlContent = Replace(HtmlContent, "{$Unit}", Newasp.ChkNull(Rs("Unit")))
		HtmlContent = Replace(HtmlContent, "{$Supply}", Newasp.ChkNull(Rs("Supply")))
		HtmlContent = Replace(HtmlContent, "{$Company}", Newasp.ChkNull(Rs("Company")))
		HtmlContent = Replace(HtmlContent, "{$Best}", Rs("isBest"))
		HtmlContent = Replace(HtmlContent, "{$Star}", Newasp.ChkNumeric(Rs("star")))
		HtmlContent = Replace(HtmlContent, "{$addTime}", Rs("addTime"))
		HtmlContent = Replace(HtmlContent, "{$Integral}", Rs("integral"))
		HtmlContent = Replace(HtmlContent, "{$ThisUrl}", ThisUrl)
		
		HtmlContent = Replace(HtmlContent, "{$LinkSite}", strLinkSite)
		HtmlContent = Replace(HtmlContent, "{$PastPrice}", FormatNumber(Rs("PastPrice"),2,-1))
		HtmlContent = Replace(HtmlContent, "{$NowPrice}", FormatNumber(Rs("NowPrice"),2,-1))
		HtmlContent = Replace(HtmlContent, "{$TradeExplain}", TradeExplain)
		HtmlContent = Replace(HtmlContent, "{$ProductImage}", strProductImage)
		
		If InStr(HtmlContent, "{$FrontProduct}") > 0 Then
			HtmlContent = Replace(HtmlContent, "{$FrontProduct}", FrontProduct(shopid))
		End If
		If InStr(HtmlContent, "{$NextProduct}") > 0 Then
			HtmlContent = Replace(HtmlContent, "{$NextProduct}", NextProduct(shopid))
		End If
		If InStr(HtmlContent, "{$ProductComment}") > 0 Then
			HtmlContent = Replace(HtmlContent, "{$ProductComment}", ProductComment(Rs("shopid")))
		End If
		
		HtmlContent = Replace(HtmlContent, "{$ModuleName}", Newasp.ModuleName)
		HtmlContent = Replace(HtmlContent, "{$PageTitle}", Rs("TradeName"))
		HtmlContent = Replace(HtmlContent, "{$classid}", Rs("ClassID"))
		HtmlContent = Replace(HtmlContent, "{$TradeName}", Rs("TradeName"))
		HtmlContent = Replace(HtmlContent, "{$ShopID}", Rs("shopid"))
		HtmlContent = HTML.ReadCurrentStation(HtmlContent, ChannelID, Rs("ClassID"), Rs("ClassName"), Rs("ParentID"), Rs("ParentStr"), Rs("HtmlFileDir"))
		HtmlContent = HTML.ReadAnnounceContent(HtmlContent, ChannelID)
		HtmlContent = ReadClassMenubar(HtmlContent)
		HtmlContent = ReadClassMenu(HtmlContent)
		HtmlContent = HTML.ReadShopPic(HtmlContent)
		HtmlContent = HTML.ReadShopList(HtmlContent)
		HtmlContent = HTML.ReadArticlePic(HtmlContent)
		HtmlContent = HTML.ReadSoftPic(HtmlContent)
		HtmlContent = HTML.ReadArticleList(HtmlContent)
		HtmlContent = HTML.ReadSoftList(HtmlContent)
		HtmlContent = HTML.LoadCommentGrade(HtmlContent, ChannelID, Rs("shopid"))
		HtmlContent = Replace(HtmlContent, "{$ChannelRootDir}", ChannelRootDir)
		HtmlContent = Replace(HtmlContent, "{$SkinPath}", Newasp.SkinPath)
		HtmlContent = Replace(HtmlContent, "{$InstallDir}", strInstallDir)
		HtmlContent = Replace(HtmlContent, "{$ChannelID}", ChannelID)
		If CreateHtml <> 0 Then
			Call CreateShopInfo
		Else
			LoadShopInfo = HtmlContent
		End If
		Rs.Close: Set Rs = Nothing
	End Function

	'=================================================
	'过程名：CreateShopInfo
	'作  用：生成商城信息HTML
	'=================================================
	Private Sub CreateShopInfo()
		Dim HtmlFileName
		HtmlFileName = Newasp.ReadDestination(Newasp.InfoDestination, Newasp.ChannelDir, Rs("HtmlFileDate"),Rs("HtmlFileDir"),Rs("ClassID"),Rs("shopid"),1,"")
		HtmlFilePath = Newasp.HtmlFilesPath
		Newasp.CreatPathEx (strBasicPath & HtmlFilePath)
		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 Sub
	'=================================================
	'函数名：FrontProduct
	'作  用：显示上一商品
	'=================================================
	Private Function FrontProduct(shopid)
		Dim rsContext, SQL, HtmlFileUrl, HtmlFileName
		SQL = "select Top 1 A.shopid,A.ClassID,A.TradeName,A.HtmlFileDate,C.HtmlFileDir from [NC_ShopList] A inner join [NC_Classify] C On A.ClassID=C.ClassID where A.ChannelID=" & ChannelID & " And A.isAccept > 0 And A.shopid < " & shopid & " order by A.shopid desc"
		Set rsContext = Newasp.Execute(SQL)
		If rsContext.EOF And rsContext.BOF Then
			HtmlContent = Replace(HtmlContent, "{$BackUrl}", "#")
			FrontProduct = "已经没有了"
		Else
			If CreateHtml <> 0 Then
				HtmlFileUrl = Newasp.ReadDestination(Newasp.InfoDestination, Newasp.ChannelDir, rsContext("HtmlFileDate"),rsContext("HtmlFileDir"),rsContext("ClassID"),rsContext("shopid"),1,"")
			Else
				If IsURLRewrite Then
					HtmlFileUrl = rsContext("shopid") & Newasp.HtmlExtName
				Else
					HtmlFileUrl = "?id=" & rsContext("shopid")
				End If
			End If
			HtmlContent = Replace(HtmlContent, "{$BackUrl}", HtmlFileUrl)
			FrontProduct = "<a href=""" & HtmlFileUrl & """>" & rsContext("TradeName") & "</a>"
		End If
		rsContext.Close
		Set rsContext = Nothing
	End Function
	'=================================================
	'函数名：NextProduct
	'作  用：显示下一商品
	'=================================================
	Private Function NextProduct(shopid)
		Dim rsContext, SQL, HtmlFileUrl, HtmlFileName
		SQL = "select Top 1 A.shopid,A.ClassID,A.TradeName,A.HtmlFileDate,C.HtmlFileDir from [NC_ShopList] A inner join [NC_Classify] C On A.ClassID=C.ClassID where A.ChannelID=" & ChannelID & " And A.isAccept > 0 And A.shopid > " & shopid & " order by A.shopid asc"
		Set rsContext = Newasp.Execute(SQL)
		If rsContext.EOF And rsContext.BOF Then
			HtmlContent = Replace(HtmlContent, "{$NextUrl}", "#")
			NextProduct = "已经没有了"
		Else
			If CreateHtml <> 0 Then
				HtmlFileUrl = Newasp.ReadDestination(Newasp.InfoDestination, Newasp.ChannelDir, rsContext("HtmlFileDate"),rsContext("HtmlFileDir"),rsContext("ClassID"),rsContext("shopid"),1,"")
			Else
				If IsURLRewrite Then
					HtmlFileUrl = rsContext("shopid") & Newasp.HtmlExtName
				Else
					HtmlFileUrl = "?id=" & rsContext("shopid")
				End If
			End If
			HtmlContent = Replace(HtmlContent, "{$NextUrl}", HtmlFileUrl)
			NextProduct = "<a href=""" & HtmlFileUrl & """>" & rsContext("TradeName") & "</a>"
		End If
		rsContext.Close
		Set rsContext = Nothing
	End Function
	'#############################\\执行商品列表开始//#############################
	'=================================================
	'过程名：BuildShopList
	'作  用：显示商城列表页面
	'=================================================
	Public Sub BuildShopList()
		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
shopchannel.asp - 源码说明

本页面展示了「小游戏网站演示www.4399.io 拥有4万条游戏数据」中的 shopchannel.asp 源码文件，采用 ASP 编程语言编写，共 1,632 行代码。您可以在线阅读完整代码内容，也可以返回资源详情页下载完整源码包进行本地学习和开发。
虫虫下载站收录了大量与4399相关的技术资源，包括源代码、技术文档、电路图等，是电子工程师和嵌入式开发者的专业学习平台。
⌨️ 快捷键说明

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