monitor.inc

物业管理和办公自动化系统

<%
'************************************************************************************************
' 文件名: monitor.inc
' Copyright(c) 2001-2002 上海阿尔卡特网络支援系统有限公司
'
' 　创建人 : 周秋舫
' 　日　期 : 2002-05-13
' 修改历史 :
'   ****年**月**日 ****** 修改内容:**************************************************
' 功能描述 : 监视器（在线人员和实时消息）monitor.asp的包含文件
'				SerialOfNewMsgFromDB
' 　版　本 :
'************************************************************************************************


''*********************************************************************************************
'' 常量定义
'' -------------------------------------------------------------------------------------------------------------------------------------
Const SHOW_NOTHING						= "1"		'' 不作任何事
Const SHOW_MSGLIST						= "2"	 	'' 如果msglist窗口不存在，则打开msglist窗口，否则更新窗口内容
Const SHOW_MSG								= "3"		'' 直接打开消息窗口
Const SHOW_MSGLIST_AND_MSG		= "4"		'' 打开或更新窗口，并直接打开消息窗口


'' ***********************************************************************************************
'' 函数名：SerialsOfNewMsgFromDB
'' 功　能：查询数据库中t_msg的收件箱中的未通知新消息
'' 输　入：(无)
'' 输　出：以逗号分隔的各未通知消息的序列号
'' -------------------------------------------------------------------------------------------------------------------------------------
function SerialsOfNewMsgFromDB()
		dim sSQL, crs, rs, sMsgSerial

		dim sTemp	 : sTemp = ""

		'' 我先找到我所有未通知的消息
		sSQL = "select serial from t_msg where emp_serial = " & sMyEmpSerial & " and folder = " & IN_BOX & " and status = " & MSG_UNINFORMED
		set crs = New CRecordset
		set rs = crs.Open(dbLocal, sSQL)

		iRecords = 0
		while not rs.eof
			iRecords = iRecords + 1
			sMsgSerial = crs.GetValue("serial")
			if sTemp <> "" then sTemp = sTemp & ","
			sTemp = sTemp & sMsgSerial

			'' 我取到了这个消息序列号，我就把这条消息更新为已通知未读状态
			sSQL = "update t_msg set status = " & MSG_INFORMED & " where serial = " & sMsgSerial
			''Response.Write iRecords & ": " & sSQL & "<br>" & vbLF
			call ExecuteSQL(dbLocal, sSQL)

			rs.movenext
		wend
		crs.Close()

		SerialsOfNewMsgFromDB = sTemp
end function


'' ***********************************************************************************************
'' 函数名：DealNewMsgs
'' 功　能：处理新消息，根据参数option显示最新消息列表和／或最新消息的详细内容
'' 输　入：msglist	: 新消息的消息序列号列表，消息序列号之间以逗号分隔
'' 输　出：(无)
'' -------------------------------------------------------------------------------------------------------------------------------------
sub DealNewMsgs(msglist)
	dim j, arrayMsg, sMsgSerial, iRecords

	arrayMsg = Split(msglist, ",")
	iRecords = UBound(arrayMsg) + 1
	if iRecords = 0 then exit sub			'' 如果没有新消息，则立即返回

	Response.Write "<script language=""javascript"">" & vbLF

	'' 显示消息列表
	if pOption = SHOW_MSGLIST or pOption = SHOW_MSGLIST_AND_MSG then
			Response.Write vbTab & "window.open('newestmsg.asp','wMsgList','width=100,height=300,left=1,top=1');" & vbLF
	end if
	
	'' 打开新消息窗口，显示消息详细内容
	if pOption = SHOW_MSG or pOption = SHOW_MSGLIST_AND_MSG then
			for j = 0 to UBound(arrayMsg) step 1
					Response.Write vbTab & "window.open('msg_p.asp?msg_serial=" & arrayMsg(j) & "','','width=480,height=421,left=1,top=1');" & vbLF
			next
	end if
	
	Response.Write "</script>" & vbLF
end sub


''*********************************************************************************************
'' 函数名：SerialsOfNewMsgFromApp
'' 功　能：查找Application("msg")中所有跟我有关的消息，取出跟我有关的消息序列号，并更新Application("msg")对象
''			  在这个函数中有可能在取到Application("msg")对象的值到重置Application对象值的这段时间内会损失一部分新消息
'' 输　入：(无)
'' 输　出：返回跟我有关的消息序列号
''----------------------------------------------------------------------------------------------------------------------------------
function SerialsOfNewMsgFromApp()

	dim arrayMsg, j, sMsgSerials
	dim sMyMsgSerials

	dim sTemp		: sTemp = ""
	dim sMsgs		: sMsgs = Application("msg")

	arrayMsg = Split(sMsgs, "&")
	for j = 0 to UBound(arrayMsg) step 1
		sMsgSerials = Trim(arrayMsg(j))
		if left(sMsgSerials, len(sMyEmpSerial) + 1) = sMyEmpSerial & ":" then
			sMyMsgSerials = Trim(right(sMsgSerials, len(sMsgSerials) - len(sMyEmpSerial) - 1))		'' 我的消息
		else
			if sTemp <> "" then sTemp = sTemp & "&"																	'' 其他人的消息
			sTemp = sTemp & sMsgSerials
		end if
	next

	Application.lock()
	Application("msg") = sTemp	'' 其他人的消息还是保持不变
	Application.unlock()

	SerialsOfNewMsgFromApp = sMyMsgSerials
end function



''*********************************************************************************************
'' 函数名：MsgRecords()
'' 功　能：显示最新的若干条消息
'' 输　入：(无)
'' 输　出：若干条消息
''----------------------------------------------------------------------------------------------------------------------------------
function MsgRecords()
		dim sSQL, crs, rs, iCounter
		dim sMsgSerial, sSender, sReceiver, sSendTime, sSubject, sContent, sFolder
		dim sTemp

		'' 选出最新的10条消息
		sSQL = "select * from t_msg" & _
						" where emp_serial = " & sMyEmpSerial & _
						" and folder in (" & IN_BOX & "," & INBOX_BULLETIN & "," & INBOX_MEETING & "," & INBOX_APPROVE & "," & INBOX_TASK & ")" & _
						" order by status asc, send_time desc, folder asc"

		set crs = New CRecordset
		set rs = crs.Open(dbLocal, sSQL)
		iCounter = 0
		sTemp = ""
		while not rs.eof and iCounter < iRows
				iCounter = iCounter + 1
				sMsgSerial	 = crs.GetValue("serial")
				sSender		 = crs.GetValue("sender")
				sSendTime	 = crs.GetValue("send_time")
				sReceiver	 = crs.GetValue("receiver")
				sSubject	 = crs.GetValue("subject")
				sContent	 = crs.GetValue("content")
				sFolder		 = crs.GetValue("folder")

				sFolder		 = FolderName(sFolder)

				sTemp = sTemp & _
						"<tr title=""［" & sFolder & "］" & vbLF & _
										"发件人　：" & TransEmpSerial(dbLocal, sSender) & vbLF & _
										"发送时间：" & FormatDT(sSendTime, "yyyy-mm-dd hh:mm") & vbLF & _
										"收件人　：" & TransEmpSerial(dbLocal, sReceiver) & vbLF & _
										"主　题　：" & sSubject & vbLF & _
										"内　容　：" & sContent & """" & _
										" style=""cursor:hand"" height=20" & _
										" onclick=""window.open('msg_p.asp?msg_serial=" & sMsgSerial & "&', '','width=480,height=421')"">" & vbLF & _
								"<td align=right><img border=0 src=""images/toc_endnode.gif"" height=11 width=11>&nbsp;</td>" & vbLF & _
								"<td nowrap>" & sSubject & "&nbsp;</td>" & vbLF & _
						"</tr>" & vbLF
				rs.movenext
		wend
		crs.Close()

		MsgRecords = sTemp
end function
%>