cl_receive.asp

正版创力4.1SQL商业版!!!ASP版。

<%
'=====================================================================
'签收文章处理
'Date:2005.6.26
'By Aspoo.CN
'=====================================================================
Sub UpReceiveUser(sUser,sInfoID)
	if sUser="" then Exit Sub
	Dim sUpUser,i,Rs_Rev,sSmsBody,sqlSms
	sUpUser=Split(sUser,"|")
	Set Rs_Rev=Server.CreateObject("Adodb.RecordSet")
	for i=0 to Ubound(sUpUser)
		sUpUser(i)=Trim(sUpUser(i))
		if sUpUser(i)<>"" then
			OpenConn_U : Rs_Rev.Open "Select UserID,WaitReceive,Received From "&Db.UserTable&" where "&Db.UserName&"='"&sUpUser(i)&"'",Conn_U,1,3
			if Not (Rs_Rev.Bof and Rs_Rev.Eof) then
				Rs_Rev("WaitReceive")=AddReceive(Rs_Rev("WaitReceive"),sInfoID)
				Rs_Rev("Received")=DelReceive(Rs_Rev("Received"),sInfoID)
				Rs_Rev.Update
				sSmsBody="管理员（<font color=""#0000ff"">"&Cl.MemberName&"</font>）发表了一篇文章（"&Title&"）需要您签收！<br /><br />如现在签收，请点击下面链接查看并签收！<br /><br />查看：<a href=""" & Cl.WebDir & Cl.Channel.selectSingleNode("@channeldir").text & "/ShowInfo.asp?InfoID="&sInfoID&""" tarGet=""_blank""><font color=""#ff00ff"">"&Title&"</font></a><br />"
				sqlSms="insert into " & Db.MessageTable & " (incept,sender,title,content,sendtime,flag,issend) values ('" & sUpUser(i) & "','"&Cl.MemberName&"','签收文章通知！','"&sSmsBody&"',"&SqlNowString_U&",0,1)"
				Cl.Execute_U(sqlSms)
				Cl.Update_UserMsg(sUpUser(i))
			end if
			Rs_Rev.Close
		end if
	next
	Set Rs_Rev=Nothing
End Sub

Sub DelReceiveUser(sUser,sInfoID)
	if sUser="" then Exit Sub
	Dim sUpUser,i,Rs_Rev
	sUpUser=Split(sUser,"|")
	Set Rs_Rev=Server.CreateObject("Adodb.RecordSet")
	for i=0 to Ubound(sUpUser)
		sUpUser(i)=Trim(sUpUser(i))
		if sUpUser(i)<>"" then
			OpenConn_U : Rs_Rev.Open "Select UserID,WaitReceive,Received From "&Db.UserTable&" where "&Db.UserName&"='"&sUpUser(i)&"'",Conn_U,1,3
			if Not (Rs_Rev.Bof and Rs_Rev.Eof) then
				Rs_Rev("WaitReceive")=DelReceive(Rs_Rev("WaitReceive"),sInfoID)
				Rs_Rev("Received")=DelReceive(Rs_Rev("Received"),sInfoID)
				Rs_Rev.Update
			end if
			Rs_Rev.Close
		end if
	next
	Set Rs_Rev=Nothing
End Sub

'添加用户要签收的ID
Function AddReceive(sOReceive,sInfoID)
	Dim sTReceive
	sTReceive=Trim(sOReceive)
	sInfoID=Trim(sInfoID)
	if sTReceive="" or IsNull(sTReceive) then
		AddReceive="|"&sInfoID&"|"
		Exit Function
	end if
	sTReceive=Replace(sTReceive,"|"&sInfoID&"|","|")
	sTReceive=sTReceive&"|"&sInfoID&"|"
	sTReceive=Replace("|"&sTReceive&"|","||","|")
	sTReceive=Replace(sTReceive,"||","|")
	sTReceive=Replace(sTReceive," ","")
	AddReceive=sTReceive
End Function
'删除用户要签收的ID
Function DelReceive(sOReceive,sInfoID)
	Dim sTReceive
	sTReceive=Trim(sOReceive)
	sInfoID=Trim(sInfoID)
	if sTReceive="" or IsNull(sTReceive) or sInfoID="" then
		DelReceive=""
		Exit Function
	end if
	sTReceive=Replace(sTReceive,"|"&sInfoID&"|","|")
	sTReceive=Replace("|"&sTReceive&"|","||","|")
	sTReceive=Replace(sTReceive,"||","|")
	sTReceive=Replace(sTReceive," ","")
	if Trim(sTReceive)="|" then sTReceive=""
	DelReceive=sTReceive
End Function
'添加已签收的用户
Function AddReceiveU(sOReceive,sUserName)
	Dim sTReceive
	sTReceive=Trim(sOReceive)
	sUserName=Trim(sUserName)
	if sTReceive="" or IsNull(sTReceive) then
		AddReceiveU="|"&sUserName&"|"
		Exit Function
	end if
	sTReceive=Replace(sTReceive,"|"&sUserName&"|","|")
	sTReceive=sTReceive&"|"&sUserName&"|"
	sTReceive=Replace("|"&sTReceive&"|","||","|")
	sTReceive=Replace(sTReceive,"||","|")
	sTReceive=Replace(sTReceive," ","")
	AddReceiveU=sTReceive
End Function
'删除已签收的用户
Function DelReceiveU(sOReceive,sUserName)
	Dim sTReceive
	sTReceive=Trim(sOReceive)
	sUserName=Trim(sUserName)
	if sTReceive="" or IsNull(sTReceive) or sUserName="" then
		DelReceiveU=""
		Exit Function
	end if
	sTReceive=Replace(sTReceive,"|"&sUserName&"|","|")
	sTReceive=Replace("|"&sTReceive&"|","||","|")
	sTReceive=Replace(sTReceive,"||","|")
	sTReceive=Replace(sTReceive," ","")
	if Trim(sTReceive)="|" then sTReceive=""
	DelReceiveU=sTReceive
End Function

Function DelHeadTail(sRevID)
	Dim str
	str=Trim(sRevID)
	if left(str,1)="|" then str=right(str,len(str)-1)
	if right(str,1)="|" then str=left(str,len(str)-1)
	DelHeadTail=str
End Function

'执行签收
Sub DoReceive(sInfoID)
	if Not IsNumeric(sInfoID) then
	Call Cl.OutErr(0,"请正确选择要签收的文章ID！")
	end if
	sInfoID=Clng(Trim(sInfoID))
	Dim Rs_Rev,sql,sWaitReceive,sReceived,sUInfo
	sql="select InfoID,Receive,ReceiveUser,NotReceiveUser,Received from Cl_Article where InfoID="&Clng(sInfoID)
	Set Rs_Rev=Server.CreateObject("Adodb.recordset")
	OpenConn : Rs_Rev.open sql,conn,1,3
	if Rs_Rev.bof and Rs_Rev.eof then
		Rs_Rev.close:Set Rs_Rev=Nothing
		Call Cl.OutErr(0,"找不到指定文章！")
	end if
	if Instr(Rs_Rev("Received"),"|"&Cl.MemberName&"|")>0 and Instr(Rs_Rev("NotReceiveUser"),"|"&Cl.MemberName&"|")=0 then
		Rs_Rev.close:Set Rs_Rev=Nothing
		Call Cl.OutErr(0,"您已经签收过此文章！")
	end if
	'在未签收列表中除名并记录在已签收列表中
	Rs_Rev("NotReceiveUser")=DelReceiveU(Rs_Rev("NotReceiveUser"),Cl.MemberName)
	Rs_Rev("Received")=AddReceiveU(Rs_Rev("Received"),Cl.MemberName)
	Rs_Rev.update()
	Rs_Rev.close

	'在用户记录调整已签收和未签收文章
	OpenConn_U : Rs_Rev.Open "Select UserID,WaitReceive,Received From "&Db.UserTable&" where "&Db.UserName&"='"&Cl.MemberName&"'",Conn_U,1,3
	if Not (Rs_Rev.Bof and Rs_Rev.Eof) then
		sWaitReceive=DelReceive(Rs_Rev("WaitReceive"),sInfoID)
		sReceived=AddReceive(Rs_Rev("Received"),sInfoID)
		Rs_Rev("WaitReceive")=sWaitReceive
		Rs_Rev("Received")=sReceived
		Rs_Rev.Update
		'更新用户临时数据
		sUInfo=Session(Cl.CacheName & "UserID")
		sUInfo(28)=Trim(sWaitReceive)
		sUInfo(29)=Trim(sReceived)
		Session(Cl.CacheName & "UserID")=sUInfo
	end if
	Rs_Rev.Close
	Set Rs_Rev=Nothing
End Sub
'=====================================================================
%>