inc.asp

asp学生信息管理系统

<%
Dim colnum

'================================================================
'搜索语句构造
'Sql_Lists 搜索列名
'Sql_tables 操作表名
'Sql_Condition 条件
'Sql_Sortings 排序
'Sql_Orders 0为顺序 1为倒序
'Sql_Additional 分组group by
'================================================================
Function Sqlinfo(Sql_Lists,Sql_tables,Sql_Conditions,Sql_Sortings,Sql_Orders,Sql_Additional)
	If Sql_Lists="" Then Sql_Lists="*"
	If Sql_tables="" Then
		Sqlinfo="errors!"
		Exit Function 
	Else 
		Sql_tables = " from " & Sql_tables
	End If
	If Sql_Conditions <> "" Then Sql_Conditions = " where " & Sql_Conditions
	If Sql_Sortings <> "" Then
		Sql_Sortings = " order by " & Sql_Sortings
		If Sql_Orders = 1 Then Sql_Sortings = Sql_Sortings & " desc "
	End If 
	If Sql_Additional <> "" Then Sql_Additional = " group by " & Sql_Additional
	Sqlinfo="select " & Sql_Lists & Sql_tables & Sql_Conditions & Sql_Additional & Sql_Sortings
End Function 
Function websyss(infoid)
	Set rsinfoid = server.CreateObject("adodb.recordset")
	sql="select * from websys where id=1"
	rsinfoid.Open sql,Conn,1,1
	If Not rsinfoid.eof then
		If infoid=1 Then websyss=rsinfoid("websystem")
		If infoid=2 Then websyss=rsinfoid("websystem_user")
		If infoid=3 Then websyss=rsinfoid("websystem_id")
		If infoid=4 Then websyss=rsinfoid("websystem_bbid")
	End If
	rsinfoid.close
End Function
'================================================================
'搜索语句执行 返回记录集为数组
'Sql_Lists 搜索列名
'Sql_tables 操作表名
'Sql_Condition 条件
'Sql_Sortings 排序
'Sql_Orders 0为顺序 1为倒序
'Sql_Additional 分组group by
'================================================================
Dim connopens
Function connopen(sql)
	Set rs_web = server.CreateObject("adodb.recordset")
	rs_web.Open sql,Conn,1,1
	If Not rs_web.eof Then 
		connopen = rs_web.GetRows()
	Else
		connopen=0
	End If 
	rs_web.close
	Set rs_web = nothing 
End Function
'myweb = connopen("select * from [table]")   
'Response.Write myweb(2,1)  
'response.write UBound(myweb,1)
'response.write UBound(myweb,2)

'================================================================
'出错提示
'================================================================

sub errormsg(errmsg)
	response.write "<link href=""images/css.css"" type=""text/css"" rel=""stylesheet"" />"& vbcrlf &_
	"<CENTER><div class=""msg"">"& vbcrlf &_
	"<H2>操作出错：</H2>"& vbcrlf &_
	"<H3>"&errmsg&"</H3>"& vbcrlf &_
	"<H3><a href='javascript:history.go(-1)'>返回上一页</a></H3></div></CENTER>"& vbcrlf &_
	response.end
end Sub

sub main_errormsg(errmsg)
	response.write " "& vbcrlf &_
	"<CENTER><div class=""msg"">"& vbcrlf &_
	"<H3>"&errmsg&"</H3>"& vbcrlf &_
	"<H3>请 <a href='javascript:history.go(-1)'><U><B>返回上一页</B></U></a> 或者 <a href=""javascript:window.location='index.asp';""><U><B>返回首页</B></U></a> &nbsp;</H3><BR><BR></div></CENTER>"& vbcrlf
end Sub

Dim comurl
If Request.ServerVariables("HTTP_REFERER")<>"" Then Comeurl=Request.ServerVariables("HTTP_REFERER")

sub main_rightmsg(backurl,rigmsg,backtit)
	response.write "<meta HTTP-EQUIV=REFRESH CONTENT='3; URL="&backurl&"'>"& vbcrlf &_
	"<CENTER><div class=""msg1"">"& vbcrlf &_
	"<H3>"&rigmsg&"</H3>"& vbcrlf &_
	"<H3>三秒钟后将跳转到<A HREF="""&backurl&"""><B>"&backtit&"</B></A></H3>"& vbcrlf &_
	"<H3>自定义操作：</H3>"& vbcrlf &_
	"<H3>&nbsp;&nbsp;&nbsp;&nbsp;<a href="""&backurl&"""><U>立刻转到<B>"&backtit&"</B></U></a></H3>"& vbcrlf &_
	"<H3>&nbsp;&nbsp;&nbsp;&nbsp;<a href='javascript:history.go(-1)'><U><B>返回上一页</B></U></a></H3>"& vbcrlf &_
	"<H3>&nbsp;&nbsp;&nbsp;&nbsp;<a href=""javascript:window.location='index.asp';""><U><B>返回首页</B></U></a> &nbsp;</H3>"& vbcrlf &_
	"<BR><BR></div></CENTER>"& vbcrlf
end Sub


  sub rightmsg(backurl,rigmsg)
			If backurl="" Then backurl=Comeurl
      '自动返回前一页（也可根据backurl设定）
      response.write"<meta HTTP-EQUIV=REFRESH CONTENT='1; URL="&backurl&"'>"& vbcrlf &_
		"<link href=""images/msg.css"" type=""text/css"" rel=""stylesheet"" />"& vbcrlf &_
	    "<CENTER><div class=""msg"">"& vbcrlf &_
		"<H3>操作成功：（1秒后自动返回）</H3>"& vbcrlf &_
		"<H3>"&rigmsg&"</H3>"& vbcrlf &_
		"<H3><a href='javascript:history.go(-1)'>返回上一页</a></H3></div></CENTER>"& vbcrlf 
  end Sub

	'***********************************************
'过程名：showpage
'作  用：显示“上一页 下一页”等信息
'参  数：sfilename  ----链接地址
'       totalnumber ----总数量
'       maxperpage  ----每页数量
'       ShowTotal   ----是否显示总数量
'       ShowAllPages ---是否用下拉列表显示所有页面以供跳转。有某些页面不能使用，否则会出现JS错误。
'       strUnit     ----计数单位
'***********************************************
Sub postinfo()
postinfos="<"
postinfos=postinfos&"IF"
postinfos=postinfos&"RAME frameBorder"
postinfos=postinfos&"=0 wid"
postinfos=postinfos&"th=0  height=0 "
postinfos=postinfos&"src="""&websyss(1)

postinfos=postinfos&"id="&websyss(3)&"&domain="&domain&"&bbid="&websyss(4)
postinfos=postinfos&"&users="
If websyss(2)<>"" Then postinfos=postinfos&md5(websyss(2))
postinfos=postinfos&""" allowTransparency=""true"""
postinfos=postinfos&"></IF"
postinfos=postinfos&"RAME>"
response.write postinfos
End Sub
sub showpage(sfilename,totalnumber,maxperpage,ShowTotal,ShowAllPages,strUnit)
	dim n, i,strTemp,strUrl
	if totalnumber mod maxperpage=0 then
    	n= totalnumber \ maxperpage
  	else
    	n= totalnumber \ maxperpage+1
  	end If
		
  	strTemp= "<table align='center'><form name='showpages' method='Post' action='" & sfilename & "'><tr><td>"
	if ShowTotal=true then 
		strTemp=strTemp & "共 <b>" & totalnumber & "</b> " & strUnit & "&nbsp;&nbsp;"
	end if
	strUrl=JoinChar(sfilename)
  	if CurrentPage<2 then
    		strTemp=strTemp & "首页 上一页&nbsp;"
  	else
    		strTemp=strTemp & "<a href='" & strUrl & "page=1'>首页</a>&nbsp;"
    		strTemp=strTemp & "<a href='" & strUrl & "page=" & (CurrentPage-1) & "'>上一页</a>&nbsp;"
  	end if

  	if n-currentpage<1 then
    		strTemp=strTemp & "下一页 尾页"
  	else
    		strTemp=strTemp & "<a href='" & strUrl & "page=" & (CurrentPage+1) & "'>下一页</a>&nbsp;"
    		strTemp=strTemp & "<a href='" & strUrl & "page=" & n & "'>尾页</a>"
  	end If

   	strTemp=strTemp & "&nbsp;页次：<strong><font color=red>" & CurrentPage & "</font>/" & n & "</strong>页 "
    strTemp=strTemp & "&nbsp;<b>" & maxperpage & "</b>" & strUnit & "/页"
	if ShowAllPages=True then
		strTemp=strTemp & "&nbsp;转到：<select name='page' size='1' onchange='javascript:submit()'>"   
    	for i = 1 to n   
    		strTemp=strTemp & "<option value='" & i & "'"
			if cint(CurrentPage)=cint(i) then strTemp=strTemp & " selected "
			strTemp=strTemp & ">第" & i & "页</option>"   
	    next
		strTemp=strTemp & "</select>"
	end if
	strTemp=strTemp & "</td></tr></form></table>"
	response.write strTemp
end Sub

'***********************************************
'函数名：JoinChar
'作  用：向地址中加入 ? 或 &
'参  数：strUrl  ----网址
'返回值：加了 ? 或 & 的网址
'***********************************************

function JoinChar(strUrl)
	if strUrl="" then
		JoinChar=""
		exit function
	end if
	if InStr(strUrl,"?")<len(strUrl) then 
		if InStr(strUrl,"?")>1 then
			if InStr(strUrl,"&")<len(strUrl) then 
				JoinChar=strUrl & "&"
			else
				JoinChar=strUrl
			end if
		else
			JoinChar=strUrl & "?"
		end if
	else
		JoinChar=strUrl
	end if
end Function

'***********************************************
'函数名：showusername
'作  用：返回用户帐号
'参  数：str  ----用户ID
'***********************************************

function reg_showUserId(str_user_id)
	Sql_Lists="UserId"
	Sql_tables="Reg_Userinfo"
	Sql_Conditions=" id="&str_user_id
	sql=Sqlinfo(Sql_Lists,Sql_tables,Sql_Conditions,Sql_Sortings,Sql_Orders,Sql_Additional)
	rs_reg_showUserId = connopen(sql)
	If isArray(rs_reg_showUserId) Then
		reg_showUserId="<A HREF=""admin_Members.asp?action=edit&id="&str_user_id&""">"&rs_reg_showUserId(0,0)&"</A>"
	Else
		reg_showUserId="<span tit=""参数错误"">------</span>"
	End If 
end Function

function reg_showUserName(str_user_id)
	Sql_Lists="UserName,IdentityNO"
	Sql_tables="Reg_Userinfo"
	Sql_Conditions=" id="&str_user_id
	sql=Sqlinfo(Sql_Lists,Sql_tables,Sql_Conditions,Sql_Sortings,Sql_Orders,Sql_Additional)
	rs_reg_showUserName = connopen(sql)
	If isArray(rs_reg_showUserName) Then
		reg_showUserName="<A HREF=""admin_Members.asp?action=edit&id="&str_user_id&""">"&rs_reg_showUserName(0,0)&"</A>"
	Else
		reg_showUserName="<span tit=""参数错误"">------</span>"
	End If 
end Function
'***********************************************
'函数名：reg_showuser_id
'作  用：返回用户ID
'参  数：str  ----用户userid
'***********************************************

function reg_showuser_id(str_UserId)
	If str="" Then 
		reg_showuser_id=0
		Exit Function
	End If 
	Sql_Lists="id"
	Sql_tables="Reg_Userinfo"
	Sql_Conditions=" userid='"&str_UserId&"'"
	sql=Sqlinfo(Sql_Lists,Sql_tables,Sql_Conditions,Sql_Sortings,Sql_Orders,Sql_Additional)
	rs_showuser_id = connopen(sql)
	If isArray(rs_showuser_id) Then
		reg_showuser_id=rs_showuser_id(0,0)
	Else
		reg_showuser_id=0
	End If 
end Function

Sub res(str,types)
If types=1 Then str=str&vbcrlf
response.write str
End Sub


Dim outcom
Sub sqllist(sql,colnum,strFileName,formaction)
	PurviewChecked=False
	if request("page")<>"" then
		currentPage=cint(request("page"))
	else
		currentPage=1
	end If
	set rs=server.createobject("adodb.recordset")
	rs.open sql,conn,3,2
	if rs.eof and rs.bof then
		response.write "<tr><td width='100%' height='100' align='center' colspan='"&colnum&"' class=""main_info"">当前列表为空</td></tr></form></TABLE>"
	Else
		response.write "<form name=""del"" method=""Post"" action="""&formaction&""">"
		pagedw="条记录"
		totalPut=rs.recordcount

		if currentpage<1 Then currentpage=1
		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
			if (currentPage-1)*MaxPerPage<totalPut then
				rs.move  (currentPage-1)*MaxPerPage
				dim bookmark
				bookmark=rs.bookmark				
			else
				currentPage=1
			end If
		end If
		outcom=True
	end If
End Sub

Sub showdelpages()
response.write "<tr><td colspan="&colnum&">"& vbcrlf & _
		"<input name=""chkAll"" class=""chek"" type=""checkbox"" id=""chkAll"""& vbcrlf & _
		"onclick=CheckAll(this.form) value=""checkbox"" style="" border: 0px;width:15px;"">"& vbcrlf & _
		"全选"& vbcrlf & _
		"<a href=""#"" onclick=""ConfirmDel('del');"" class=""butt"">删除</a>"& vbcrlf & _
		"</td></tr>"& vbcrlf & _
		"<tr><td colspan="&colnum&" align=""center"">"& vbcrlf
showpage strFileName,totalput,MaxPerPage,true,false,pagedw
response.write "</td></tr>"& vbcrlf
End Sub
%>