cl_clstemplate.asp

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

				if instr(Node.SelectSingleNode("@author").text,"|")>0 then
					DataStr	= Split(Node.SelectSingleNode("@author").text,"|")(0)
				else
					DataStr	= Node.SelectSingleNode("@author").text
				end if
			Case "authoremail"
				if instr(Node.SelectSingleNode("@author").text,"|")>0 then
					DataStr	= Split(Node.SelectSingleNode("@author").text,"|")(1)
				else
					DataStr	= ""
				end if
			Case "title","softname","photoname","moviename","productname"
				If UBound(ArrayStr)<1 Then
				DataStr = Node.SelectSingleNode("@" & ArrayStr(0)).text
				else
				DataStr = Cl.GotTopic(Node.SelectSingleNode("@" & ArrayStr(0)).text,ArrayStr(1))
				DataStr = Cl.GetTitleFont(DataStr,Node.SelectSingleNode("@fonttype").text)
				DataStr = Cl.FormatColor(DataStr,Node.SelectSingleNode("@fontcolor").text)
				End If
			Case "titlewithfont"
				If UBound(ArrayStr)<1 Then
				DataStr = Node.SelectSingleNode("@" & ArrayStr(0)).text
				else
				DataStr = Cl.GotTopic(Node.SelectSingleNode("@" & ArrayStr(0)).text,ArrayStr(1))
				End If
				DataStr = Cl.GetTitleFont(DataStr,Node.SelectSingleNode("@fonttype").text)
				DataStr = Cl.FormatColor(DataStr,Node.SelectSingleNode("@fontcolor").text)
			Case "showpic"
				Dim sImgUrl,sPicUrl
				sPicUrl  = Cl.GetPicUrl(Node.SelectSingleNode("@picurl").text)
				Select Case right(lcase(sPicUrl),3)
				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=""" & sPicUrl & """><param name=""quality"" value=""high""><embed src=""" & sPicUrl & """ 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=""" & sPicUrl & """ width=""{$ImgWidth}"" height=""{$ImgHeight}"" border=""0"" />"
				Case Else
					sImgUrl = "<img src=""" & InstallDir & "images/NoPic.jpg"" width=""{$ImgWidth}"" height=""{$ImgHeight}"" border=""0"" alt="""" />"
				End Select
				sImgUrl	 = Replace(sImgUrl,"{$ImgWidth}",ArrayStr(1))
				DataStr	 = Replace(sImgUrl,"{$ImgHeight}",ArrayStr(2))
			Case "picurl"
				if Trim(Node.SelectSingleNode("@picurl").text)="" then
					DataStr = InstallDir & "images/nopic.gif"
				else
					DataStr = Node.SelectSingleNode("@picurl").text
				end If
			Case "intro"
				If UBound(ArrayStr)<1 Then
				DataStr = Node.SelectSingleNode("@intro").text
				Else
				DataStr = Left(Cl.NoHTML(Node.SelectSingleNode("@intro").text&""),ArrayStr(1))
				End if
			Case "updatetime"
				If UBound(ArrayStr)<1 Then
				DataStr = Node.SelectSingleNode("@updatetime").text
				else
				DataStr = Cl.Format_Time(Node.SelectSingleNode("@updatetime").text,ArrayStr(1))
				End If
				if CDate(FormatDateTime(Node.SelectSingleNode("@updatetime").text,2))=Date() Then
				DataStr = "<span style=""color:#ff0033;"">"&DataStr&"</span>"
				End if
			Case "infogroupname"
				DataStr = Cl.GetUserGroupName(Node.SelectSingleNode("@infogroup").text)
			Case "newicon"
				if CDate(FormatDateTime(Node.SelectSingleNode("@updatetime").text,2))=Date() then
					DataStr = "<img src=""" & InstallDir & "Images/news.gif"" alt=""最新"" />"
				else
					DataStr = ""
				end If
			Case "hoticon"
				if CLng(Node.SelectSingleNode("@hits").text)>=Clng(Cl.Web_Setting(14)) then
					DataStr = "<img src=""" & InstallDir & "Images/hot.gif"" alt=""热门"" />"
				Else
					DataStr = ""
				end If
			Case Else
				'Response.write ArrayStr(0) & "<br />"
				DataStr = Node.SelectSingleNode("@"&ArrayStr(0)).text
			End Select
			sTemp = Replace(sTemp,Match.Value,DataStr)
		Next
		ReplaceInfoContent = sTemp
		sTemp		= Empty
		DataStr		= Empty
		ArrayStr	= Empty
		Set Match = Nothing
		Set IregEx = Nothing
	End Function

	Public Function ReplaceLabel(ByVal sContent)
		Dim RsLabel,LabelStr
		Set RsLabel = Cl.Execute("Select LabelName,LabelContent from Cl_Label Order By LabelPriority,LabelID")
		if RsLabel.bof or RsLabel.eof then
			ReplaceLabel = sContent
			Set RsLabel = Nothing : Exit Function
		end If
		LabelStr = RsLabel.GetRows(-1)
		Set RsLabel = Nothing
		Dim i
		for i=0 to Ubound(LabelStr,2)
			If InStr(sContent,"{$"&LabelStr(0,i)&"}")>0 Then
			sContent = Replace(sContent,"{$"&LabelStr(0,i)&"}",LabelStr(1,i))
			End if
		next
		ReplaceLabel=sContent
		LabelStr = Empty
	End Function

	Rem 取得循环内容
	Public Function GetPartContent(ByVal sContent, ByVal BStr, ByVal EStr)
		Dim PartStr
		'On Error Resume Next
		If InStr(sContent, BStr) > 0 Then
			'PartStr = Right(sContent,Len(sContent) - InStr(sContent, BStr) - Len(BStr) + 1)
			'PartStr = Left(PartStr,InStr(PartStr, EStr) - 1)
			PartStr = Left(sContent,InStr(sContent, EStr)-1)
			PartStr = Right(PartStr,Len(PartStr) - InStrRev(PartStr,BStr) - Len(BStr) + 1)
		End If
		GetPartContent = PartStr
	End Function

	Public Function ClLabelEnCode(ByVal sContent)
		sContent = Replace(sContent,"{$","#CL$")
		sContent = Replace(sContent,"}","$CL#")
		sContent = Replace(sContent,"[Cl_Loop]","#Cl_Loop#")
		sContent = Replace(sContent,"[/Cl_Loop]","#/Cl_Loop#")
		sContent = Replace(sContent,"【Cl_Loop","@Cl_Loop")
		sContent = Replace(sContent,"【/Cl_Loop","@/Cl_Loop")
		sContent = Replace(sContent,"【Cl_ClassLoop","@Cl_ClassLoop")
		sContent = Replace(sContent,"【/Cl_ClassLoop","@/Cl_ClassLoop")
		ClLabelEnCode = sContent
	End Function

	Public Function ClLabelDeCode(ByVal sContent)
		sContent = Replace(sContent,"#CL$","{$")
		sContent = Replace(sContent,"$CL#","}")
		sContent = Replace(sContent,"#Cl_Loop#","[Cl_Loop]")
		sContent = Replace(sContent,"#/Cl_Loop#","[/Cl_Loop]")
		sContent = Replace(sContent,"@Cl_Loop","【Cl_Loop")
		sContent = Replace(sContent,"@/Cl_Loop","【/Cl_Loop")
		sContent = Replace(sContent,"@Cl_ClassLoop","【Cl_ClassLoop")
		sContent = Replace(sContent,"@/Cl_ClassLoop","【/Cl_ClassLoop")
		ClLabelDeCode = sContent
	End Function

	Public Function GetClassMenu(sChannelID)
		Dim sTemp, TopNum, ModNum, SettingStr
		Dim SQL, Rs, j, ClassUrlStr, OpenType
		Cl.Load_ChannelSetting(sChannelID)
		SettingStr	= Split(Cl.Channel.selectSingleNode("@othersetting").text,",")
		TopNum		= Clng(SettingStr(0))
		ModNum		= Clng(SettingStr(1))
		If TopNum > 0 Then 
			TopNum	= "Top "&TopNum&""
		Else
			TopNum	= ""
		End If 
		If ModNum = 0 Then ModNum=10
		sTemp = "<!--" & vbcrlf
		sTemp = sTemp & "stm_bm(['uueoehr',400,'','"&Cl.WebDir&"images/blank.gif',0,'','',0,0,0,0,0,1,0,0]);" & vbcrlf
		sTemp = sTemp & "stm_bp('p0',[0,4,0,0,2,2,0,0,100,'',-2,'',-2,90,0,0,'#000000','transparent','',3,0,0,'#000000']);" & vbcrlf
		sTemp = sTemp & "stm_ai('p0i0',[0,'|','','',-1,-1,0,'','_self','','','','',0,0,0,'','',0,0,0,0,1,'#f1f2ee',1,'#cccccc',1,'','',3,3,0,0,'#fffff7','#000000','"&Cl.Language.selectSingleNode("//Color/ClassMenu1").text&"','"&Cl.Language.selectSingleNode("//Color/ClassMenu2").text&"','9pt 宋体','9pt 宋体',0,0]);" & vbcrlf
		Rem Begin(如不显示频道首页连接，请注消)
		ClassUrlStr = Cl.WebDir & Cl.Channel.selectSingleNode("@channeldir").text
		sTemp = sTemp & "stm_aix('p0i1','p0i0',[0,'"&Cl.Channel.selectSingleNode("@channelname").text&"','','',-1,-1,0,'" & ClassUrlStr & "','_self','" & ClassUrlStr & "','','','',0,0,0,'','',0,0,0,0,1,'#f1f2ee',1,'#cccccc',1,'','',3,3,0,0,'#fffff7','#ff0000','"&Cl.Language.selectSingleNode("//Color/ClassMenu1").text&"','"&Cl.Language.selectSingleNode("//Color/ClassMenu2").text&"','9pt 宋体','9pt 宋体']);" & vbcrlf
		sTemp = sTemp & "stm_aix('p0i2','p0i0',[0,'|','','',-1,-1,0,'','_self','','','','',0,0,0,'','',0,0,0,0,1,'#f1f2ee',1,'#cccccc',1,'','',3,3,0,0,'#fffff7','#000000','"&Cl.Language.selectSingleNode("//Color/ClassMenu1").text&"','"&Cl.Language.selectSingleNode("//Color/ClassMenu2").text&"','9pt 宋体','9pt 宋体',0,0]);" & vbcrlf
		Rem End
		SQL="Select "&TopNum&" ClassID,ClassName,ParentPath,ClassDir,ParentDir,Depth,NextID,Child,Readme,IsOuter,LinkUrl From Cl_Class where ChannelID="&Cint(sChannelID)&" and Depth=0 and ShowOnTop="&TrueType&" order by RootID"
		Set rs = Cl.Execute(SQL)
		If Not (Rs.bof And Rs.eof) Then 
			SQL = Rs.GetRows(-1)
			pNum = 1 : pNum2 = 0
			For j=0 To Ubound(SQL,2)
				If (j+1) mod ModNum=0 Then 
					sTemp = sTemp & "stm_em();" & vbcrlf
					sTemp = sTemp & "//-->" & vbcrlf
					sTemp = sTemp & "<!--" & vbcrlf
					sTemp = sTemp & "stm_bm(['uueoehr',400,'','"&Cl.WebDir&"images/blank.gif',0,'','',0,0,0,0,0,1,0,0]);" & vbcrlf
					sTemp = sTemp & "stm_bp('p0',[0,4,0,0,2,2,0,0,100,'',-2,'',-2,90,0,0,'#000000','transparent','',3,0,0,'#000000']);" & vbcrlf
					sTemp = sTemp & "stm_ai('p0i0',[0,'|','','',-1,-1,0,'','_self','','','','',0,0,0,'','',0,0,0,0,1,'#f1f2ee',1,'#cccccc',1,'','',3,3,0,0,'#fffff7','#000000','"&Cl.Language.selectSingleNode("//Color/ClassMenu1").text&"','"&Cl.Language.selectSingleNode("//Color/ClassMenu2").text&"','9pt 宋体','9pt 宋体',0,0]);" & vbcrlf
				End If
				If SQL(9,j)=1 Then
					ClassUrlStr = SQL(10,j)
					OpenType	= "_blank"
				Else
					ClassUrlStr = Cl.GetClassLinkUrl(SQL(0,j))
					OpenType	= "_self"
				End If
				sTemp = sTemp & "stm_aix('p0i"&j&"','p0i0',[0,'" & SQL(1,j) & "','','',-1,-1,0,'" & ClassUrlStr & "','"&OpenType&"','" & ClassUrlStr & "','" & SQL(8,j) & "','','',0,0,0,'','',0,0,0,0,1,'#f1f2ee',1,'#cccccc',1,'','',3,3,0,0,'#fffff7','#ff0000','"&Cl.Language.selectSingleNode("//Color/ClassMenu1").text&"','"&Cl.Language.selectSingleNode("//Color/ClassMenu2").text&"','9pt 宋体','9pt 宋体']);" & vbcrlf
				If SQL(7,j)>0 And Clng(SettingStr(2))=1 Then sTemp = sTemp & GetChildMenu(SQL(0,j),0,sChannelID)
				sTemp = sTemp & "stm_aix('p0i2','p0i0',[0,'|','','',-1,-1,0,'','_self','','','','',0,0,0,'','',0,0,0,0,1,'#f1f2ee',1,'#cccccc',1,'','',3,3,0,0,'#fffff7','#000000','"&Cl.Language.selectSingleNode("//Color/ClassMenu1").text&"','"&Cl.Language.selectSingleNode("//Color/ClassMenu2").text&"','9pt 宋体','9pt 宋体',0,0]);" & vbcrlf
			Next
			SQL=Empty
		End If 
		Rs.Close : Set Rs=Nothing
		sTemp = sTemp & "stm_em();" & vbcrlf
		GetClassMenu = Cl.ReplaceDir(sTemp) & "//-->"
		sTemp=Empty
	End Function

	Public Function GetChildMenu(ID,ShowType,sChannelID)
		dim SQL,Rs,k,sTemp,ClassUrlStr,OpenType
		If pNum=1 Then 
			sTemp = "stm_bp('p" & pNum & "',[1,4,0,0,2,3,6,7,100,'progid:DXImageTransform.Microsoft.Fade(overlap=.5,enabled=0,Duration=0.43)',-2,'',-2,67,2,3,'#999999','#ffffff','',3,1,1,'#aca899']);" & vbcrlf
		Else 
			If ShowType=0 Then 
				sTemp = "stm_bpx('p" & pNum & "','p" & pNum2 & "',[1,4,0,0,2,3,6]);" & vbcrlf
			Else 
				sTemp = "stm_bpx('p" & pNum & "','p" & pNum2 & "',[1,2,-2,-3,2,3,0]);" & vbcrlf
			End If 
		End If 
		SQL="select ClassID,ClassName,ParentPath,ClassDir,ParentDir,Depth,NextID,Child,Readme,IsOuter,LinkUrl From Cl_Class where ChannelID="&Cint(sChannelID)&" and ParentID=" & ID & " and ShowOnTop="&TrueType&" order by OrderID asc"
		Set Rs = Cl.Execute(SQL)
		if Not (Rs.Bof and Rs.Eof) THen
			SQL = Rs.GetRows(-1)
			For k=0 to Ubound(SQL,2)
				If SQL(9,k)=1 Then
					ClassUrlStr = SQL(10,k)
					OpenType	= "_blank"
				Else
					ClassUrlStr = Cl.GetClassLinkUrl(SQL(0,k))
					OpenType	= "_self"
				End If
				If SQL(7,k) > 0 Then 
				sTemp = sTemp & "stm_aix('p"&pNum&"i"&k&"','p"&pNum2&"i0',[0,'" & SQL(1,k) & "','','',-1,-1,0,'" & ClassUrlStr & "','"&OpenType&"','" & ClassUrlStr & "','" & SQL(8,k) & "','','',6,0,0,'"&Cl.WebDir&"images/arrow_r.gif','"&Cl.WebDir&"images/arrow_w.gif',7,7,0,0,1,'#ffffff',0,'#cccccc',0,'','',3,3,0,0,'#fffff7','#000000','#000000','#ffffff','9pt 宋体']);" & vbcrlf
				pNum=pNum+1 : pNum2=pNum2+1
				sTemp = sTemp & GetChildMenu(SQL(0,k),1,sChannelID)
				Else 
				sTemp = sTemp & "stm_aix('p"&pNum&"i"&k&"','p"&pNum2&"i0',[0,'" & SQL(1,k) & "','','',-1,-1,0,'" & ClassUrlStr & "','"&OpenType&"','" & ClassUrlStr & "','" & SQL(8,k) & "','','',0,0,0,'','',0,0,0,0,1,'#f1f2ee',1,'#cccccc',0,'','',3,3,0,0,'#fffff7','#ff0000','#000000','#cc0000','9pt 宋体']);" & vbcrlf
				End If 
			Next
			SQL=Empty
		End if
		Rs.Close : Set Rs=Nothing
		GetChildMenu = sTemp & "stm_ep();" & vbcrlf
		sTemp=Empty
	End Function

	Public Function ShowUserLogin(Byval sType)
		Dim sTemp
		if sType="1" Then
			Html = GetTemplate(Cl.GetDefaultTemplateID(-1,4,ProjectID))
		Else
			Html = GetTemplate(Cl.GetDefaultTemplateID(-1,3,ProjectID))
		end If
		Html = Split(Html,"@@@")
		if Cl.UserID=0 Or Cl.UserGroupID=5 then
			sTemp=Replace(Html(0),"{$webname}",Cl.Web_Info(0))
			if Cl.Web_Setting(39)="Yes" then
				sTemp=Replace(sTemp,"{$getcode}",Replace(Html(5),"{$getcode}",Cl.GetCode("GetCode")))
			else
				sTemp=Replace(sTemp,"{$getcode}","")
			end if
		Else
			if Cint(Cl.UserGroupID)=1 then
				sTemp=Replace(Html(2),"{$webname}",Cl.Web_Info(0))
			else
				sTemp=Replace(Html(1),"{$webname}",Cl.Web_Info(0))
			end if
			if Cint(Cl.User_Info(17))=1 then
				sTemp=Replace(sTemp,"{$userinfo}",Html(3))
				if clng(Cl.User_Info(15))>10 then
					sTemp=Replace(sTemp,"{$color2}",Cl.Language.selectSingleNode("//Color/Point1").text)
				else
					sTemp=Replace(sTemp,"{$color2}",Cl.Language.selectSingleNode("//Color/Point2").text)
				end if
			else
				sTemp=Replace(sTemp,"{$userinfo}",Html(4))
				if clng(Cl.User_Info(22))>10 then
					sTemp=Replace(sTemp,"{$color3}",Cl.Language.selectSingleNode("//Color/Day1").text)
				else
					sTemp=Replace(sTemp,"{$color3}",Cl.Language.selectSingleNode("//Color/Day1").text)
				end if
			end If
			if Cint(Cl.SendMsgNum)>0 Then
				sTemp=Replace(sTemp,"{$newincept}","<font color="""&Cl.Language.selectSingleNode("//Color/Message1").text&""">"&Cl.SendMsgNum&"</font>")
				if Cl.Web_Setting(36)="Yes" Then
					sTemp=sTemp & vbNewLine & Cl.Language.selectSingleNode("//User/PopMessage").text
					sTemp=Replace(sTemp,"{$inceptid(1)}",Cl.SendMsgID)
					sTemp=Replace(sTemp,"{$inceptid(2)}","")
				end If
			else
				sTemp=Replace(sTemp,"{$newincept}","<font color="""&Cl.Language.selectSingleNode("//Color/Message2").text&""">"&Cl.SendMsgNum&"</font>")
			end If
			sTemp=Replace(sTemp,"{$userid}",Cl.UserID)
			sTemp=Replace(sTemp,"{$username}",Cl.MemberName)
			sTemp=Replace(sTemp,"{$userpoint}",Cl.User_Info(15))
			sTemp=Replace(sTemp,"{$usermoney}",Cl.User_Info(16))
			sTemp=Replace(sTemp,"{$moneyitemname}",Cl.Web_Setting(26))
			sTemp=Replace(sTemp,"{$moneyitemunit}",Cl.Web_Setting(27))
			sTemp=Replace(sTemp,"{$pointitemname}",Cl.Web_Setting(28))
			sTemp=Replace(sTemp,"{$pointitemunit}",Cl.Web_Setting(29))
			sTemp=Replace(sTemp,"{$usergroupid}",Cl.UserGroupID)
			sTemp=Replace(sTemp,"{$usergroupname}",Cl.GetUserGroupName(Cl.UserGroupID))
			sTemp=Replace(sTemp,"{$uservalidday}",Cl.User_Info(22))
			sTemp=Replace(sTemp,"{$color1}",Cl.Language.selectSingleNode("//Color/UserName").text)
			if CLng(Cl.User_Info(16))>10 then
				sTemp=Replace(sTemp,"{$color4}",Cl.Language.selectSingleNode("//Color/Money1").text)
			else
				sTemp=Replace(sTemp,"{$color4}",Cl.Language.selectSingleNode("//Color/Money2").text)
			end if
		end if
		ShowUserLogin=Replace(sTemp,"{$channelid}",ChannelID)
		sTemp= Empty
	End Function

End Class
%>