admin_stuid_into.asp

提供学生证 的在线查询功能。界面上面是录入框

<!--#include file="../conn.asp"-->
<!--#include file="../inc/UpLoadClass.asp"-->
<!--#include file="../inc/md5.asp"-->
<!--#include file="../inc/inc.asp"-->
<!--#include file="inc/inc.asp"-->
<!--#include file="admin_page_top.asp"-->
<%
Login_Judge
dim request2
Dim conn_excel
Dim rsxls,rs_add
Dim lj_id,Col_id,pro_id,cla_id
Dim stuid,name,IdentityNO,con,Gender
Dim ClassNo,username,stu_Res,stu_con
Dim filename,fso,sqlmodstr
Dim exceltable,intomodle
Dim nojump
Dim xls_url
nojump=""
'建立上传对象
set request2=New UpLoadClass
	'设置为手动保存模式
	request2.AutoSave=2
	request2.FileType="xls"
	'设置服务器文件保存路径
	request2.SavePath="excel/"
	'设置重命名
	'request2.AutoSave = 0
	'打开对象，默认为 gb2312 字符集，故没有显示设置
	request2.Open()
	lj_id = che(request2.form("lj_id"))
	Col_id = che(request2.form("Col_id"))
	pro_id = che(request2.form("pro_id"))
	cla_id = che(request2.form("cla_id"))
	exceltable = che(request2.form("exceltable"))
	intomodle = che(request2.form("intomodle"))

	isn lj_id,"年届",1
	isn Col_id,"系所",1
	isn pro_id,"专业",1
	isn cla_id,"班级",1
	isn exceltable,"excel sheel名称",1

	xls_url=""
	request2.MaxSize=204800
	if request2.Save("file1",0) then
		xls_url=request2.SavePath&request2.Form("file1")
	end If
	response.write xls_url
	On Error Resume Next
	set conn_excel=CreateObject("ADODB.connection")
	conn_excel.Open "Driver={Microsoft Excel Driver (*.xls)};" & _
         "DriverId=790;" & _
         "Dbq=" & server.mappath(""&xls_url&"") & ";" & _
				 "DefaultDir= "
	
	set rsxls=createobject("ADODB.recordset")
	rsxls.Open "Select * From ["&exceltable&"$]",conn_excel, 2, 2
	If Err Then 
	response.write ""
	End If
	if rsxls.eof then
	errormsg "Excel表中无纪录"
	Else
		Dim temp_str1,temp_str2
		Dim temp_jump_i,temp_rig_i,temp_rig2_i,temp_i
		temp_jump_i=0
		temp_rig_i=0
		temp_rig2_i=0
		temp_i=0
			do while not  rsxls.eof
			stuid=rsxls(0)
			name=rsxls(1)
			Gender=rsxls(2)
			IdentityNO=rsxls(3)
			con=rsxls(4)
			If stuid<>"" And IdentityNO<>"" Then
					temp_str1=checkstu(stuid,"stuid",1)
					temp_str2=checkstu(IdentityNO,"IdentityNO",1)
				If intomodle="1" Then		'跳过
					If temp_str1<>0 Or temp_str2<>0 Then'跳过
						temp_jump_i=temp_jump_i+1
					Else
						addstuinfo(0)'添加
						temp_rig_i=temp_rig_i+1
					End If 
				Else	'覆盖
					If temp_str1<>0 And temp_str2=temp_str1 Then
						addstuinfo(temp_str1)'修改
						temp_rig2_i=temp_rig2_i+1
					ElseIf temp_str1=0 Or temp_str2=0 Then
						addstuinfo(0)'添加
						temp_rig_i=temp_rig_i+1
					Else	'跳过
						temp_jump_i=temp_jump_i+1
					End If 
				End If
			Else'跳过
				temp_jump_i=temp_jump_i+1
			End If
			temp_i=temp_i+1
		rsxls.movenext
		Loop
	End If 
	Dim errinfo
	deleteAFile(xls_url)
	If Err Then 
	errinfo="\n文件没有成功清除，请手工删除"&xls_url&"文件"
	End If
	If intomodle<>"1" Then  nojump="其中因存在相同学号与身份证号，覆盖"&temp_rig2_i&"条信息"
res "<SCRIPT LANGUAGE=""JavaScript"">alert(""导入成功： 共有"&temp_i&"条信息；\n 成功导入"&temp_rig_i+temp_rig2_i&"条信息；\n因重复过信息不完整，跳过"&temp_jump_i&"条信息;\n"& nojump &errinfo &" "");</SCRIPT>",1
'rightmsg "admin_Results.asp?action=into",""


Function checkgender(str1)
	If str1="" Or str1="男" Then
		str1=1
	Else
		str1=2
	End If 
	checkgender=str1
End function
Function checkstu(str1,str2,str3)	'存在返回true
	sql=Sqlinfo("id","admin_stu",str2&" = '"&str1&"'","","","")
	fun_get = connopen(sql)
	If str3=0 Then 
		checkstu = False
		If IsArray(fun_get) Then checkstu=True
	Else
		checkstu = 0
		If IsArray(fun_get) Then checkstu=fun_get(0,0)
	End If
End Function


Sub addstuinfo(strid)
	set rs_add=server.createobject("adodb.recordset")
	sql=Sqlinfo("","admin_stu","id="&strid,"","","")
	rs_add.Open Sql, Conn, 1, 3
	If strid=0 Then rs_add.AddNew
	sqltable
	rs_add.Update
	rs_add.close
End Sub 
'****************************************************
'名称:sqltable
'功能:将值提交入库
'参数:types 为空或 "add" 判断是修改记录还是添加记录
'****************************************************
Sub sqltable()
	rs_add("lj_id")=lj_id
	rs_add("Col_id")=Col_id
	rs_add("pro_id")=pro_id
	rs_add("cla_id")=cla_id
	rs_add("stuid")=stuid
	rs_add("name")=name
	rs_add("Gender")=checkgender(Gender)
	rs_add("IdentityNO")=IdentityNO
	rs_add("con")=con
End Sub

'deleteAFile(Server.MapPath(xls_url))
	Function deleteAFile(filespec)
'//功能：文件删除
'//形参：文件名
'//返回值：成功为1，失败为-1
  Set fso = server.CreateObject("Scripting.FileSystemObject") 
	filename=Server.MapPath(xls_url)
	fso.DeleteFile (filename)
	set fso = nothing 
End Function

%>
<!--#include file="admin_page_footer.asp"-->