⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 task_bak.inc

📁 物业管理和办公自动化系统
💻 INC
📖 第 1 页 / 共 2 页
字号:
<%
'--------------------------------------------------------------------------------------
' 服务器端函数GetUrgency(), 获取下拉选择框
'--------------------------------------------------------------------------------------
function getUrgency(sUrgencyId)
	Dim sTemp	: sTemp = ""
	Dim sId, sDesc
	openrs RS, "select * from T_Urgency"
	while Not RS.EOF
		sId = GetValue(RS, "Urgency_id")
		sDesc = GetValue(RS, "Urgency_Desc")
		if sId = sUrgencyId then
			sTemp = sTemp & "<option value=""" & sId & """ selected>" & sDesc & "</option>"
		else
			sTemp = sTemp & "<option value=""" & sId & """>" & sDesc & "</option>"
		end if
		RS.MoveNext
	wEnd
	RS.close
	Set RS = nothing

	getUrgency = sTemp
end function

'--------------------------------------------------------------------------------------
' 服务器端函数getEmps(), 获取下拉选择框(所有未离职员工,包括登录用户自己)
'--------------------------------------------------------------------------------------
function getEmps()
	openrs RS, "select Emp_id, Name from T_Employee where dismissed = 0 and co_id = " & session("co_id") & " and isdummy = 0 order by Emp_id"
	optSuffix = "</OPTION>" & vbNewLine 
	valPrefix = "<OPTION Value='" 
	valSuffix = "'>" 
	opts = RS.GetString( , , valSuffix, optSuffix & valPrefix, "--error--" ) 
	opts = Left( opts, Len(opts)-Len(valPrefix) )  'This line is the key to it! 
	getEmps = valPrefix & opts
	rs.close
	Set rs = nothing
end function

'--------------------------------------------------------------------------------------
' 服务器端函数getRestEmps(), 获取下拉选择框
'--------------------------------------------------------------------------------------
function getRestEmps(sTaskSerial)
	openrs RS, "select Emp_id, Name from T_Employee where dismissed = 0 and co_id = " & session("co_id") & " and isdummy = 0 and Emp_id not in ( select Emp_id from T_PersonalTask where Task_Serial = " & sTaskSerial & ") order by Emp_id"
	if RS.EOF then
		getRestEmps = ""
		rs.close
		Set rs = nothing
		exit function
	end if
	optSuffix = "</OPTION>" & vbNewLine 
	valPrefix = "<OPTION Value='" 
	valSuffix = "'>" 
	opts = RS.GetString( , , valSuffix, optSuffix & valPrefix, "--error--" ) 
	opts = Left( opts, Len(opts)-Len(valPrefix) )  'This line is the key to it! 
	getRestEmps = valPrefix & opts
	rs.close
	Set rs = nothing
end function
%>

<script language="VBScript">
'------------------------------------------------------------------------------------
' VBScript客户端函数检查输入
'------------------------------------------------------------------------------------
function checkString(fldName, fldDescription)
	checkString = 0 
	Execute("formTask." & fldName & ".value = Trim(formTask." & fldName & ".value)")	' 清空前后空格
	if Eval("formTask." & fldName & ".value = """"") then
		msgbox "请输入〈 " & fldDescription & " 〉!"
		Eval("formTask." & fldName & ".focus()")
		checkString = -1
	end if
end function

'---------------------------------------------------------------
' VBScript函数数字转换成中文
'---------------------------------------------------------------
function TransWeekDay(sDay)
	Dim sTemp : sTemp = ""
	select case sDay
	case "01"
		sTemp = "一"
	case "02"
		sTemp = "二"
	case "03"
		sTemp = "三"
	case "04"
		sTemp = "四"
	case "05"
		sTemp = "五"
	case "06"
		sTemp = "六"
	case "07"
		sTemp = "日"
	end select
	TransWeekDay = sTemp
end function

'---------------------------------------------------------------
' VBScript函数检查提前N分钟(/小时/天)提醒输入是否正确(格式:00~99)
'---------------------------------------------------------------
function getAheadValue(sType)
	Dim sAhead : sAhead = ""
	Execute("sAhead = Trim(document.all." & sType & ".value)")	' 去除首尾空格
	Execute("document.all." & sType & ".value = sAhead")
	if Not IsNumeric(sAhead) then
		msgbox "对不起,输入值应当在0~99之间!"
		Execute("document.all." & sType & ".select()")
		getAheadValue = ""
	end if
	getAheadValue = Right("0000" & sAhead, 4) ' 前面补4个0,然后取后面4位
end function

'---------------------------------------------------------------
' VBScript函数检查时间输入是否正确(格式00:00~23:59)
'---------------------------------------------------------------
function getDaytime(sType)
	Dim sDaytime : sDaytime = ""
	Dim sHour, sMinute
	Dim arrayTemp
	Dim bError : bError = 0
	getDaytime = ""
	Execute("sDaytime = Trim(document.all." & sType & ".value)")	' 去除首尾空格
	Execute("document.all." & sType & ".value = sDaytime")
	' 看是否有个冒号
	arrayTemp = Split(sDaytime,":")
	if UBound(arrayTemp) <> 1 then		' 没有冒号和一个以上冒号都不对
		bError = 1
	else
		sHour = arrayTemp(0)			' 小时应该为数字,且在0~23之间
		if Not IsNumeric(sHour) then
			bError = 1
		elseif sHour > 23 then 
			bError = 1		
		end if
		sMinute = arrayTemp(1)			' 分钟应该为数字,且在00~59之间				
		if Not IsNumeric(sMinute) or len(sMinute) <> 2 then
			bError = 1
		elseif sMinute > 59 then 
			bError = 1	
		end if
	end if
	if bError then
		msgbox "对不起,时间输入范围为00:00~23:59!"
		Execute("document.all." & sType & ".select()")
		getDaytime = ""
		exit function
	end if
	getDaytime = Right("00" & sHour, 2) & Right("00" & sMinute, 2)
end function

'---------------------------------------------------------------
' VBScript函数CheckTaskData()检查输入的任务信息
'---------------------------------------------------------------
function CheckTaskData()
	Dim sSubject : sSubject = ""
	Dim sDoFrom	: sDoFrom = ""
	Dim sDoEnd	: sDoEnd = ""
	CheckTaskData = ""				' 缺省总是认为数据是正确的
	if checkString("Subject", "任务标题") = -1 then CheckTaskData = "Error" : exit function		' 任务标题
	if checkString("Content", "任务描述") = -1 then CheckTaskData = "Error" : exit function		' 任务描述
	if checkString("DoFrom", "开始时间") = -1 then CheckTaskData = "Error" : exit function		' 任务开始时间
	sDoFrom = formTask.DoFrom.value
	if Not IsDate(sDoFrom) then																	' 日期格式
		msgbox "对不起,〈 开始时间 〉的日期格式不正确!"
		formTask.DoFrom.focus()
		CheckTaskData = "Error"
		exit function
	end if
	if checkString("DoEnd", "完成时间") = -1 then CheckTaskData = "Error" : exit function			' 任务完成期限
	sDoEnd = formTask.DoEnd.value
	if Not IsDate(sDoEnd) then																	' 日期格式
		msgbox "对不起,〈 完成时间 〉的日期格式不正确!"
		formTask.DoEnd.focus()
		CheckTaskData = "Error"
		exit function
	end if
end function

'---------------------------------------------------------------
' VBScript函数CheckExecutorData()检查任务执行人员(创建新任务时必须选择任务执行人员),并设置Executors的值,以便提交
'---------------------------------------------------------------
function CheckExecutorData()
	CheckExecutorData = ""		' 缺省总是认为成功
	
	Dim executorCount : executorCount = formTask.Executors.length	' 任务执行人员的个数
	if executorCount = 0 then
		msgbox "对不起,请选择任务执行人员!"
		formTask.Employee.focus()
		CheckExecutorData = "Error"
		exit function
	else
		Dim sExecutors : sExecutors = ""
		Dim i : i = 0
		for i = 0 to executorCount - 1 
	       sExecutors = sExecutors & formTask.Executors.options(i).value & ","

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -