shopchannel.asp

网络上经典的图片程序

<!--#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

	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)
		ChannelRootDir = Newasp.InstallDir & Newasp.ChannelDir
		strInstallDir = Newasp.InstallDir
		strIndexName = "<a href=""" & ChannelRootDir & """>" & Newasp.ChannelName & "</a>"
		
	End Sub
	'=================================================
	'过程名：BuildShopIndex
	'作  用：显示商城首页
	'=================================================
	Public Sub BuildShopIndex()
		On Error Resume Next
		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()
		On Error Resume Next
		LoadShopIndex
		Dim FilePath
		FilePath = Newasp.InstallDir & Newasp.ChannelDir & "index" & Newasp.HtmlExtName
		Newasp.CreatedTextFile FilePath, HtmlContent
		If IsShowFlush = 1 Then Response.Write "<li style=""font-size: 12px;"">生成" & Newasp.ModuleName & "首页HTML完成... <a href=" & FilePath & " target=_blank>" & Server.MapPath(FilePath) & "</a></li>" & vbNewLine
		Response.Flush
	End Sub
	Private Sub LoadShopIndex()
		On Error Resume Next
		Newasp.LoadTemplates ChannelID, 1, 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,"{$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
		Dim strProductImage,ProductImageUrl,arrImageSize
		
		On Error Resume Next
		
		SQL = "SELECT A.*,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.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.ChannelSkin
		End If
		
		Newasp.LoadTemplates ChannelID, 3, skinid
		TradeExplain = Rs("Explain")
		TradeExplain = 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 = Replace(HtmlContent, "{$InstallDir}", strInstallDir)
		HtmlContent = Replace(HtmlContent, "{$ChannelID}", ChannelID)
		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, "{$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 = 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
		HtmlFilePath = Newasp.InstallDir & Newasp.ChannelDir & Rs("HtmlFileDir") & Newasp.ShowDatePath(Rs("HtmlFileDate"), Newasp.HtmlPath)
		Newasp.CreatPathEx (HtmlFilePath)
		HtmlFileName = HtmlFilePath & Newasp.ReadFileName(Rs("HtmlFileDate"), Rs("shopid"), Newasp.HtmlExtName, Newasp.HtmlPrefix, Newasp.HtmlForm, 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
	End Sub
	'=================================================
	'函数名：FrontProduct
	'作  用：显示上一商品
	'=================================================
	Private Function FrontProduct(shopid)
		Dim rsContext, SQL, HtmlFileUrl, HtmlFileName
		On Error Resume Next
		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
			FrontProduct = "已经没有了"
		Else
			If CreateHtml <> 0 Then
				HtmlFileUrl = ChannelRootDir & rsContext("HtmlFileDir") & Newasp.ShowDatePath(rsContext("HtmlFileDate"), Newasp.HtmlPath)
				HtmlFileName = Newasp.ReadFileName(rsContext("HtmlFileDate"), rsContext("shopid"), Newasp.HtmlExtName, Newasp.HtmlPrefix, Newasp.HtmlForm, "")
				FrontProduct = "<a href=" & HtmlFileUrl & HtmlFileName & ">" & rsContext("TradeName") & "</a>"
			Else
				FrontProduct = "<a href=?id=" & rsContext("shopid") & ">" & rsContext("TradeName") & "</a>"
			End If
		End If
		rsContext.Close
		Set rsContext = Nothing
	End Function
	'=================================================
	'函数名：NextProduct
	'作  用：显示下一商品
	'=================================================
	Private Function NextProduct(shopid)
		Dim rsContext, SQL, HtmlFileUrl, HtmlFileName
		On Error Resume Next
		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
			NextProduct = "已经没有了"
		Else
			If CreateHtml <> 0 Then
				HtmlFileUrl = ChannelRootDir & rsContext("HtmlFileDir") & Newasp.ShowDatePath(rsContext("HtmlFileDate"), Newasp.HtmlPath)
				HtmlFileName = Newasp.ReadFileName(rsContext("HtmlFileDate"), rsContext("shopid"), Newasp.HtmlExtName, Newasp.HtmlPrefix, Newasp.HtmlForm, "")
				NextProduct = "<a href=" & HtmlFileUrl & HtmlFileName & ">" & rsContext("TradeName") & "</a>"
			Else
				NextProduct = "<a href=?id=" & rsContext("shopid") & ">" & rsContext("TradeName") & "</a>"
			End If
		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
				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)
		On Error Resume Next
		Dim rsClass
		Dim HtmlFileName,maxparent,strMaxParent
		
		PageType = 1
		
		If Not IsNumeric(clsid) Then Exit Function
		Set rsClass = Newasp.Execute("SELECT ClassID,ClassName,ChildStr,ParentID,ParentStr,Child,skinid,HtmlFileDir,UseHtml 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)