cl_function_product.asp

正版创力4.1SQL商业版!!!ASP版。

<%
'===================================================
' CreateLive CMS Version 4.0
'							Powered by Aspoo.CoM
'===================================================
' File: Cl_Function_Product.asp
' Date: 2005-10-31
' Mail: [e-mail], [e-mail]
' Q  Q: 3315263, 596197794
' Msn : [e-mail], [e-mail]
' Web : http://www.aspoo.com, http://www.aspoo.net
' Bbs : http://bbs.aspoo.com, http://bbs.aspoo.net
' Copyright (C) 2005-2007 Aspoo.CoM All Rights Reserved.
'===================================================
Public Sub Product_Setting()
	CurrentPath = Cl.Language.selectSingleNode("//CurrentPath").text & "<a href='" & Cl.Web_info(4) & "'>" & Cl.Web_info(0) & "</a> &gt;&gt; <a href='" & Cl.WebDir & Cl.ChannelDir & "'>" & Cl.ChannelName & "</a>"
	Cl.Title = Cl.NoHtml(Cl.ChannelName) & " " & Cl.GotTopic(Cl.ChannelReadMe,50) & "[" & Cl.Web_info(1) & "]"
	if InfoID>0 then
		Set rs= Cl.Execute("select * from Cl_Product where InfoID=" & InfoID)
		if rs.bof and rs.eof then
			rs.Close : Set rs=Nothing
			Call Cl.OutErr(0,Replace(Cl.Language.selectSingleNode("//InfoNoFind").text,"{$channelitemname}",Cl.ChannelItemName))
		end if
		if rs("ChannelID")<>ChannelID Or rs("Deleted")=True Or rs("Status")<>1 Then
			rs.Close : Set rs=Nothing
			Call Cl.OutErr(0,Replace(Cl.Language.selectSingleNode("//InfoNoFind").text,"{$channelitemname}",Cl.ChannelItemName))
		end If
		ClassID = rs("ClassID")
		InfoTitle = rs("ProductName")
		if rs("Hot")=False then
			if rs("hits")>=Clng(Cl.Web_Setting(14)) then Cl.Execute("Update Cl_Product Set Hot=" & TrueType & " where InfoID=" & InfoID & "")
		end if
		Template.TemplateID = 0
		If CLng(Cl.Channel.selectSingleNode("@info_projectid").text)>0 Then
			Template.ProjectID = CLng(Cl.Channel.selectSingleNode("@info_projectid").text)
			If CLng(Cl.Channel.selectSingleNode("@info_templateid").text)>0 Then Template.TemplateID = CLng(Cl.Channel.selectSingleNode("@info_templateid").text)
			If CLng(Cl.Channel.selectSingleNode("@info_cssid").text)>0 Then Template.CssID = CLng(Cl.Channel.selectSingleNode("@info_cssid").text)
		End if
	end if
	if ClassID>0 Then
		Set tClass = Application(Cl.CacheName&"_classlist").documentElement.selectSingleNode("class[@classid="&ClassID&"]")
		If tClass Is Nothing Then Call Cl.OutErr(0,Cl.Language.selectSingleNode("//ClassNoFind").text)
		ClassName	= tClass.selectSingleNode("@classname").text
		ParentID	= CLng(tClass.selectSingleNode("@parentid").text)
		ParentPath	= tClass.selectSingleNode("@parentpath").text
		ClassDir	= tClass.selectSingleNode("@classdir").text
		ParentDir	= tClass.selectSingleNode("@parentdir").text
		RootID		= CLng(tClass.selectSingleNode("@rootid").text)
		Depth		= CLng(tClass.selectSingleNode("@depth").text)
		Child		= CLng(tClass.selectSingleNode("@child").text)
		arrChildID	= tClass.selectSingleNode("@arrchildid").text
		BrowsePurview=CLng(tClass.selectSingleNode("@browsepurview").text)
		VipUser		= tClass.selectSingleNode("@vipuser").text
		ClassProjectID= CLng(tClass.selectSingleNode("@projectid").text)
		ClassTemplateID = CLng(tClass.selectSingleNode("@templateid").text)
		ClassCssID	= CLng(tClass.selectSingleNode("@cssid").text)
		If CLng(Cl.Channel.selectSingleNode("@class_projectid").text)>0 Then
			Cl.ProjectID = CLng(Cl.Channel.selectSingleNode("@class_projectid").text)
			'Template.TemplateID = CLng(Cl.Channel.selectSingleNode("@class_templateid").text)
			Cl.CssID = CLng(Cl.Channel.selectSingleNode("@class_cssid").text)
		End if
		If ClassProjectID > 0 Then
			Cl.ProjectID = ClassProjectID
			Cl.CssID = ClassCssID
		End if
		If ParentID>0 Then
			Dim tNode,tParent,i
			tParent = Split(ParentPath,",")
			For i=1 To UBound(tParent)
				Set tNode = Application(Cl.CacheName&"_classlist").documentElement.selectSingleNode("class[@classid=" & tParent(i) & "]")
				If Not tNode Is Nothing Then 
				CurrentPath=CurrentPath & " &gt;&gt; <a href='" & tNode.selectSingleNode("@linkurl").text & "'>" & tNode.selectSingleNode("@classname").text & "</a>"
				End If
				Set tNode=Nothing
			Next
			tParent = Null
		End If
		CurrentPath=CurrentPath & " &gt;&gt; <a href='" & tClass.selectSingleNode("@linkurl").text & "'>" & ClassName & "</a>"
		Set tClass = Nothing
	end if
End Sub
'Rem 商品
Function GetProduct(Byval sChannelID,Byval sClassID,Byval sSpecialID,Byval TopNum,Byval IncludeChild,Byval ShowType, _
Byval ColsNum,Byval IsHot,Byval IsElite,Byval DateNum,Byval OrderType,Byval Style1,Byval Style2,Byval Style3)
	Dim JsSQL,sHTML,sTitleMaxLen,TitleStr,LinkUrl,FileType
	Dim Author,AuthorName,AuthorEmail
	Dim SystemTopDir,SystemDir
	Dim Rs,i
	On Error Resume Next
	SystemTopDir	= "http://"&Request.servervariables("Server_Name")
	SystemDir		= SystemTopDir & Cl.WebDir
	sChannelID		= Clng(sChannelID)
	sClassID		= Clng(sClassID)
	sSpecialID		= Clng(sSpecialID)
	TopNum			= Clng(TopNum)
	IncludeChild	= CBool(IncludeChild)
	ShowType		= Clng(ShowType)
	ColsNum			= Clng(ColsNum)
	IsHot			= CBool(IsHot)
	IsElite			= CBool(IsElite)
	DateNum			= CLng(DateNum)
	OrderType		= CLng(OrderType)
	Style1			= Trim(Style1)
	Style2			= Trim(Style2)
	Style3			= Trim(Style3)
	if Err then Err.Clear : GetProduct="GetProduct参数错误。":Exit Function
	On Error GoTo 0
	if TopNum > 0 then
		JsSQL="select top " & TopNum & " "
	else
		JsSQL="select top 100 "
	end if
	JsSQL=JsSQL & " P.InfoID,P.ChannelID,P.ChannelDir,P.ClassID,C.ClassName,C.ParentPath,C.ClassDir,C.ParentDir,P.ProductName,P.Prefixion,P.ProductSn,P.Producer,P.Trademark,P.ProductModel,P.ProductUnit,P.Intro,P.MarketPrice,P.MemberPrice,P.TruePrice,P.Discount,P.IncludeTax,P.TaxRate,P.InfoPoint,P.StockNum,P.PresentExp,P.PicUrl,P.OnTop,P.Hot,P.Elite,P.Stars,P.Hits,P.BuyTimes,P.UpdateTime,P.Editor,P.Status,P.IsHtml,P.HtmlFileUrl from Cl_Product P"
	JsSQL=JsSQL & " inner join Cl_Class C on P.ClassID=C.ClassID where P.Deleted="&FalseType&" and P.Status=1"
	if sChannelID>0 then JsSQL=JsSQL & " and P.ChannelID="&sChannelID&" "
	if sClassID>0 then
		if IncludeChild=True then
			Dim tClass
			set tClass=Cl.Execute("select ClassID,ParentPath,arrChildID From Cl_Class where ClassID=" & sClassID)
			if tClass.bof and tClass.eof then
				GetProduct="找不到指定的栏目。" : set tClass=Nothing : Exit Function
			else
				JsSQL=JsSQL & " and P.ClassID in (" & tClass(2) & ")"
			end if
			set tClass=Nothing
		else
			JsSQL=JsSQL & " and P.ClassID=" & sClassID & ""
		end if
	end if
	if sSpecialID>0 then JsSQL=JsSQL & " and P.SpecialID like '%," & sSpecialID & ",%'"
	if ShowType >= 2 then JsSQL=JsSQL & " and P.PicUrl<>''"
	if IsHot=True then JsSQL=JsSQL & " and P.Hot="&TrueType&""
	if IsElite=True then JsSQL=JsSQL & " and P.Elite="&TrueType&""
	if DateNum>0 then
		if IsSqlDatabase=1 then
			JsSQL=JsSQL & " and datediff(d,P.UpdateTime,"&SQLNowString&")<=" & DateNum & " "
		else
			JsSQL=JsSQL & " and datediff('d',P.UpdateTime,"&SQLNowString&")<=" & DateNum & " "
		end if
	end if
	JsSQL=JsSQL & " order by P.OnTop asc"
	Select Case OrderType
	Case 1 : JsSQL=JsSQL & " ,P.InfoID desc"
	Case 2 : JsSQL=JsSQL & " ,P.InfoID asc"
	Case 3 : JsSQL=JsSQL & " ,P.UpDateTime desc, P.InfoID desc"
	Case 4 : JsSQL=JsSQL & " ,P.UpDateTime asc, P.InfoID desc"
	Case 5 : JsSQL=JsSQL & " ,P.Hits desc, P.InfoID desc"
	Case 6 : JsSQL=JsSQL & " ,P.Hits asc, P.InfoID desc"
	Case else : JsSQL=JsSQL & " ,P.InfoID desc"
	End Select
	set Rs=server.createObject("Adodb.recordset")
	OpenConn : Rs.open JsSQL,Conn,1,1
	if Rs.bof and Rs.eof then 
		GetProduct = "当前没有记录！"
		Rs.close:set Rs=Nothing : Exit Function
	End if
	JsSQL=Rs.GetRows(-1)
	Rs.close:set Rs=Nothing
	Dim TempBody
	Dim regEx,Matches,Match,TempStr
	Dim PropertyImg,ClassFileUrl,sImgUrl
	TempBody="":sHTML=""
	Set regEx	= New RegExp
	regEx.Pattern = "{\$.[^{\$}]*}"
	regEx.IgnoreCase = True
	regEx.Global = True
	For i=0 to Ubound(JsSQL,2)
		if JsSQL(35,i)=True then
			LinkUrl = SystemDir & JsSQL(36,i)
		else
			LinkUrl = SystemDir & JsSQL(2,i) & "/ShowInfo.asp?InfoID=" & JsSQL(0,i)
		end if
		if JsSQL(26,i)=True then
			PropertyImg = "<img src=""" & InstallDir & "Images/ProductOntop.gif"" alt=""固顶"" />"
		elseif JsSQL(28,i)=True then
			PropertyImg = "<img src=""" & InstallDir & "Images/ProductElite.gif"" alt=""推荐"" />"
		else
			PropertyImg = "<img src=""" & InstallDir & "Images/ProductCommon.gif"" alt=""普通"" />"
		end if
		ClassFileUrl = SystemDir & JsSQL(2,i) & "/ShowClass.asp?ClassID=" & JsSQL(3,i)
		if ShowType >= 2 then
			FileType=right(lcase(JsSQL(25,i)),3)
			JsSQL(25,i) = Cl.GetPicUrl(JsSQL(25,i))
			Select Case FileType
			Case "swf"
				sImgUrl = "<object classid=""clsid:D27CDB6E-AE6D-11cf-96B8-444553540000"" codebase=""http://download.macromedia.com/pub/shockwave/cabs/flash/swflash.cab#version=5,0,0,0"" width=""{$ImgWidth}"" height=""{$ImgHeight}""><param name=""movie"" value=""" & JsSQL(25,i) & """><param name=""quality"" value=""high""><embed src=""" & JsSQL(25,i) & """ pluginspage=""http://www.macromedia.com/shockwave/download/index.cgi?P1_Prod_Version=ShockwaveFlash"" type=""application/x-shockwave-flash"" width=""{$ImgWidth}"" height=""{$ImgHeight}""></embed></object>"
			Case "jpg", "bmp", "png", "gif"
				sImgUrl = "<img src=""" & JsSQL(25,i) & """ width=""{$ImgWidth}"" height=""{$ImgHeight}"" border=0>"
			Case Else
				sImgUrl = "<img src=""" & SystemDir & "images/NoPic2.jpg"" width=""{$ImgWidth}"" height=""{$ImgHeight}"" border=0>"
			End Select
		end if
		TempBody	= Style2
		TempBody	= Replace(TempBody,"{$InfoID}",JsSQL(0,i))
		TempBody	= Replace(TempBody,"{$Prefixion}",JsSQL(9,i)&"")
		TempBody	= Replace(TempBody,"{$PropertyImg}",PropertyImg)
		TempBody	= Replace(TempBody,"{$LinkUrl}",LinkUrl)
		TempBody	= Replace(TempBody,"{$ClassID}",JsSQL(3,i))
		TempBody	= Replace(TempBody,"{$ClassName}",JsSQL(4,i))
		TempBody	= Replace(TempBody,"{$ClassUrl}",ClassFileUrl)
		TempBody	= Replace(TempBody,"{$ProductSn}",JsSQL(10,i))
		TempBody	= Replace(TempBody,"{$Producer}",JsSQL(11,i))
		TempBody	= Replace(TempBody,"{$Trademark}",JsSQL(12,i))
		TempBody	= Replace(TempBody,"{$ProductModel}",JsSQL(13,i))
		TempBody	= Replace(TempBody,"{$ProductUnit}",JsSQL(14,i))
		TempBody	= Replace(TempBody,"{$MarketPrice}",JsSQL(16,i))
		TempBody	= Replace(TempBody,"{$MemberPrice}",JsSQL(17,i))
		TempBody	= Replace(TempBody,"{$TruePrice}",JsSQL(18,i))
		TempBody	= Replace(TempBody,"{$Discount}",JsSQL(19,i))
		TempBody	= Replace(TempBody,"{$InfoPoint}",JsSQL(22,i))
		TempBody	= Replace(TempBody,"{$StockNum}",JsSQL(23,i))
		TempBody	= Replace(TempBody,"{$PresentExp}",JsSQL(24,i))
		TempBody	= Replace(TempBody,"{$Stars}",JsSQL(29,i))
		TempBody	= Replace(TempBody,"{$Hits}",JsSQL(30,i))
		TempBody	= Replace(TempBody,"{$BuyTimes}",JsSQL(31,i))
		TempBody	= Replace(TempBody,"{$Editor}",JsSQL(33,i))
		Set Matches = regEx.Execute(TempBody)
		For Each Match in Matches
			TempStr = Replace(Match.Value,"{$","")
			TempStr = Replace(TempStr,"}","")
			TempStr = Replace(TempStr,"(",",")
			TempStr = Replace(TempStr,")","")
			TempStr = Replace(TempStr,"""","")
			TempStr = Split(Lcase(TempStr),",")
			Select Case TempStr(0)
			Case "title"
				TitleStr = Cl.GotTopic(JsSQL(8,i),TempStr(1))
				TempBody = Replace(TempBody,Match.Value,TitleStr)
			Case "imgurl"
				sImgUrl	 = Replace(sImgUrl,"{$ImgWidth}",TempStr(1))
				sImgUrl	 = Replace(sImgUrl,"{$ImgHeight}",TempStr(2))
				TempBody = Replace(TempBody,Match.Value,sImgUrl)
			Case "intro"
				TempBody = Replace(TempBody,Match.Value,Left(Cl.NoHtml(JsSQL(15,i)),TempStr(1)))
			Case "updatetime"
				TempBody = Replace(TempBody,Match.Value,Cl.Format_Time(JsSQL(32,i),TempStr(1)))
			End Select
		Next
		sHTML = sHTML & TempBody
		if (i+1) mod ColsNum=0 then sHTML = sHTML & Style3
	Next
	GetProduct=Replace(Style1,"{$ContentBody}",sHTML)
	JsSQL=Empty