📄 cl_function_public.asp

📁 淘客网上商店网站程序淘客网上商店网站程序淘客网上商店网站程序
💻 ASP
📖 第 1 页 / 共 4 页
字号:
12 3 4 下一页
<%
'===================================================
' CreateLive CMS Version 4.0
'							Powered by Aspoo.CoM
'===================================================
' File: Cl_Function_Public.asp
' Date: 2005-10-31
' Mail: support@aspoo.cn, Info@aspoo.cn
' Q  Q: 3315263, 596197794
' Msn : support@aspoo.cn, Clw866@hotmail.com
' 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.
'===================================================
'==================================================================
'过程：ShowLogo(sChannelID,sWidth,sHeight)
'参数：
'	sChannelID		------  频道ID
'	sWidth			------  宽度
'	sHeight			------  高度
'==================================================================
Function ShowLogo(Byval sChannelID,Byval sWidth,Byval sHeight)
	if Cl.Logo <> "" then
		dim sLogo
		'sChannelID	= Cl.GetClng(sChannelID)
		'sWidth		= Cl.GetClng(sWidth)
		'sHeight	= Cl.GetClng(sHeight)
		sLogo = "<a href=""" & Cl.ReplaceDir(Cl.Web_Info(4)) & """ title=""" & Cl.Web_Info(0) & """>"
		Cl.Logo=Cl.ReplaceDir(Cl.Logo)
		if lcase(right(Cl.Logo,3))<>"swf" then
			sLogo = sLogo & "<img src=""" & Cl.Logo & """ width="""& sWidth &"""  height=""" & sHeight & """ border=""0"" alt="""" />"
		else
			sLogo = sLogo & "<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="""& sWidth &""" height="""& sHeight &"""><param name=""movie"" value=""" & Cl.Logo & """><param name=""quality"" value=""high""><param name=""wmode"" value=""transparent""><embed src=""" & Cl.Logo & """ pluginspage=""http://www.macromedia.com/shockwave/download/index.cgi?P1_Prod_Version=ShockwaveFlash"" type=""application/x-shockwave-flash"" width="""& sWidth &""" height="""& sHeight &"""></embed></object>"
		end if
		sLogo = sLogo & "</a>"
		ShowLogo = sLogo
	else
		ShowLogo = "<a href=""http://www.aspoo.cn"" title=""创力网""><img src=""http://www.aspoo.cn/images/logo.gif"" width="""& sWidth &""" height="""& sHeight &""" border=""0"" alt="""" /></a>"
	end if
End Function

'==================================================================
'过程：ShowBanner(sChannelID,Width,Height)
'参数：
'	sChannelID		------  频道ID
'	sWidth			------  宽度
'	sHeight			------  高度
'==================================================================
Function ShowBanner(Byval sChannelID,Byval sWidth,Byval sHeight)
	if Cl.Banner<>"" then
		'sChannelID	= Cl.GetClng(sChannelID)
		'sWidth		= Cl.GetClng(sWidth)
		'sHeight		= Cl.GetClng(sHeight)
		Cl.Banner = Cl.ReplaceDir(Cl.Banner)
		if lcase(right(Cl.Banner,3))="swf" then
			ShowBanner="<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="""& sWidth &""" height="""& sHeight &"""><param name=""movie"" value=""" & Cl.Banner & """><param name=""quality"" value=""high""><param name=""wmode"" value=""transparent""><embed src=""" & Cl.Banner & """ pluginspage=""http://www.macromedia.com/shockwave/download/index.cgi?P1_Prod_Version=ShockwaveFlash"" type=""application/x-shockwave-flash"" width="""& sWidth &""" height="""& sHeight &"""></embed></object>"
		else
			ShowBanner="<a href=""" & Cl.Web_Info(4) & """ title=""" & Cl.Web_Info(0) & """><img src=""" & Cl.Banner & """ width="""& sWidth &""" height="""& sHeight &""" border=""0"" alt="""" /></a>"
		end if
	else
		ShowBanner="<a href=""http://www.aspoo.cn/""><img src=""http://www.aspoo.cn/Images/Banner.Gif"" width="""& sWidth &""" height="""& sHeight &""" border=""0"" alt="""" /></a>"
	end if
End Function
'显示网站调查
Function ShowVote(Byval sChannelID,Byval TopNum)
	dim i,ii,strHTML,sConTent,sType
	sChannelID = Cl.GetClng(sChannelID)
	TopNum = Cl.GetClng(TopNum)
	if TopNum<=1 then TopNum=1
	dim SqlVote,RsVote
	SqlVote = "select top "&TopNum&" ID,Title,Content,nums,Type,totalNums from Cl_Vote where IsNew=1 and (ChannelID=-1 or ChannelID=" & sChannelID & ") order by ID Desc"
	Set RsVote = Cl.Execute(SqlVote)
	if rsVote.bof and rsVote.eof then
		ShowVote = "<li>没有任何调查</li>"
		rsVote.close : set rsVote=Nothing : Exit Function
	End If
	SqlVote = rsVote.GetRows(-1)
	rsVote.close:set rsVote=Nothing
	For ii=0 to Ubound(SqlVote,2)
	strHTML = strHTML & "<form action=""" & Cl.WebDir & "Vote.asp"" method=""post"" target=""_blank"" name=""VoteForm"&SqlVote(0,ii)&""" id=""VoteForm"&SqlVote(0,ii)&"""><div>"
	strHTML = strHTML & "&nbsp;&nbsp;&nbsp;&nbsp;" & SqlVote(1,ii) & "<br />"
	sConTent = Split(SqlVote(2,ii),"@")
	if SqlVote(4,ii) = 0 then
		sType = "radio"
	else
		sType = "checkbox"
	end if
	for i=0 to Ubound(sConTent)
		if Trim(sConTent(i)) = "" then exit for
		strHTML = strHTML & "<input type="""&sType&""" name=""VoteOption"" value="""&i&""" />" & sConTent(i) & "<br />"
	next
	strHTML = strHTML & "<br /><input name=""VoteType"" type=""hidden"" value=""" & Trim(SqlVote(4,ii)) & """ />"
	strHTML = strHTML & "<input name=""Action"" type=""hidden"" value=""Vote"" />"
	strHTML = strHTML & "<input name=""ID"" type=""hidden"" value=""" & SqlVote(0,ii) & """ />"
	strHTML = strHTML & "<p style=""text-align:center;"">"
	strHTML = strHTML & "<a href=""javascript:VoteForm"&SqlVote(0,ii)&".submit();""><img src=""" & InstallDir & "Images/voteSubmit.gif"" width=""52"" height=""18"" border=""0"" /></a>&nbsp;&nbsp;"
	strHTML = strHTML & "<a href=""" & Cl.WebDir & "Vote.asp?ID=" & SqlVote(0,ii) & "&amp;Action=Show"" target=""_blank""><img src=""" & InstallDir & "Images/voteView.gif"" width=""52"" height=""18"" border=""0"" alt="""" /></a></p>"
	strHTML = strHTML & "</div></form>"
	Next
	ShowVote = strHTML
End Function

'==================================================================
'过程：ShowAnnounce(sChannelID,TopNum,TitleLen,ShowType,DateType)
'参数：
'	sChannelID		------  频道ID
'	TopNum			------  最多记录数，0为全部(用于分页显示)
'	TitleLen		------  标题最多字节数，只对列表方式有效
'	ShowType		------  0列表，1纵向，2横向
'	DateType		------  显示更新日期的样式
'					---- 0(不显示)
'					---- 1(2004-10-01 23:45:45)
'					---- 2(年-月-日 时:分:秒)
'					---- 3(2004-10-01)
'					---- 4(2004\10\01)
'					---- 5(10-01 23:45)
'					---- 6(2004年10月01日)
'					---- 7(10-01)
'					---- 8(20041001234545)
'==================================================================
Function ShowAnnounce(Byval sChannelID,Byval TopNum,Byval TitleLen,Byval ShowType,Byval DateType)
	On Error Resume Next
	sChannelID	= CLng(sChannelID)
	TopNum		= CLng(TopNum)
	TitleLen	= Clng(TitleLen)
	ShowType	= CLng(ShowType)
	DateType	= CLng(DateType)
	if Err then Err.Clear : ShowAnnounce="ShowAnnounce参数错误。":Exit Function
	On Error GoTo 0
	dim SQL, Rs, i, sTemp
	if TopNum>0 then
		SQL="Select Top " & TopNum & " "
	else
		SQL="Select Top 10 "
	end if
	SQL=SQL & " ID,Title,Content,Author,AddTime from Cl_Announce where IsSelected="&TrueType&" and (ChannelID=-1 or ChannelID=" & sChannelID & ") and (ShowType=0 or ShowType=1) order by ID Desc"
	Set Rs = Cl.Execute(SQL)
	if Rs.bof and Rs.eof then
		ShowAnnounce = "当前没有通告！"
		Rs.Close : Set Rs=Nothing : Exit Function
	end if
	SQL = Rs.GetRows(-1)
	Rs.Close : Set Rs=Nothing
	sTemp = "" : TopNum = Ubound(SQL,2)
	Select Case ShowType
	Case 0
		for i=0 to TopNum
			sTemp = sTemp & "<li><a href="""&Cl.WebDir&"Announce.asp?ChannelID=" & sChannelID & "&amp;ID=" & SQL(0,i) &""" title=""" & Cl.NoHtml(SQL(2,i)) & """ target=""_blank"">" & Cl.GotTopic(SQL(1,i),TitleLen) & "</a></li>"
		next
	Case 1
		for i=0 to TopNum
			sTemp = sTemp & "&nbsp;&nbsp;&nbsp;&nbsp;<a href="""&Cl.WebDir&"Announce.asp?ChannelID=" & sChannelID & "&amp;ID=" & SQL(0,i) &""" title=""" & Cl.NoHtml(SQL(2,i)) & """ target=""_blank"">" & SQL(1,i) & "<br /><div align=""right"">" & SQL(3,i) & "&nbsp;&nbsp;<br />" & Cl.Format_Time(SQL(4,i),DateType) & "</a></div>"
			if i < TopNum then sTemp = sTemp & "<hr />"
		next
	Case 2
		for i=0 to TopNum
			if i>0 then sTemp = sTemp & "&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;"
			sTemp = sTemp & "<a href="""&Cl.WebDir&"Announce.asp?ChannelID=" & sChannelID & "&amp;ID=" & SQL(0,i) &""" title=""" & Cl.NoHtml(SQL(2,i)) & """ target=""_blank"">" & Cl.GotTopic(SQL(1,i),TitleLen) & "&nbsp;&nbsp;[" & Cl.Format_Time(SQL(4,i),DateType) & "]</a>"
		next
	Case 3
		sTemp = "<a href="""&Cl.WebDir&"Announce.asp?ChannelID=" & sChannelID & "&amp;ID=" & SQL(0,TopNum) &""" id=""hottext"" target=""_blank"">" & SQL(1,TopNum) & "</a>" & VbCrlf
		sTemp = sTemp & "<div id=""AllNews"" style=""display:none;"">" & VbCrlf
		for i=0 to TopNum
			sTemp = sTemp & "<div id=""News"&i&""">" & VbCrlf
			sTemp = sTemp & "	<div id=""Summary"&i&""">" & SQL(1,i) & "</div>" & VbCrlf
			sTemp = sTemp & "	<div id=""NewsLink"&i&""">"&Cl.WebDir&"Announce.asp?ChannelID=" & sChannelID & "&amp;ID=" & SQL(0,i) &"</div>" & VbCrlf
			sTemp = sTemp & "</div>" & VbCrlf
		next
		sTemp = sTemp & "</div>" & VbCrlf
		sTemp = sTemp & "<script type=""text/javascript"" src=""{$webdir}Inc/Js/news.js""></script>"
	End Select
	ShowAnnounce = sTemp
	SQL=Empty
End Function

'==================================================================
'过程：OpenAnnounce(sChannelID)
'参数：
'	sChannelID		------  频道ID
'==================================================================
Function OpenAnnounce(Byval sChannelID)
	if Cl.Web_Setting(1)="Yes" Then
	sChannelID = Cl.GetClng(sChannelID)
	Dim popCount,rsAnnounce,strHTML
	set rsAnnounce=Cl.Execute("select count(*) from Cl_Announce where IsSelected="&TrueType&" and (ChannelID=-1 or ChannelID=" & sChannelID & ") and (ShowType=0 or ShowType=2)")
	popCount=rsAnnounce(0)
	if popCount>0 then
		strHTML=Template.GetTemplate(Cl.GetDefaultTemplateID(-1,5,Template.ProjectID))
		strHTML=Replace(strHTML,"{$channelid}",sChannelID)
		strHTML=Replace(strHTML,"{$width}",Split(Cl.Web_Setting(2),"|")(0))
		strHTML=Replace(strHTML,"{$height}",Split(Cl.Web_Setting(2),"|")(1))
		'strHTML="<script type=""text/javascript"">" & strHTML & "</script>"
	else
		strHTML=""
	end if
	OpenAnnounce=strHTML
	end if
End Function

'=========================================================
'ShowLinkSite(sClassID,TopNum,Cols,LinkType,ShowType)
'参数：
'	TopNum		-----	最多显示多少个记录
'	Cols		-----	几列换行
'=========================================================
Function ShowLinkClassMenu(Byval sClassID,Byval TopNum,Byval Cols)
	sClassID	= CLng(sClassID)
	TopNum		= Clng(TopNum)
	Cols		= Clng(Cols)
	Dim TopStr,sTemp
	If TopNum>0 then TopStr = " top " & TopNum
	Dim sqlLink,rsLink,i
	sqlLink = "select "&TopStr&" ClassID,ClassName,Child from Cl_LinkClass Where ParentID="&sClassID&" order by OrderID"
	Set RsLink = Cl.Execute(sqlLink)
	i = 0
	Do While Not RsLink.Eof
		sTemp = sTemp & "<a href='?ClassID="&RsLink("ClassID")&"'>"&RsLink("ClassName")&"</a>"
		If RsLink("Child")>0 Then sTemp = sTemp & "("&RsLink("Child")&")"
		i = i + 1
		If i Mod Cols = 0 Then
			sTemp = sTemp & "<br />"
		Else
			sTemp = sTemp & "&nbsp;&nbsp;"
		End if
		RsLink.MoveNext
	Loop
	ShowLinkClassMenu = sTemp
End Function

'=========================================================
'ShowLinkSite(sClassID,TopNum,Cols,LinkType,ShowType)
'参数：
'	sClassID	-----	分类ID
'	TopNum		-----	最多显示多少个记录
'	Cols		-----	几列换行
'	LinkType	-----	链接方式(1为LOGO，2为文字)
'	ShowType	-----	显示方式(1向上，2横向，3文字下拉)
'=========================================================
Function ShowLinkSite(Byval sClassID,Byval TopNum,Byval Cols,Byval LinkType,Byval ShowType)
	Dim SiteCount,i,strLink,sValue
	On Error Resume Next
	sClassID	= Clng(sClassID)
	TopNum		= Clng(TopNum)
	Cols		= Clng(Cols)
	LinkType	= Clng(LinkType)
	ShowType	= Clng(ShowType)
	if Err then Err.Clear : ShowLinkSite="ShowLinkSite参数错误。":Exit Function
	On Error GoTo 0
	If TopNum=0 then TopNum=10
	Select Case ShowType
	Case 1
		strLink=strLink & "<div id=""rolllink"" style=""overflow:hidden;height:170;width:100""><div id=""rolllink1"">"
		strLink=strLink & "<table width=""100%"" cellSpacing=""5""><tr align=""center"">"
		strLink=strLink & "{$tempvalue}"
		strLink=strLink & "</tr></table>"
		strLink=strLink & "</div><div id=""rolllink2""></div></div>"   '新增代码
		strLink=strLink & vbcrlf & RollFriendLink()    '新增代码
	Case 2
		strLink=strLink & "<table width=""100%"" cellSpacing=""5""><tr align=""center"">"
		strLink=strLink & "{$tempvalue}"
		strLink=strLink & "</tr></table>"
	Case 3
		strLink=strLink & "<select name=""friendlink"" onchange=""if(this.options[this.selectedIndex].value!=''){window.open(this.options[this.selectedIndex].value,'_blank');}""><option value="""">友情文字链接</option>"
		strLink=strLink & "{$tempvalue}"
		strLink=strLink & "</select>"
	End Select
	Dim sqlLink,rsLink

	sqlLink="select top " & TopNum & " ID,LinkType,SiteName,SiteUrl,SiteIntro,LogoUrl from Cl_LinkSite where IsOK="&TrueType&" and LinkType=" & LinkType & " and IsIndex=1 "
	if sClassID>0 then sqlLink=sqlLink & " and ClassID="&sClassID&" "
	sqlLink=sqlLink & " order by IsGood,OrderID Asc, ID Desc"
	set rsLink=Cl.Execute(sqlLink)
	if rsLink.bof and rsLink.eof then
		if ShowType<>3 then
			if LinkType=1 then
				for i=1 to TopNum
					sValue=sValue & "<td><a href=""" & Cl.WebDir & "LinkSite.asp?Action=Reg"" target=""_blank"">"
					sValue=sValue & "<img src=""" & Cl.WebDir & "images/nologo.gif"" width=""88"" height=""31"" border=""0"" alt=""点击申请"" />"
					sValue=sValue & "</a></td>"
					if i mod Cols=0 then sValue=sValue & VbCrlf & "</tr><tr align=""center"">"
				next
			else
				for i=1 to TopNum
					sValue=sValue & "<td><a href=""" & Cl.WebDir & "LinkSite.asp?Action=Reg"" target=""_blank"">点击申请</a></td>"
					if i mod Cols=0 then sValue=sValue & VbCrlf & "</tr><tr align=""center"">"
				next
			end if
		end if
		rsLink.Close:Set rsLink=Nothing
	else
		sqlLink = rsLink.GetRows(-1)
		rsLink.Close:Set rsLink=Nothing
		SiteCount=Ubound(sqlLink,2)
		if ShowType=3 then
			for i = 0 to SiteCount
				sValue=sValue & "<option value=""" & sqlLink(3,i) & """>" & sqlLink(2,i) & "</option>"
			next
		else
			if LinkType=1 then
				for i = 0 to SiteCount
					sValue=sValue & "<td><a href=""" & sqlLink(3,i) & """ target=""_blank"" title=""网站名称：" & sqlLink(2,i) & vbcrlf & "网站地址：" & sqlLink(3,i) & vbcrlf & "网站简介：" & sqlLink(4,i) & """>"
					if sqlLink(5,i)="" or sqlLink(5,i)="http://" then
						sValue=sValue & "<img src=""" & Cl.WebDir & "images/nologo.gif"" width=""88"" height=""31"" border=""0"" alt="""" />"
					else
						sValue=sValue & "<img src=""" & sqlLink(5,i) & """ width=""88"" height=""31"" border=""0"" alt="""" />"
					end if
					sValue=sValue & "</a></td>"
					if (i+1) mod Cols=0 then sValue=sValue & VbCrlf & "</tr><tr align=""center"">"
				next
				if SiteCount < TopNum-1 then
					for i=SiteCount+1 to TopNum-1
						sValue=sValue & "<td><a href=""" & Cl.WebDir & "LinkSite.asp?Action=Reg"" target=""_blank""><img src=""" & Cl.WebDir & "images/nologo.gif"" width=""88"" height=""31"" border=""0"" alt=""点击申请"" /></a></td>"
						if (i+1) mod Cols=0 then sValue=sValue & VbCrlf & "</tr><tr align=""center"">"
					next
				end if
			else
				for i = 0 to SiteCount
					sValue=sValue & "<td><a href=""" & sqlLink(3,i) & """ target=""_blank"" title=""网站名称：" & sqlLink(2,i) & vbcrlf & "网站地址：" & sqlLink(3,i) & vbcrlf & "网站简介：" & sqlLink(4,i) & """>" & sqlLink(2,i) & "</a></td>"
					if (i+1) mod Cols=0 then sValue=sValue & VbCrlf & "</tr><tr align=""center"">"
				next
				if SiteCount < TopNum-1 then
					for i=SiteCount+1 to TopNum-1
						sValue=sValue & "<td><a href=""" & Cl.WebDir & "LinkSite.asp?Action=Reg"" target=""_blank"">点击申请</a></td>"
						if (i+1) mod Cols=0 then sValue=sValue & VbCrlf & "</tr><tr align=""center"">"
					next
				end if
			end if
		end if
		sqlLink=Empty
	end if
	ShowLinkSite=Replace(strLink,"{$tempvalue}",sValue)
End Function
12 3 4 下一页
⌨️ 快捷键说明

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