harry.asp

为我们公司使用的oa系统

<%
function ReplaceBadChar(strChar)
	if strChar="" then
		ReplaceBadChar=""
	else
		ReplaceBadChar=replace(replace(replace(replace(replace(replace(replace(strChar,"'",""),"*",""),"?",""),"(",""),")",""),"<",""),".","")
	end if
end function

sub ShowUserLogin()
	dim strLogin
	if CheckUserLogined()=False then
    	strLogin="<table align='center' width='100%' border='0' cellspacing='0' cellpadding='0'>" & vbcrlf
		strLogin=strLogin &  "<form action='User_ChkLogin.asp' method='post' name='UserLogin' onSubmit='return CheckForm();'>" & vbcrlf
        strLogin=strLogin & "<tr><td height='25' align='right'>用户名：</td><td height='25'><input name='UserName' type='text' id='UserName' size='10' maxlength='20'></td></tr>" & vbcrlf
        strLogin=strLogin & "<tr><td height='25' align='right'>密&nbsp;&nbsp;码：</td><td height='25'><input name='Password' type='password' id='Password' size='10' maxlength='20'></td></tr>" & vbcrlf
        strLogin=strLogin & "<tr><td height='25' align='right'>Cookie：</td><td height='25'><select name=CookieDate><option selected value=0>不保存</option><option value=1>保存一天</option>" & vbcrlf
		strLogin=strLogin & "<option value=2>保存一月</option><option value=3>保存一年</option></select></td></tr>" & vbcrlf
		strLogin=strLogin & "<tr align='center'><td height='30' colspan='2'><input name='Login' type='submit' id='Login' value=' 登录 ' class='input'> <input name='Reset' type='reset' id='Reset' value=' 清除 ' class='input'>" & vbcrlf
        strLogin=strLogin & "<br><br><a href='User_Reg.asp' target='_blank'>新用户注册</a>&nbsp;&nbsp;<a href='User_GetPassword.asp'>忘记密码？</a><br></td>" & vbcrlf      
        strLogin=strLogin & "</tr></form></table>" & vbcrlf
		response.write strLogin
%>
<script language=javascript>
	function CheckForm()
	{
		if(document.UserLogin.UserName.value=="")
		{
			alert("请输入用户名！");
			document.UserLogin.UserName.focus();
			return false;
		}
		if(document.UserLogin.Password.value == "")
		{
			alert("请输入密码！");
			document.UserLogin.Password.focus();
			return false;
		}
	}
	function openScript(url, width, height)
	{
		var Win = window.open(url,"UserControlPad",'width=' + width + ',height=' + height + ',resizable=1,scrollbars=yes,menubar=yes,status=yes' );
	}
</script>
<%
	Else 
		response.write "欢迎您！<font color=green><b>" & UserName & "</b></font>，好久不见！"
		response.write "<br>您的身份："
		if UserLevel=999 then
			response.write "注册用户"
		elseif UserLevel=99 then
			response.write "收费用户"
		elseif UserLevel=9 then
			response.write "VIP用户"
		end if
		response.write "<br>计费方式："
		if ChargeType=1 then
			if UserPoint>0 then
				response.write "扣点数<br>可用点数： <b><font color=blue>" & UserPoint & "</font></b> 点"
				if UserPoint<=10 then
					response.write "<br><font color=red>你的可用点数已不多，请及时联系我们进行充值！</font>"
				end if
			else
				response.write "扣点数<br>可用点数： <b><font color=red>" & UserPoint & "</font></b> 点"
				response.write "<br><font color=red>你的可用点数已经用完，请联系我们进行充值，否则你将不能阅读收费内容。</font>"
			end if
		else
			if ValidDays>0 then
				response.write "有效期<br>有效天数： <b><font color=blue>" & ValidDays & "</font></b> 天"
				if ValidDays<=10 then
					response.write "<br><font color=red>你的有效期时间已不长，请及时联系我们进行充值！</font>"
				end if
			else
				response.write "有效期<br>有效天数： <b><font color=red>" & ValidDays & "</font></b> 天"
				response.write "<br><font color=red>你的有效期已经过期，请联系我们进行充值，否则你将不能阅读收费内容。</font>"
			end if
		end if
		response.write "<br><b>用户控制面板：</b><br>" & vbcrlf
		response.write "<div align='center'><a href='/bbs'>【进入论坛】</a></div>" & vbcrlf
		response.write "&nbsp;&nbsp;&nbsp;<a href=""JavaScript:openScript('User_ControlPad.asp?Action=ModifyPwd')"">修改密码</a>" & vbcrlf
		response.write "&nbsp;&nbsp;<a href=""JavaScript:openScript('User_ControlPad.asp?Action=ModifyInfo')"">个人信息</a><br>" & vbcrlf
		response.write "<div align='center'><a href='User_Logout.asp'>【注销登录】</a></div>" & vbcrlf
	end if
%>
<script language=javascript>
	function openScript(url)
	{
		var Win = window.open(url,"UserControlPad");
	}
	function openScript2(url, width, height)
	{
		var Win = window.open(url,"UserControlPad",'width=' + width + ',height=' + height + ',resizable=1,scrollbars=yes,menubar=yes,status=yes' );
	}
</script>
<%
end sub

sub PopAnnouceWindow(Width,Height)
	dim popCount,rsAnnounce
	set rsAnnounce=conn.execute("select count(*) from Announce where IsSelected=1 and (ChannelID=0 or ChannelID=" & ChannelID & ") and (ShowType=0 or ShowType=2)")
	popCount=rsAnnounce(0)
	if popCount>0 then
		if  PopAnnounce="Yes" and session("Poped")<>ChannelID then
			response.write "<script LANGUAGE='JavaScript'>"
			response.write "window.open ('Announce.asp?ChannelID=" & ChannelID & "', 'newwindow', 'height=" & Height & ", width=" & Width & ", toolbar=no, menubar=no, scrollbars=auto, resizable=no, location=no, status=no')"
			response.write "</script>"
			session("Poped")=ChannelID
		end if
	end if
end sub

sub ShowPath()
	if PageTitle<>"" and ChannelID<>1 then
		strPath= strPath & "&nbsp;&gt;&gt;&nbsp;" & PageTitle
	end if
	response.write strPath
end sub

sub ShowChildClass(ShowType)
	dim sqlChild,rsChild,i
	sqlChild="select C.ClassID,C.ClassName,C.Depth,L.LayoutFileName,C.NextID,C.LinkUrl,C.Child From ArticleClass C"
	sqlChild= sqlChild & " inner join Layout L on C.LayoutID=L.LayoutID where C.ParentID=" & ClassID & " order by C.OrderID"
	Set rsChild= Server.CreateObject("ADODB.Recordset")
	rsChild.open sqlChild,conn,1,1
	if rsChild.bof and rsChild.eof then
		response.write "没有任何子栏目"
	else
		if ShowType=1 then
			do while not rsChild.eof
				if rsChild(5)<>"" then
					response.write "<li><a href='" & rsChild(5) & "'>" & rsChild(1) & "</a></li>"
				else
					response.Write "<li><a href='" & rsChild(3) & "?ClassID=" & rsChild(0) & "'>" & rsChild(1) & "</a></li>"
				end if
				if rsChild(6)>0 then
					response.write "(" & rsChild(6) & ")"
				end if
				response.write "<br>"		
				rsChild.movenext
			loop
		else
			i=0
			do while not rsChild.eof
				if rsChild(5)<>"" then
					response.write "&nbsp;&nbsp;<a href='" & rsChild(5) & "'>" & rsChild(1) & "</a>"
				else
					response.Write "&nbsp;&nbsp;<a href='" & rsChild(3) & "?ClassID=" & rsChild(0) & "'>" & rsChild(1) & "</a>"
				end if
				if rsChild(6)>0 then
					response.write "(" & rsChild(6) & ")"
				end if		
				rsChild.movenext
				i=i+1
				if i mod 5=0 then
					response.write "<br>"
				end if
			loop
		end if
	end if
	rsChild.close
	set rsChild=nothing
end sub

sub ShowClassNavigation()
	dim rsNavigation,sqlNavigation,strNavigation,PrevRootID,i
	sqlNavigation="select C.ClassID,C.ClassName,C.Depth,L.LayoutFileName,C.RootID,C.LinkUrl,C.Child,C.Readme From ArticleClass C"
	sqlNavigation= sqlNavigation & " inner join Layout L on C.LayoutID=L.LayoutID where C.Depth<=1 order by C.RootID,C.OrderID"
	Set rsNavigation= Server.CreateObject("ADODB.Recordset")
	rsNavigation.open sqlNavigation,conn,1,1
	if rsNavigation.bof and rsNavigation.eof then
		response.write "没有任何栏目"
	else
		strNavigation="<table border='0' cellpadding='0' cellspacing='2'><tr><td valign='top' nowrap>【<a href='" & rsNavigation(3) & "?ClassID=" & rsNavigation(0) & "' title='" & rsNavigation(7) & "'>" & rsNavigation(1) & "</a>】</td><td>"
		PrevRootID=rsNavigation(4)
		rsNavigation.movenext
		i=1
		do while not rsNavigation.eof
			if PrevRootID=rsNavigation(4) then
				if i mod 6=0 then
					strNavigation=strNavigation & "<br>"
				end if
				strNavigation=strNavigation & "<a href='" & rsNavigation(3) & "?ClassID=" & rsNavigation(0) & "' title='" & rsNavigation(7) & "'>" & rsNavigation(1) & "</a>&nbsp;&nbsp;"
				i=i+1
			else
				strNavigation=strNavigation & "</td></tr><tr><td valign='top' nowrap>【<a href='" & rsNavigation(3) & "?ClassID=" & rsNavigation(0) & "' title='" & rsNavigation(7) & "'>" & rsNavigation(1) & "</a>】</td><td>"
				i=1
			end if
			PrevRootID=rsNavigation(4)
			rsNavigation.movenext
		loop
		strNavigation=strNavigation & "</td></tr></table>"
		response.write strNavigation
	end if
	rsNavigation.close
	set rsNavigation=nothing
end sub

sub ShowArticleTitle(CID,TitleLen,TopNum)
	if TitleLen<0 or TitleLen>200 then
		TitleLen=50
	end if

	sqlArticle="select Top "&TopNum&"   A.ArticleID,A.ClassID,L.LayoutID,L.LayoutFileName,A.Title,A.Keywords,A.Author,A.CopyFrom,A.UpdateTime,A.Editor,A.TitleFontColor,A.TitleFontType,"
	sqlArticle=sqlArticle & "A.Hits,A.OnTop,A.Hot,A.Elite,A.Passed,A.IncludePic,A.Stars,A.PaginationType,A.ReadLevel,A.ReadPoint,A.DefaultPicUrl,A.http from Article A"
	sqlArticle=sqlArticle & " inner join Layout L on A.LayoutID=L.LayoutID where A.Deleted=0 and A.Passed=1 "
	if SpecialID>0 then
		sqlArticle=sqlArticle & " and A.SpecialID=" & SpecialID
	end if
	if CID>0 then
		sqlArticle=sqlArticle &  " and A.ClassID=" & CID
	end if
	sqlArticle=sqlArticle & " order by A.OnTop,A.ArticleID desc"
	Set rsArticle= Server.CreateObject("ADODB.Recordset")
	rsArticle.open sqlArticle,conn,1,1
	if rsArticle.bof and  rsArticle.eof then
		totalput=0
		response.Write("<br><li>没有任何文章</li>")
	else
		totalput=rsArticle.recordcount
		if currentpage<1 then
			currentpage=1
		end if
		if (currentpage-1)*MaxPerPage>totalput then
			if (totalPut mod MaxPerPage)=0 then
				currentpage= totalPut \ MaxPerPage
			else
				currentpage= totalPut \ MaxPerPage + 1
			end if
		end if

		if currentPage=1 then
			call ArticleContent(TitleLen,True,True,False,0,False,True)
		else
			if (currentPage-1)*MaxPerPage<totalPut then
         	   	rsArticle.move  (currentPage-1)*MaxPerPage
         		dim bookmark
           		bookmark=rsArticle.bookmark
            	call ArticleContent(TitleLen,True,True,False,0,False,True)
        	else
	        	currentPage=1
           		call ArticleContent(TitleLen,True,True,False,0,False,True)
	    	end if
		end if
	end if
	rsArticle.close
	set rsArticle=nothing
end sub


sub ShowArticle(TitleLen)
	if TitleLen<0 or TitleLen>200 then
		TitleLen=50
	end if

	sqlArticle=sqlArticle & "select  A.ArticleID,A.ClassID,L.LayoutID,L.LayoutFileName,A.Title,A.Keywords,A.Author,A.CopyFrom,A.UpdateTime,A.Editor,A.TitleFontColor,A.TitleFontType,"
	sqlArticle=sqlArticle & "A.Hits,A.OnTop,A.Hot,A.Elite,A.Passed,A.IncludePic,A.Stars,A.PaginationType,A.ReadLevel,A.ReadPoint,A.DefaultPicUrl,A.http from Article A"
	sqlArticle=sqlArticle & " inner join Layout L on A.LayoutID=L.LayoutID where A.Deleted=0 and A.Passed=1 "
	if SpecialID>0 then
		sqlArticle=sqlArticle & " and A.SpecialID=" & SpecialID
	end if
	if ClassId>0 then
		sqlArticle=sqlArticle &  " and A.ClassID=" & ClassID
	end if
	sqlArticle=sqlArticle & " order by A.OnTop,A.ArticleID desc"

	Set rsArticle= Server.CreateObject("ADODB.Recordset")
	rsArticle.open sqlArticle,conn,1,1
	if rsArticle.bof and  rsArticle.eof then
		totalput=0
		response.Write("<br><li>没有任何文章</li>")
	else
		totalput=rsArticle.recordcount
		'http=rsArticle("http")
		if currentpage<1 then
			currentpage=1
		end if
		if (currentpage-1)*MaxPerPage>totalput then
			if (totalPut mod MaxPerPage)=0 then
				currentpage= totalPut \ MaxPerPage
			else
				currentpage= totalPut \ MaxPerPage + 1
			end if
		end if

		if currentPage=1 then
			call ArticleContent(TitleLen,True,True,False,2,False,True)
		else
			if (currentPage-1)*MaxPerPage<totalPut then
         	   	rsArticle.move  (currentPage-1)*MaxPerPage