syscode.asp

三鸟个人网站源码。

				strPic=strPic & "<td align='center'>"
				call GetPicArticleTitle(TitleLen,ImgWidth,ImgHeight)
				strPic=strPic & "</td>"
				rsPic.movenext
				i=i+1
				if ((i mod Cols=0) and (not rsPic.eof)) then strPic=strPic & "</tr><tr valign='top'>"
			loop
		elseif ShowType=2 then
			do while not rsPic.eof
				strPic=strPic & "<td align='center'>"
				call GetPicArticleTitle(TitleLen,ImgWidth,ImgHeight)
				strPic=strPic & "</td><td valign='top' algin='center' class='left'><a href='" & rsPic("LayoutFileName") & "?ArticleID=" & rsPic("ArticleID") & "'>" & left(nohtml(rsPic("Content")),ContentLen) & "……</a></td>"
				rsPic.movenext
				i=i+1
				if ((i mod Cols=0) and (not rsPic.eof)) then strPic=strPic & "</tr><tr valign='top'>"
			loop
		end if
		
	end if
	strPic=strPic &  "</tr></table>"
	response.write strPic
	rsPic.close
end sub

'=================================================
'过程名：GetPicArticleTitle
'作  用：显示图片文章的标题
'参  数：intTitleLen  ----标题最多字符数，一个汉字=两个英文字符
'        intImgWidth   ----图片宽度
'        intImgHeight  ----图片高度
'=================================================
sub GetPicArticleTitle(intTitleLen,intImgWidth,intImgHeight)
	dim FileType,TitleStr
	FileType=right(lcase(rsPic("DefaultPicUrl")),3)
	TitleStr=gotTopic(rsPic("Title"),intTitleLen)
	strPic=strPic & "<a href='" & rsPic("LayoutFileName") & "?ArticleID=" & rsPic("ArticleID") & "' title='文章标题：" & rsPic("Title") & vbcrlf & "作    者：" & rsPic("Author") & vbcrlf & "更新时间：" & rsPic("UpdateTime") & vbcrlf & "点击次数：" & rsPic("Hits") & "' target='_blank'>"
	if FileType="swf" then
		strPic=strPic & "<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='" & intImgWidth & "' height='" & intImgHeight & "'><param name='movie' value='" & rsPic("DefaultPicUrl") & "'><param name='quality' value='high'><embed src='" & rsPic("DefaultPicUrl") & "' pluginspage='http://www.macromedia.com/shockwave/download/index.cgi?P1_Prod_Version=ShockwaveFlash' type='application/x-shockwave-flash' width='" & intImgWidth & "' height='" & intImgHeight & "'></embed></object>"
	elseif fileType="jpg" or fileType="bmp" or fileType="png" or fileType="gif" then
		strPic=strPic & "<img src='" & rsPic("DefaultPicUrl") & "' width='" & intImgWidth & "' height='" & intImgHeight & "' border='0'>"
	else
		strPic=strPic & "<img src='images/NoPic.jpg2' width='" & intImgWidth & "' height='" & intImgHeight & "' border='0'>"
	end if
	if rsPic("TitleFontType")=1 then
		TitleStr="<b>" & TitleStr & "</b>"
	elseif rsPic("TitleFontType")=2 then
		TitleStr="<em>" & TitleStr & "</em>"
	elseif rsPic("TitleFontType")=3 then
		TitleStr="<b><em>" & TitleStr & "</em></b>"
	end if
	if rsPic("TitleFontColor")<>"" then
		TitleStr="<font color='" & rsPic("TitleFontColor") & "'>" & TitleStr & "</font>"
	end if
	strPic=strPic & "<br>" & TitleStr & "</a>"
end sub

'=================================================
'过程名：MenuJS
'作  用：生成下拉菜单相关的JS代码
'参  数：无
'=================================================
sub MenuJS()
%>
<script language="JavaScript" type="text/JavaScript">
//下拉菜单相关代码
 var h;
 var w;
 var l;
 var t;
 var topMar = 1;
 var leftMar = -2;
 var space = 1;
 var isvisible;
 var MENU_SHADOW_COLOR='#999999';//定义下拉菜单阴影色
 var global = window.document
 global.fo_currentMenu = null
 global.fo_shadows = new Array

function HideMenu() 
{
 var mX;
 var mY;
 var vDiv;
 var mDiv;
	if (isvisible == true)
{
		vDiv = document.all("menuDiv");
		mX = window.event.clientX + document.body.scrollLeft;
		mY = window.event.clientY + document.body.scrollTop;
		if ((mX < parseInt(vDiv.style.left)) || (mX > parseInt(vDiv.style.left)+vDiv.offsetWidth) || (mY < parseInt(vDiv.style.top)-h) || (mY > parseInt(vDiv.style.top)+vDiv.offsetHeight)){
			vDiv.style.visibility = "hidden";
			isvisible = false;
		}
}
}

function ShowMenu(vMnuCode,tWidth) {
	vSrc = window.event.srcElement;
	vMnuCode = "<table id='submenu' cellspacing=1 cellpadding=3 style='width:"+tWidth+"' class=menu onmouseout='HideMenu()'><tr height=23><td nowrap align=left class=MenuBody>" + vMnuCode + "</td></tr></table>";

	h = vSrc.offsetHeight;
	w = vSrc.offsetWidth;
	l = vSrc.offsetLeft + leftMar+4;
	t = vSrc.offsetTop + topMar + h + space-2;
	vParent = vSrc.offsetParent;
	while (vParent.tagName.toUpperCase() != "BODY")
	{
		l += vParent.offsetLeft;
		t += vParent.offsetTop;
		vParent = vParent.offsetParent;
	}

	menuDiv.innerHTML = vMnuCode;
	menuDiv.style.top = t;
	menuDiv.style.left = l;
	menuDiv.style.visibility = "visible";
	isvisible = true;
    makeRectangularDropShadow(submenu, MENU_SHADOW_COLOR, 4)
}

function makeRectangularDropShadow(el, color, size)
{
	var i;
	for (i=size; i>0; i--)
	{
		var rect = document.createElement('div');
		var rs = rect.style
		rs.position = 'absolute';
		rs.left = (el.style.posLeft + i) + 'px';
		rs.top = (el.style.posTop + i) + 'px';
		rs.width = el.offsetWidth + 'px';
		rs.height = el.offsetHeight + 'px';
		rs.zIndex = el.style.zIndex - i;
		rs.backgroundColor = color;
		var opacity = 1 - i / (i + 1);
		rs.filter = 'alpha(opacity=' + (100 * opacity) + ')';
		el.insertAdjacentElement('afterEnd', rect);
		global.fo_shadows[global.fo_shadows.length] = rect;
	}
}
</script>
<%
	response.write "<script language='JavaScript' type='text/JavaScript'>" & vbcrlf
	response.write "//菜单列表" & vbcrlf

	dim arrShowLine(20)
	for i=0 to ubound(arrShowLine)
		arrShowLine(i)=False
	next
	
	dim sqlMenu,rsMenu,strMenu,PrevRootID,tmpDepth,i
	sqlMenu="select C.ClassID,C.ClassName,C.RootID,L.LayoutFileName,C.LinkUrl,C.Child,C.Depth,C.NextID From ArticleClass C"
	sqlMenu= sqlMenu & " inner join Layout L on C.LayoutID=L.LayoutID where C.Depth>=1 order by C.RootID,C.OrderID"
	Set rsMenu= Server.CreateObject("ADODB.Recordset")
	rsMenu.open sqlMenu,conn,1,1
	PrevRootID=0
	if not(rsMenu.bof and rsMenu.eof) then
		tmpDepth=rsMenu(6)
		if rsMenu(7)>0 then
			arrShowLine(tmpDepth)=True
		else
			arrShowLine(tmpDepth)=False
		end if
		strMenu="var menu" & rsMenu(2) & "=" & chr(34)

		for i=1 to tmpDepth
			if i=tmpDepth then
				if rsMenu(7)>0 then
					strMenu=strMenu & "<img src='images/tree_line1.gif' width='17' height='16' valign='abvmiddle'>"
				else
					strMenu=strMenu & "<img src='images/tree_line2.gif' width='17' height='16' valign='abvmiddle'>"
				end if
			else
				if arrShowLine(i)=True then
					strMenu=strMenu & "<img src='images/tree_line3.gif' width='17' height='16' valign='abvmiddle'>"
				else
					strMenu=strMenu & "<img src='images/tree_line4.gif' width='17' height='16' valign='abvmiddle'>"
				end if
			end if
		next
		if rsMenu(5)>0 then 
			strMenu=strMenu & "<img src='Images/tree_folder4.gif' width='15' height='15' valign='abvmiddle'>" 
		else 
			strMenu=strMenu & "<img src='Images/tree_folder3.gif' width='15' height='15' valign='abvmiddle'>" 
		end if 
			
		if rsMenu(4)<>"" then
			strMenu=strMenu & "<a style=font-size:9pt;line-height:14pt; href='" & rsMenu(4) & "'>" & rsMenu(1) & "</a><br>"
		else
			strMenu=strMenu & "<a style=font-size:9pt;line-height:14pt; href='" & rsMenu(3) & "?ClassID=" & rsMenu(0) & "'>" & rsMenu(1) & "</a><br>"
		end if
			
		PrevRootID=rsMenu(2)
		rsMenu.movenext
		do while not rsMenu.eof
			if rsMenu(2)<>PrevRootID then
				strMenu=strMenu & chr(34) & ";" & vbcrlf & "var menu" & rsMenu(2) & "=" & chr(34)
			end if

			tmpDepth=rsMenu(6)
			if rsMenu(7)>0 then
				arrShowLine(tmpDepth)=True
			else
				arrShowLine(tmpDepth)=False
			end if
			for i=1 to tmpDepth
				if i=tmpDepth then
					if rsMenu(7)>0 then
						strMenu=strMenu & "<img src='images/tree_line1.gif' width='17' height='16' valign='abvmiddle'>"
					else
						strMenu=strMenu & "<img src='images/tree_line2.gif' width='17' height='16' valign='abvmiddle'>"
					end if
				else
					if arrShowLine(i)=True then
						strMenu=strMenu & "<img src='images/tree_line3.gif' width='17' height='16' valign='abvmiddle'>"
					else
						strMenu=strMenu & "<img src='images/tree_line4.gif' width='17' height='16' valign='abvmiddle'>"
					end if
				end if
			next
			if rsMenu(5)>0 then 
				strMenu=strMenu & "<img src='Images/tree_folder4.gif' width='15' height='15' valign='abvmiddle'>" 
			else 
				strMenu=strMenu & "<img src='Images/tree_folder3.gif' width='15' height='15' valign='abvmiddle'>" 
			end if 
			
			if rsMenu(4)<>"" then
				strMenu=strMenu & "<a style=font-size:9pt;line-height:14pt; href='" & rsMenu(4) & "' target='_blank'>" & rsMenu(1) & "</a>"
			else
				strMenu=strMenu & "<a style=font-size:9pt;line-height:14pt; href='" & rsMenu(3) & "?ClassID=" & rsMenu(0) & "'>" & rsMenu(1) & "</a>"
			end if
			strMenu=strMenu & "<br>"
			
			PrevRootID=rsMenu(2)
			rsMenu.movenext
		loop
		strMenu=strMenu & chr(34) & ";" & vbcrlf
		response.write strMenu
	end if
	rsMenu.close
	set rsMenu=nothing
	
	if ShowMyStyle="Yes" then
		'自选风格的菜单定义
		strMenu="var menu_skin=" & chr(34)
		dim rsSkin
		set rsSkin=conn.execute("select SkinID,SkinName from Skin")
		do while not rsSkin.eof
			strMenu=strMenu & "&nbsp;<a style=font-size:9pt;line-height:14pt; href='SetCookie.asp?Action=SetSkin&ClassID=" & ClassID & "&SkinID=" & rsSkin(0) & "'>" & rsSkin(1) & "</a><br>"
			rsSkin.movenext
		loop
		rsSkin.close
		set rsSkin=nothing
		response.write strMenu & chr(34) & ";" & vbcrlf
	end if
	response.write "</script>" & vbcrlf
end sub


'=================================================
'过程名：PopAnnouceWindow
'作  用：弹出公告窗口
'参  数：无
'=================================================
sub PopAnnouceWindow(Width,Height)
	if AnnounceCount>0 and PopAnnounce="Yes" and session("Poped")="" then
		response.write "<script LANGUAGE='JavaScript'>"
		response.write "window.open ('Announce.asp', 'newwindow', 'height=" & Height & ", width=" & Width & ", toolbar=no, menubar=no, scrollbars=auto, resizable=no, location=no, status=no')"
		response.write "</script>"
		session("Poped")="Yes"
	end if
end sub

'=================================================
'过程名：ShowArticleContent
'作  用：显示文章具体的内容，可以分页显示
'参  数：无
'=================================================
sub ShowArticleContent()
	dim PaginationType
	PaginationType=rs("PaginationType")
	select case PaginationType
		case 0    '不分页显示
			response.write rs("Content")
		case 1    '自动分页显示
			call AutoPagination()
		case 2    '手动分页显示
			call ManualPagination()
	end select
end sub

'=================================================
'过程名：ManualPagination
'作  用：采用手动分页方式显示文章具体的内容
'参  数：无
'=================================================
sub ManualPagination()
	dim ArticleID,strContent,CurrentPage
	dim ContentLen,MaxPerPage,pages,i
	dim arrContent
	ArticleID=rs("ArticleID")
	strContent=rs("Content")
	ContentLen=len(strContent)
	CurrentPage=trim(request("ArticlePage"))
	if Instr(strContent,"[NextPage]")<=0 then
		response.write strContent
		response.write "</p><p align='center'><font color='red'><b>[1]</b></font></p>"
	else
		arrContent=split(strContent,"[NextPage]")

		pages=Ubound(arrContent)+1
		if CurrentPage="" then
			CurrentPage=1
		else
			CurrentPage=Cint(CurrentPage)
		end if
		if CurrentPage<1 then CurrentPage=1
		if CurrentPage>pages then CurrentPage=pages

		response.write arrContent(CurrentPage-1)

		response.write "</p><p align='center'><b>"