function.asp

公司企业网站管理系统全站源码,用于企业内部对网站的管理

		response.write "<a href='Shownews.asp?ID=" & rsPrev("ID")& "&BigClass="&BigClass&"' title='新闻标题：" & rsPrev("Title") & vbcrlf & "作    者：" & rsPrev("User") & vbcrlf & "更新时间：" & rsPrev("AddDate") & vbcrlf & "点击次数：" & rsPrev("Hits") &"'>" &gotTopic(rsPrev("Title"),TitleLen)  &"</a>"
	end if
	rsPrev.close
	set rsPrev=nothing
end sub

'=================================================
'过程名：ShowNextNews
'作  用：显示上一篇新闻
'参  数：TitleLen   ----标题最多字符数，一个汉字=两个英文字符
'=================================================
sub ShowNextNews(TitleLen)
	dim rsNext,sqlNext
	sqlNext="Select Top 1 * From News Where BigClassName='"&BigClass&"' and ID>" & rsnews("ID")& " order by ID ASC"
	Set rsNext= Server.CreateObject("ADODB.Recordset")
	rsNext.open sqlNext,conn,1,1
	if TitleLen<0 or TitleLen>255 then TitleLen=50
	if rsNext.Eof then
	 	response.write "没有了"
	else
	  	response.write "<a href='Shownews.asp?ID="&rsNext("ID")& "&BigClass="&BigClass&"' title='新闻标题：" & rsNext("Title") & vbcrlf & "作    者：" & rsNext("User") & vbcrlf & "更新时间：" & rsNext("AddDate") & vbcrlf & "点击次数：" & rsNext("Hits") &"'>" &gotTopic(rsNext("Title"),TitleLen) &"</a>"
	end if
	rsNext.close
	set rsNext=nothing
end sub


'=================================================
'过程名：ShowPrevProduct
'作  用：显示上一个产品
'参  数：TitleLen   ----标题最多字符数，一个汉字=两个英文字符
'=================================================
sub ShowPrevProduct(TitleLen)
	dim rsPrev,sqlPrev
	sqlPrev="Select Top 1 * from Producwyt Where BigClassName='"&rs("BigClassName")&"' and ID<" & rs("ID")& " order by ID DESC"
	Set rsPrev= Server.CreateObject("ADODB.Recordset")
	rsPrev.open sqlPrev,conn,1,1
	if TitleLen<0 or TitleLen>255 then TitleLen=50
	if rsPrev.Eof then
	  	response.write "没有了"
	else
		response.write "<a href='ProductShow.asp?ID=" & rsPrev("ID")& "&BigClass="&rs("BigClassName")&"' title='产品名称：" & rsPrev("Title") & vbcrlf & "更新时间：" & rsPrev("UpdateTime") & vbcrlf & "点击次数：" & rsPrev("Hits") &"'>" &gotTopic(rsPrev("Title"),TitleLen)  &"</a>"
	end if
	rsPrev.close
	set rsPrev=nothing
end sub

'=================================================
'过程名：ShowNextProduct
'作  用：显示上一个产品
'参  数：TitleLen   ----标题最多字符数，一个汉字=两个英文字符
'=================================================
sub ShowNextProduct(TitleLen)
	dim rsNext,sqlNext
	sqlNext="Select Top 1 * from Producwyt Where BigClassName='"&rs("BigClassName")&"' and ID>" & rs("ID")& " order by ID ASC"
	Set rsNext= Server.CreateObject("ADODB.Recordset")
	rsNext.open sqlNext,conn,1,1
	if TitleLen<0 or TitleLen>255 then TitleLen=50
	if rsNext.Eof then
	 	response.write "没有了"
	else
	  	response.write "<a href='ProductShow.asp?ID="&rsNext("ID")& "&BigClass="&rs("BigClassName")&"' title='产品名称：" & rsNext("Title") & vbcrlf & "更新时间：" & rsNext("UpdateTime") & vbcrlf & "点击次数：" & rsNext("Hits") &"'>" &gotTopic(rsNext("Title"),TitleLen) &"</a>"
	end if
	rsNext.close
	set rsNext=nothing
end sub

'==================================================
'过程名：MenuJS
'作  用：生成下拉菜单相关的JS代码
'参  数：无
'==================================================
sub MenuJS()
	response.write "<script type='text/javascript' language='JavaScript1.2' src='Inc/Southidcmenu.js'></script>"
end sub

dim pNum,pNum2
pNum=1
pNum2=0
'=================================================
'过程名：ShowRootClass_Menu
'作  用：显示一级栏目（下拉菜单效果）
'参  数：无
'=================================================
sub ShowRootClass_Menu()
	response.write "<script type='text/javascript' language='JavaScript1.2'>" & vbcrlf & "<!--" & vbcrlf
	response.write "stm_bm(['uueoehr',400,'','images/blank.gif',0,'','',0,0,0,0,0,1,0,0]);" & vbcrlf
	response.write "stm_bp('p0',[0,4,0,0,2,2,0,0,100,'',-2,'',-2,90,0,0,'#000000','transparent','',3,0,0,'#000000']);" & vbcrlf
	response.write "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','#000000','#000000','9pt 宋体','9pt 宋体',0,0]);" & vbcrlf
	response.write "stm_aix('p0i1','p0i0',[0,'首页','','',-1,-1,0,'index.asp ','_self','index.asp','','','',0,0,0,'','',0,0,0,0,1,'#f1f2ee',1,'#cccccc',1,'','',3,3,0,0,'#fffff7','#ff0000','#000000','#cc0000','9pt 宋体','9pt 宋体']);" & vbcrlf
	response.write "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','#000000','#000000','9pt 宋体','9pt 宋体',0,0]);" & vbcrlf

	dim sqlRoot,rsRoot,j
	sqlRoot="select ClassID,ClassName,Depth,NextID,LinkUrl,Child,Readme From MenuClass"
	sqlRoot= sqlRoot & " where Depth=0 and ShowOnTop=True order by RootID"
	Set rsRoot= Server.CreateObject("ADODB.Recordset")
	rsRoot.open sqlRoot,conn,1,1
	if not(rsRoot.bof and rsRoot.eof) then 
		j=3
		do while not rsRoot.eof
			if rsRoot(4)<>"" then
				response.write "stm_aix('p0i"&j&"','p0i0',[0,'" & rsRoot(1) & "','','',-1,-1,0,'" & rsRoot(4) & "','_self','" & rsRoot(4) & "','" & rsRoot(6) & "','','',0,0,0,'','',0,0,0,0,1,'#f1f2ee',1,'#cccccc',1,'','',3,3,0,0,'#fffff7','#ff0000','#000000','#cc0000','9pt 宋体','9pt 宋体']);" & vbcrlf							
			end if
			if rsRoot(5)>0 then
				call GetClassMenu(rsRoot(0),0)
			end if
			j=j+1
			response.write "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','#000000','#000000','9pt 宋体','9pt 宋体',0,0]);" & vbcrlf 			
			j=j+1
			rsRoot.movenext
		loop
	end if
	rsRoot.close
	set rsRoot=nothing
	response.write "stm_em();" & vbcrlf
	response.write "//-->" & vbcrlf & "</script>" & vbcrlf	
end sub

sub GetClassMenu(ID,ShowType)
	dim sqlClass,rsClass,k
	'1,4,0,4,2,3,6,7,100前4个数字控制菜单位置和大小
	if pNum=1 then
		response.write "stm_bp('p" & pNum & "',[1,4,0,4,2,3,6,7,100,'progid:DXImageTransform.Microsoft.Fade(overlap=.5,enabled=0,Duration=0.43)',-2,'',-2,67,2,3,'#999999','#EBEBEB','',3,1,1,'#aca899']);" & vbcrlf
	else
		if ShowType=0 then
			response.write "stm_bpx('p" & pNum & "','p" & pNum2 & "',[1,4,0,0,2,3,6]);" & vbcrlf
		else
			response.write "stm_bpx('p" & pNum & "','p" & pNum2 & "',[1,2,-2,-3,2,3,0]);" & vbcrlf
		end if
	end if
	
	k=0
	sqlClass="select ClassID,ClassName,Depth,NextID,LinkUrl,Child,Readme From MenuClass"
	sqlClass= sqlClass & " where ParentID=" & ID & " order by OrderID asc"
	Set rsClass= Server.CreateObject("ADODB.Recordset")
	rsClass.open sqlClass,conn,1,1
	do while not rsClass.eof
		if rsClass(4)<>"" then
			if rsClass(5)>0 then
				response.write "stm_aix('p"&pNum&"i"&k&"','p"&pNum2&"i0',[0,'" & rsClass(1) & "','','',-1,-1,0,'" & rsClass(4) & "','_self','" & rsClass(4) & "','" & rsClass(6) & "','','',6,0,0,'images/arrow_r.gif','images/arrow_w.gif',7,7,0,0,1,'#FFFFFF',0,'#cccccc',0,'','',3,3,0,0,'#fffff7','#ff0000','#000000','#cc0000','9pt 宋体']);" & vbcrlf
				pNum=pNum+1
				pNum2=pNum2+1
				call GetClassMenu(rsClass(0),1)
			else
				response.write "stm_aix('p"&pNum&"i"&k&"','p"&pNum2&"i0',[0,'" & rsClass(1) & "','','',-1,-1,0,'" & rsClass(4) & "','_self','" & rsClass(4) & "','" & rsClass(6) & "','','',0,0,0,'','',0,0,0,0,1,'#f1f2ee',1,'#FFFFFF',0,'','',3,3,0,0,'#fffff7','#ff0000','#000000','#cc0000','9pt 宋体']);" & vbcrlf
			end if			
		end if
		k=k+1
		rsClass.movenext
	loop
	rsClass.close
	set rsClass=nothing
	response.write "stm_ep();" & vbcrlf	
end sub



'==================================================
'过程名：ShowAnnounce
'作  用：显示本站公告信息
'        AnnounceNum  ----最多显示多少条公告
'==================================================
sub ShowAnnounce(AnnounceNum)
	dim sqlAnnounce,rsAnnounce,i
	if AnnounceNum>0 and AnnounceNum<=10 then
		sqlAnnounce="select top " & AnnounceNum
	else
		sqlAnnounce="select top 10"
	end if
	sqlAnnounce=sqlAnnounce & " * from affiche order by ID Desc"	
	Set rsAnnounce= Server.CreateObject("ADODB.Recordset")
	rsAnnounce.open sqlAnnounce,conn,1,1
	if rsAnnounce.bof and rsAnnounce.eof then 
		AnnounceCount=0
		response.write "<p>&nbsp;&nbsp;没有公告</p>" 
	else 
		AnnounceCount=rsAnnounce.recordcount		
			response.Write "本站公告："
			do while not rsAnnounce.eof   
				response.Write "&nbsp;<a href='#' onclick=""javascript:window.open('Affiche.asp?ID=" & rsAnnounce("id") &"', 'newwindow', 'height=450, width=400, toolbar=no, menubar=no, scrollbars=auto, resizable=no, location=no, status=no')"" title='" & rsAnnounce("Content") & "'><font color='#FF0000'>" &rsAnnounce("title") & "</font></a>"
				rsAnnounce.movenext
				i=i+1				  
			loop       		
	end if  
	rsAnnounce.close
	set rsAnnounce=nothing
end sub

'==================================================
'过程名：ShowFriendLinks
'作  用：显示友情链接站点
'参  数：LinkType  ----链接方式，1为LOGO链接，2为文字链接
'       SiteNum   ----最多显示多少个站点
'       Cols      ----分几列显示
'       ShowType  ----显示方式。1为向上滚动，2为横向列表，3为下拉列表框
'==================================================
sub ShowFriendLinks(LinkType,SiteNum,Cols,ShowType)
	dim sqlLink,rsLink,SiteCount,i,strLink
	if LinkType<>1 and LinkType<>2 then
		LinkType=1
	else
		LinkType=Cint(LinkType)
	end if
	if SiteNum<=0 or SiteNum>100 then
		SiteNum=10
	end if
	if Cols<=0 or Cols>20 then
		Cols=10
	end if
	if ShowType=1 then'
        strLink=strLink & "<div id=rolllink style=overflow:hidden;height:100;width:100><div id=rolllink1>"    '新增加的代码
	elseif ShowType=3 then
		strLink=strLink & "<select name='FriendSite' onchange=""if(this.options[this.selectedIndex].value!=''){window.open(this.options[this.selectedIndex].value,'_blank');}""><option value=''>友情文字链接站点</option>"
	end if
	if ShowType=1 or ShowType=2 then
		strLink=strLink & "<table width='100%' cellSpacing='5'><tr align='center' >"
	end if
	
	sqlLink="select top " & SiteNum & " * from FriendLinks where IsOK=True and LinkType=" & LinkType & " order by IsGood,id desc"
	set rsLink=server.createobject("adodb.recordset")
	rsLink.open sqlLink,conn,1,1
	if rsLink.bof and rsLink.eof then
		if ShowType=1 or ShowType=2 then
	  		for i=1 to SiteNum
				strLink=strLink & "<td>"			
				strLink=strLink & "</td>"
				if i mod Cols=0 and i<SiteNum then
					strLink=strLink & "</tr><tr align='center' >"
				end if
			next
		end if
	else
		SiteCount=rsLink.recordcount
		for i=1 to SiteCount
			if ShowType=1 or ShowType=2 then
			  if LinkType=1 then
				strLink=strLink & "<td width='88'><a href='" & rsLink("SiteUrl") & "' target='_blank' title='网站名称：" & rsLink("SiteName") & vbcrlf & "网站地址：" & rsLink("SiteUrl") & vbcrlf & "网站简介：" & rsLink("SiteIntro") & "'>"
				if rsLink("LogoUrl")="" or rsLink("LogoUrl")="http://" then
					strLink=strLink & "<img src='images/nologo.gif' width='88' height='31' border='0'>"
				else
					strLink=strLink & "<img src='" & rsLink("LogoUrl") & "' width='88' height='31' border='0'>"
				end if
				strLink=strLink & "</a></td>"
			  else
				strLink=strLink & "<td width='88'><a href='" & rsLink("SiteUrl") & "' target='_blank' title='网站名称：" & rsLink("SiteName") & vbcrlf & "网站地址：" & rsLink("SiteUrl") & vbcrlf & "网站简介：" & rsLink("SiteIntro") & "'>" & rsLink("SiteName") & "</a></td>"
			  end if
			  if i mod Cols=0 and i<SiteNum then
				strLink=strLink & "</tr><tr align='center' >"
			  end if
			else
				strLink=strLink & "<option value='" & rsLink("SiteUrl") & "'>" & rsLink("SiteName") & "</option>"
			end if
			rsLink.moveNext
		next
		if SiteCount<SiteNum and (ShowType=1 or ShowType=2) then
			for i=SiteCount+1 to SiteNum
				if LinkType=1 then
					strLink=strLink & "<td width='88'></td>"
				else
					strLink=strLink & "<td width='88'></td>"
				end if
				if i mod Cols=0 and i<SiteNum then
					strLink=strLink & "</tr><tr align='center' >"
				end if
			next
		end if
	end if
	if ShowType=1 or ShowType=2 then
		strLink=strLink & "</tr></table>"
	end if
	if ShowType=1 then
        strLink=strLink & "</div><div id=rolllink2></div></div>"   '新增代码
	elseif ShowType=3 then
		strLink=strLink & "</select>"
	end if
	response.write strLink
	if ShowType=1 then call RollFriendLinks()    '新增代码
	rsLink.close
	set rsLink=nothing
end sub

'==================================================
'过程名：RollFriendLinks
'作  用：滚动显示友情链接站点
'参  数：无
'==================================================
sub RollFriendLinks()
%>
<script>
   var rollspeed=30
   rolllink2.innerHTML=rolllink1.innerHTML //克隆rolllink1为rolllink2
   function Marquee(){
   if(rolllink2.offsetTop-rolllink.scrollTop<=0) //当滚动至rolllink1与rolllink2交界时
   rolllink.scrollTop-=rolllink1.offsetHeight  //rolllink跳到最顶端
   else{
   rolllink.scrollTop++
   }
   }
   var MyMar=setInterval(Marquee,rollspeed) //设置定时器
   rolllink.onmouseover=function() {clearInterval(MyMar)}//鼠标移上时清除定时器达到滚动停止的目的
   rolllink.onmouseout=function() {MyMar=setInterval(Marquee,rollspeed)}//鼠标移开时重设定时器
</script>
<%
end sub
%>