docdb.inc

档案管理系统

<!--#include file="../include/common.inc"-->
<%
public sub removeDept(deptname)
	checkSession
	dim strQuery
	if getUserRank() <> 1 then
		closeConnection
		raiseErr "您无权删除机构"
	end if
	strQuery="delete from deptinfo where deptname='" & deptname & "'"
	getConnection().Execute strQuery
	addlog "remove dept" & deptname, "deptinfo"
end sub

public function checkDeptNameConflict(strName)
	checkSession
	dim adoRS
	dim strQuery
	strQuery="select * from deptinfo where deptname='" & strName & "'"
	set adoRS=server.createobject("ADODB.Recordset")
	adoRS.Open strQuery, getConnection(), , , adCmdText
	if adoRS.EOF then
		checkDeptNameConflict = 0
	else
		checkDeptNameConflict = 1
	end if
	set adoRS = Nothing
end function

public sub addDept(deptname)
	checkSession
	if getUserRank() <> 1 then
		closeConnection
		raiseErr "您无权增加机构"
	end if
	if checkDeptNameConflict(deptname) = 1 then
		closeConnection
		raiseErr "机构名称已存在"
		response.End()
	end if
	Dim strInsert
	strInsert = "insert into deptinfo(deptname) values('"
	strInsert = strInsert & deptname & "')"
	getConnection().Execute strInsert
	addlog "add dept" & deptname, "deptinfo"
end sub

public sub setDeptDesc(deptname,deptdesc)
	checkSession
	if getUserRank() <> 1 then
		closeConnection
		raiseErr "您无权修改机构描述"
	end if
	if checkDeptNameConflict(deptname) = 0 then
		closeConnection
		raiseErr "该机构不存在"
		response.End()
	end if
	Dim strUpdate
	strUpdate = "update deptinfo set deptdesc='" & deptdesc & "' where deptname='" & deptname & "'"
	getConnection().Execute strUpdate
	addlog "set deptdesc of " & deptname & ":" & deptdesc,"deptinfo"
end sub

public sub writeDeptListOption(deptname)
	checkSession
	dim selDept
	dim adoRS
	dim strQuery
	selDept = "" & deptname
	strQuery="select * from deptinfo"
	set adoRS=server.createobject("ADODB.Recordset")
	adoRS.Open strQuery, getConnection(), , , adCmdText
	while not adoRS.EOF
		WriteOption adoRS("deptname"),selDept,adoRS("deptname")
		adoRS.MoveNext
	Wend
	set adoRS = Nothing
end sub

public sub removeDocClass(name)
	checkSession
	dim strQuery
	dim strUpdate
	if getUserRank() <> 1 then
		closeConnection
		raiseErr "您无权删除档案库"
	end if
	strQuery="delete from documentclass where name='" & name & "'"
	getConnection().Execute strQuery
	strUpdate = "update document set attr=0 where class='" & name & "'"
	getConnection().Execute strUpdate	
	addlog "remove docclass" & name, "documentclass"
end sub

public function checkDocClsNameConflict(strName)
	checkSession
	dim adoRS
	dim strQuery
	strQuery="select * from documentclass where name='" & strName & "'"
	set adoRS=server.createobject("ADODB.Recordset")
	adoRS.Open strQuery, getConnection(), , , adCmdText
	if adoRS.EOF then
		checkDocClsNameConflict = 0
	else
		checkDocClsNameConflict = 1
	end if
	set adoRS = Nothing
end function

public sub setClassNote(name,note)
	checkSession
	if getUserRank() <> 1 then
		closeConnection
		raiseErr "您无权修改档案库说明"
	end if
	if checkDocClsNameConflict(name) = 0 then
		closeConnection
		raiseErr "该档案库不存在"
		response.End()
	end if
	Dim strUpdate
	strUpdate = "update documentclass set note='" & note & "' where name='" & name & "'"
	getConnection().Execute strUpdate
	addlog "set note of docclass " & name & ":" & note,"documentclass"
end sub

public sub setClassAdmin(name,user)
	checkSession
	if getUserRank() <> 1 then
		closeConnection
		raiseErr "您无权修改档案库管理员"
	end if
	if checkDocClsNameConflict(name) = 0 then
		closeConnection
		raiseErr "该档案库不存在"
	end if
	Dim strUpdate
	strUpdate = "update documentclass set admin='" & user & "' where name='" & name & "'"
	getConnection().Execute strUpdate
	addlog "set admin of docclass " & name & ":" & user,"documentclass"
end sub

public sub addDocClass(name)
	checkSession
	if getUserRank() <> 1 then
		closeConnection
		raiseErr "您无权增加档案库"
	end if
	if checkDocClsNameConflict(name) = 1 then
		closeConnection
		raiseErr "档案库名称有冲突"
		response.End()
	end if
	Dim strInsert
	strInsert = "insert into documentclass(name) values('"
	strInsert = strInsert & name & "')"
	getConnection().Execute strInsert
	addlog "add documentclass:" & name, "documentclass"
end sub

public function getAdminOfDocCls(name)
	checkSession
	dim adoRS
	dim strQuery
	strQuery="select * from documentclass where name='" & name & "'"
	set adoRS=server.createobject("ADODB.Recordset")
	adoRS.Open strQuery, getConnection(), , , adCmdText
	if adoRS.EOF then
		getAdminOfDocCls = ""
	else
		getAdminOfDocCls = "" & adoRS("admin")
	end if
	set adoRS = Nothing
end function

public function isWritableForDocCls(name)
	checkSession
	if getUserRank() = 1 or getUser() = getAdminOfDocCls(name) then
		isWritableForDocCls = 1
	else
		isWritableForDocCls = 0
	end if
end function

public sub writeDocClsListOption(doccls)
	checkSession
	dim selDocCls
	dim adoRS
	dim strQuery
	selDocCls = "" & doccls
	strQuery="select * from documentclass"
	set adoRS=server.createobject("ADODB.Recordset")
	adoRS.Open strQuery, getConnection(), , , adCmdText
'	WriteOption "",selDocCls,""
	while not adoRS.EOF
		WriteOption adoRS("name"),selDocCls,adoRS("name")
		adoRS.MoveNext
	Wend
	set adoRS = Nothing
end sub

public function getDocNameById(id)
	checkSession
	dim adoRS
	dim strQuery
	strQuery="select * from document where id=" & id
	set adoRS=server.createobject("ADODB.Recordset")
	adoRS.Open strQuery, getConnection(), , , adCmdText
	if adoRS.EOF then
		getDocNameById = null
	else
		getDocNameById = adoRS("name")
	end if
	set adoRS = Nothing
end function

public function getRSById(id)
	checkSession
	dim adoRS
	dim strQuery
	strQuery="select * from document where id=" & id
	set adoRS=server.createobject("ADODB.Recordset")
	adoRS.Open strQuery, getConnection(), , , adCmdText
	set getRSById = adoRS
end function

public function getIdByName(name,doccls)
	checkSession
	dim adoRS
	dim strQuery
	strQuery="select * from document where name='" & name & "' and class='" & doccls & "'"
	set adoRS=server.createobject("ADODB.Recordset")
	adoRS.Open strQuery, getConnection(), , , adCmdText
	if adoRS.EOF then
		getIdByName = ""
	else
		getIdByName = adoRS("id")
	end if
	set adoRS = nothing
end function

public function getAttrById(id)
	checkSession
	dim adoRS
	dim strQuery
	strQuery="select * from document where id=" & id
	set adoRS=server.createobject("ADODB.Recordset")
	adoRS.Open strQuery, getConnection(), , , adCmdText
	if adoRS.EOF then
		getAttrById = null
	else
		getAttrById = adoRS("attr")
	end if
	set adoRS = nothing
end function

public function getDocClsById(id)
	checkSession
	dim adoRS
	dim strQuery
	strQuery="select * from document where id=" & id
	set adoRS=server.createobject("ADODB.Recordset")
	adoRS.Open strQuery, getConnection(), , , adCmdText
	if adoRS.EOF then
		getDocClsById = null
	else
		getDocClsById = adoRS("class")
	end if
	set adoRS = nothing
end function

public function getDocBorrowerById(id)
	checkSession
	dim adoRS
	dim strQuery
	strQuery="select * from document where id=" & id
	set adoRS=server.createobject("ADODB.Recordset")
	adoRS.Open strQuery, getConnection(), , , adCmdText
	if adoRS.EOF then
		getDocBorrowerById = null
	else
		getDocBorrowerById = adoRS("borrower")
	end if
	set adoRS = nothing
end function

public function getDocRS(attr,name,dept,docyear,builder,cls,borrower)
	checkSession
	dim adoRS
	dim strAttr,strName,strDept,strDocyear,strBuilder,strCls,strBorrower,strQuery
	strAttr = "" & attr
	if strAttr = "" then
		raiseErr "查询条件有问题"
	end if
	strName = "" & name
	strDept = "" & dept
	strDocyear = "" & docyear
	strBuilder = "" & builder
	strCls = "" & cls
	strBorrower = "" & borrower
	strQuery = "select * from document where attr=" & strAttr
	if strDept <> "" then
		strQuery = strQuery & " and dept='" & strDept & "'"
	end if
	if strDocyear <> "" then
		strQuery = strQuery & " and docyear='" & strDocyear & "'"
	end if
	if strBuilder <> "" then
		strQuery = strQuery & " and builder='" & strBuilder & "'"
	end if
	if strCls <> "" then
		strQuery = strQuery & " and class='" & strCls & "'"
	end if 
	if strBorrower <> "" then
		strQuery = strQuery & " and borrower='" & strBorrower & "'"
	end if
	if strName <> "" then
		strQuery = strQuery & " and name like '%" & strName & "%'"
	end if
	set adoRS=server.createobject("ADODB.Recordset")
	adoRS.Open strQuery, getConnection(), , , adCmdText
	set getDocRS = adoRS
end function

public sub addDoc(name,dept,docyear,timelimit,doccls,note)
	checkSession
	if isWritableForDocCls(doccls) <> 1 then
		raiseErr "您无权在该档案库增加档案"
	end if
	if getIdByName(name,doccls) <> "" then
		raiseErr "档案库中已有该名称的档案"
	end if
	Dim strInsert
	strInsert = "insert into document(name,dept,docyear,timelimit,attr,class,note,builder,buildtime) values('"
	strInsert = strInsert & name & "','" & dept & "','" & docyear & "'," & timelimit & ",0,'" & doccls & "','" & note & "','" & getUser() & "','" & now & "')"
	getConnection().Execute strInsert
	addlog "add document:" & name, "document"	
end sub

public sub updateDoc(intId,dept,docyear,timelimit,note)
	checkSession
	if isWritableForDocCls(doccls) <> 1 then
		raiseErr "您无权在该档案库更新档案"
	end if
	Dim strUpdate
	strUpdate = "update document set "
	strUpdate = strUpdate & "dept='" & "" & dept & "',"
	strUpdate = strUpdate & "docyear='" & "" & docyear & "',"
	strUpdate = strUpdate & "timelimit=" & timelimit & ","
	strUpdate = strUpdate & "note='" & "" & note & "' "
	strUpdate = strUpdate & "where id=" & CInt(intId)

	getConnection().Execute strUpdate
	addlog "update document:" & intId,"document"	

end sub

public sub removeDoc(id)
	checkSession
	if isWritableForDocCls(getDocClsById(id)) <> 1 then
		raiseErr "您无权在该档案库删除档案"
	end if
	Dim strQuery
	strQuery = "delete from document where id=" & id
	getConnection().Execute strQuery
	addlog "remove document:" & id, "document"
end sub

public sub setDocClass(id,doccls)
	checkSession
	if isWritableForDocCls(getDocClsById(id)) <> 1 then
		raiseErr "您无权对该档案库档案操作"
	end if
	Dim strQuery
	strQuery = "update document set class='" & doccls & "' where id=" & id
	getConnection().Execute strQuery
	addlog "update document:" & id & " set class=" & doccls, "document"
end sub

public sub setDocAttr(id,intAttr)
	checkSession
	if isWritableForDocCls(getDocClsById(id)) <> 1 then
		raiseErr "您无权对该档案库档案操作"
	end if
	Dim strQuery
	strQuery = "update document set attr=" & intAttr & " where id=" & id
	getConnection().Execute strQuery
	addlog "update document:" & id & " set attr=" & intAttr, "document"
end sub

public sub setDocBorrower(id,strBorrower)
	checkSession
	if isWritableForDocCls(getDocClsById(id)) <> 1 then
		raiseErr "您无权对该档案库档案操作"
	end if
	Dim strQuery
	strQuery = "update document set borrower='" & strBorrower & "' where id=" & id
	getConnection().Execute strQuery
	addlog "update document:" & id & " set borrower=" & strBorrower, "document"
end sub

public sub addLibInfo(doc,begintime,endtime,reason)
	checkSession
	if "" & getDocBorrowerById(doc) <> "" then
		raiseErr "该档案已被" & getDocBorrowerById(doc) & "借走"
	end if
	Dim strInsert
	strInsert = "insert into libinfo(document,borrower,begintime,endtime,reason,state) values("
	strInsert = strInsert & doc & ",'" & getUser() & "','" & begintime & "','" & endtime & "','" & reason & "',0)"
	getConnection().Execute strInsert
	addlog "add libinfo:" & doc, "libinfo"	
end sub

public function getLibDocById(id)
	checkSession
	dim adoRS
	dim strQuery
	strQuery="select * from libinfo where id=" & id
	set adoRS=server.createobject("ADODB.Recordset")
	adoRS.Open strQuery, getConnection(), , , adCmdText
	if adoRS.EOF then
		getLibDocById = null
	else
		getLibDocById = adoRS("document")
	end if
	set adoRS = nothing
end function

public function getLibStateById(id)
	checkSession
	dim adoRS
	dim strQuery
	strQuery="select * from libinfo where id=" & id
	set adoRS=server.createobject("ADODB.Recordset")
	adoRS.Open strQuery, getConnection(), , , adCmdText
	if adoRS.EOF then
		getLibStateById = null
	else
		getLibStateById = adoRS("state")
	end if
	set adoRS = nothing
end function

public function getLibBorrowerById(id)
	checkSession
	dim adoRS
	dim strQuery
	strQuery="select * from libinfo where id=" & id
	set adoRS=server.createobject("ADODB.Recordset")
	adoRS.Open strQuery, getConnection(), , , adCmdText
	if adoRS.EOF then
		getLibBorrowerById = null
	else
		getLibBorrowerById = adoRS("borrower")
	end if
	set adoRS = nothing
end function

public function getLibRSById(id)
	checkSession
	dim adoRS
	dim strQuery
	strQuery="select * from libinfo where id=" & id
	set adoRS=server.createobject("ADODB.Recordset")
	adoRS.Open strQuery, getConnection(), , , adCmdText
	set getLibRSById = adoRS
end function

public sub removeLibInfo(id,msg)
	checkSession
	Dim strQuery
	dim strBorrower
	strBorrower = getLibBorrowerById(id)
	strQuery = "delete from libinfo where id=" & id
	getConnection().Execute strQuery
	addlog "remove libinfo:" & id, "libinfo"
	addmsg "" & strBorrower,"" & msg	
end sub

public sub setLibState(id)
	checkSession
	Dim strQuery
	dim strUpdate
	dim intDoc
	dim strSel
	dim adoRS
	intDoc = getLibDocById(id)
	strQuery = "update libinfo set state=1,lender='" & getUser() & "' where id=" & id
	getConnection().Execute strQuery
	strUpdate = "update document set borrower='" & getLibBorrowerById(id) & "' where id=" & intDoc
	getConnection().Execute strUpdate
	addmsg "" & getLibBorrowerById(id),"您申请借阅的" & getDocNameById(intDoc) & "已被批准"
	strSel = "select * from libinfo where state=0 and document=" & CInt(intDoc)
	set adoRS=server.createobject("ADODB.Recordset")
	adoRS.Open strSel, getConnection(), , , adCmdText
	while not adoRS.EOF
		removeLibInfo adoRS("id"),"您所申请借阅的" & getDocNameById(adoRS("document")) & "已被别人借阅，请稍候时日"
		adoRS.MoveNext
	wend
	set adoRS = nothing
end sub

public sub retLib(id)
	dim intDoc
	dim strUpdate
	intDoc = getLibDocById(id)
	removeLibInfo id,"您所申请借阅的" & getDocNameById(intDoc) & "已归还"
	strUpdate = "update document set borrower='' where id=" & intDoc
	getConnection().Execute strUpdate	
end sub

public function getLibRSByBorrower(user,state)
	checkSession
	dim adoRS
	dim strQuery
	strQuery="select * from libinfo where state=" & state & " and borrower='" & user & "'"
	set adoRS=server.createobject("ADODB.Recordset")
	adoRS.Open strQuery, getConnection(), , , adCmdText
	set getLibRSByBorrower = adoRS
end function
%>