messanger.asp

来自「一个功能强大的asp招聘求职系统」· ASP 代码 · 共 667 行 · 第 1/2 页

ASP
667 行
字号
12
		ErrCodes=ErrCodes+"<li>"+Replace(template.Strings(54),"{$MaxLen}",Dvbbs.GroupSetting(34))
		Exit Sub
	Else
		message=checkXHTML(Request.form("message"))
		If message <>"" Then
			ErrCodes=ErrCodes+"<li>"& message
		Exit Sub
		End If
		message=Request.form("message")
		message=Dvbbs.checkStr(message)
	End If

	Dim InceptName,SendNum
	SendNum = 0
	FOR i=0 TO ubound(incept)
		Sql="SELECT UserName FROM [Dv_User] WHERE UserName = '"& Trim(incept(i)) &"' "
		Set Rs=Dvbbs.Execute(Sql)
		If Rs.eof And Rs.bof Then
			ErrCodes=ErrCodes+"<li>"+template.Strings(35):Exit Sub
		ELSE
			InceptName=RS(0)
		End If
		Rs.close
		If CHKHateName(InceptName) Then
			ErrCodes=ErrCodes+"<li>"+Replace(template.Strings(64),"{$incept}",InceptName)
			Exit Sub
		Else
			If Request.Form("sms_act")="Sms_Issend" Then
				Sql="insert into Dv_Message (incept,sender,title,content,sendtime,flag,issend) values ('"& Dvbbs.CheckStr(InceptName) &"','"&Dvbbs.MemberName&"','"&title&"','"&message&"',"&SqlNowString&",0,1)"
				subtype=BoxName(2)		'已发送的消息
				SendNum = SendNum + 1
			ElseIf Request.Form("sms_act")="Sms_Issave" Then
				Sql="insert into Dv_Message (incept,sender,title,content,sendtime,flag,issend) values ('"& Dvbbs.CheckStr(InceptName) &"','"&Dvbbs.MemberName&"','"&title&"','"&message&"',"&SqlNowString&",0,0)"
				subtype=BoxName(4)		'发件箱
			Else
				Sql="insert into Dv_Message (incept,sender,title,content,sendtime,flag,issend) values ('"& Dvbbs.CheckStr(InceptName) &"','"&Dvbbs.MemberName&"','"&title&"','"&message&"',"&SqlNowString&",0,1)"
				subtype=BoxName(2)		'已发送的消息
				SendNum = SendNum + 1
			End If
			Dvbbs.execute(sql)
			UPDATE_User_Msg(InceptName)
		End If
		If i>Cint(Dvbbs.GroupSetting(33))-1 Then
			ErrCodes=ErrCodes+"<li>"+Replace(template.Strings(55),"{$Sms_MaxSend}",Dvbbs.GroupSetting(33))
			Exit Sub
		Exit For
		End If
	Next
	'更新用户当日发短信数据以及缓存
	If SendNum > 0 Then
		Dim iUserInfo
		iUserInfo = Dvbbs.UserToday(0) & "|" & Dvbbs.UserToday(1) + SendNum & "|" & Dvbbs.UserToday(2) &"|"& Clng(Dvbbs.UserToday(3)) &"|"& Clng(Dvbbs.UserToday(4))
		Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@usertoday").text=iUserInfo
		Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@postdata").text=""
		Dvbbs.Execute( "Update [Dv_User] Set UserToday='" & Dvbbs.CheckStr(iUserInfo) & "' Where UserID = " & Dvbbs.UserID)
	End If
	Response.Cookies("Dvbbs")=Dvbbs.Boardid
	Dvbbs.Dvbbs_Suc("<li>"+Replace(template.Strings(38),"{$SmsBOX}",subtype))
End Sub

'保存修改
Sub savedit()
Dim incept,title,message,subtype
If Clng(Dvbbs.GroupSetting(53))>0 And DateDiff("s",Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@joindate").text,Now)<Clng(Dvbbs.GroupSetting(53))*60 Then
	ErrCodes=ErrCodes+"<li>"+Replace(template.Strings(39),"{$Lim_Time}",Dvbbs.GroupSetting(53))
	Exit Sub
End If
If CheckID(id) = False Then
	ErrCodes=ErrCodes+"<li>"+template.Strings(51)
	Exit Sub
End If
If Request("touser")="" Then
	ErrCodes=ErrCodes+"<li>"+template.Strings(35)
	Exit Sub
Else
	incept=Dvbbs.checkStr(Request.Form("touser"))
End If
If Request("title")="" or Dvbbs.StrLength(Request("title")) > 50 Then
	ErrCodes=ErrCodes+"<li>"+template.Strings(53)
	Exit Sub
Else
	title=Dvbbs.checkStr(Request.Form("title"))
End If
If Request("message")="" or (Dvbbs.StrLength(Request("message")) > CLng(Dvbbs.GroupSetting(34)) And CLng(Dvbbs.GroupSetting(34)) > 0) Then
	ErrCodes=ErrCodes+"<li>"+Replace(template.Strings(54),"{$MaxLen}",Dvbbs.GroupSetting(34))
	Exit Sub
Else
	message=checkXHTML(Request.form("message"))
		If message <>"" Then
			ErrCodes=ErrCodes+"<li>"& message
		Exit Sub
		End If
		message=Request.form("message")
		message=Dvbbs.checkStr(message)
End If

Dim SendNum
SendNum = 0
Sql="SELECT UserName FROM [Dv_User] WHERE UserName='"&incept&"'"
Set Rs=Dvbbs.execute(sql)
If Rs.eof And Rs.bof Then
	ErrCodes=ErrCodes+"<li>"+template.Strings(35)
	Exit Sub
End If
Rs.close:Set Rs=Nothing
If Request("Submit")="Sms_Issend" Then
	Sql="UPDATE Dv_Message Set incept='"&incept&"',title='"&title&"',content='"&message&"',sendtime="&SqlNowString&",flag=0,issend=1 WHERE id="&Dvbbs.checkStr(id)
	subtype="发送箱"
	SendNum = 1
Else
	Sql="UPDATE Dv_Message Set incept='"&incept&"',title='"&title&"',content='"&message&"',sendtime="&SqlNowString&",flag=0,issend=0 WHERE id="&Dvbbs.checkStr(id)
	subtype="发件箱"
End If
Dvbbs.execute(sql)

'更新用户当日发短信数据以及缓存
If SendNum > 0 Then
	Dim iUserInfo
	iUserInfo = Dvbbs.UserToday(0) & "|" & Dvbbs.UserToday(1) + SendNum & "|" & Dvbbs.UserToday(2) &"|"& Clng(Dvbbs.UserToday(3)) &"|"& Clng(Dvbbs.UserToday(4))
	Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@usermsg").text=iUserInfo
	Dvbbs.Execute("Update [Dv_User] Set UserToday='" & iUserInfo & "' Where UserID = " & Dvbbs.UserID)
End If
UPDATE_User_Msg(incept)
UPDATE_User_Msg(Dvbbs.membername)
Dvbbs.Dvbbs_Suc("<li>"+Replace(template.Strings(38),"{$SmsBOX}",subtype))
End Sub

'-------------------------------------------------------------逻辑删除-----------------------------------------
'收件逻辑删除，置于回收站，入口字段DelR，可用于批量及单个删除
Sub Delinbox()
If CheckID(id) = False Then
	ErrCodes=ErrCodes+"<li>"+template.Strings(51)
else
	Dvbbs.execute("UPDATE Dv_Message Set DelR=1 WHERE incept='"&Dvbbs.MemberName&"' And id in ("&Dvbbs.checkStr(id)&")")
	Dvbbs.Dvbbs_Suc("<li>"+template.Strings(36))
	UPDATE_User_Msg(Dvbbs.membername)
End If 
End Sub

Sub AllDelinbox()
	Dvbbs.execute("UPDATE Dv_Message Set DelR=1 WHERE incept='"&Dvbbs.MemberName&"' And DelR=0")
	Dvbbs.Dvbbs_Suc("<li>"+template.Strings(36))
	UPDATE_User_Msg(Dvbbs.membername)
End Sub

'发件逻辑删除，置于回收站，入口字段DelS，可用于批量及单个删除
Sub Deloutbox()
If CheckID(id) = False Then
	ErrCodes=ErrCodes+"<meta http-equiv=refresh content=""2;URL="&Request.ServerVariables("HTTP_REFERER")&"""><li>"+template.Strings(51)&"2秒后自动返回上一页"
Else
	Dvbbs.execute("UPDATE Dv_Message Set DelS=1 WHERE sender='"&Dvbbs.MemberName&"' And issend=0 And id in ("&Dvbbs.checkStr(id)&")")
	Dvbbs.Dvbbs_Suc("<li>"+template.Strings(36))
	UPDATE_User_Msg(Dvbbs.membername)
End If
End Sub

Sub AllDeloutbox()
	Dvbbs.execute("UPDATE Dv_Message Set DelS=1 WHERE sender='"&Dvbbs.MemberName&"' And DelS=0 And issend=0")
	Dvbbs.Dvbbs_Suc("<li>"+template.Strings(36))
	UPDATE_User_Msg(Dvbbs.membername)
End Sub

'已发送逻辑删除，置于回收站，入口字段DelS，可用于批量及单个删除
'DelS：0未操作，1发送者删除，2发送者从回收站删除
Sub DelISsend()
If CheckID(id) = False Then
	ErrCodes=ErrCodes+"<meta http-equiv=refresh content=""2;URL="&Request.ServerVariables("HTTP_REFERER")&"""><li>"+template.Strings(51)&"两秒后自动返回"
Else 
	Dvbbs.execute("UPDATE Dv_Message Set DelS=1 WHERE sender='"&Dvbbs.MemberName&"' And issend=1 And id in ("&Dvbbs.checkStr(id)&")")
	Dvbbs.Dvbbs_Suc("<li>"+template.Strings(36))
	UPDATE_User_Msg(Dvbbs.membername)
End If
End Sub

'将已发送的短信移到回收站。
Sub AllDelIssend()
	Dvbbs.execute("UPDATE Dv_Message Set DelS=1 WHERE sender='"&Dvbbs.MemberName&"' And DelS=0 And issend=1")
	Dvbbs.Dvbbs_Suc("<li>"+template.Strings(36))
	UPDATE_User_Msg(Dvbbs.membername)
End Sub

'用户能完全删除收到信息和逻辑删除所发送信息，逻辑删除所发送信息设置入口字段DelS参数为2
sub Delrecycle()
If CheckID(id) = False Then
	ErrCodes=ErrCodes+"<meta http-equiv=refresh content=""2;URL="&Request.ServerVariables("HTTP_REFERER")&"""><li>"+template.Strings(51)
	Exit Sub
Else
	Dvbbs.execute("DelETE FROM Dv_Message WHERE incept='"&Dvbbs.MemberName&"' And DelR=1 And id in ("&Dvbbs.checkStr(id)&")")
	Dvbbs.execute("UPDATE Dv_Message Set DelS=2 WHERE sender='"&Dvbbs.MemberName&"' And DelS=1 And id in ("&Dvbbs.checkStr(id)&")")
	Dvbbs.Dvbbs_Suc("<li>"+template.Strings(37))
	UPDATE_User_Msg(dvbbs.membername)
End If
End Sub

'收信人回收站： incept=收信人 DelR=1
'发信人回收站： sender=收信人 DelS=2
'清空及删除回收站记录，将不在回收站的记录放到回收站内
sub AllDelrecycle()
	Dvbbs.execute("DelETE FROM Dv_Message WHERE incept='"&Dvbbs.MemberName&"' And DelR=1")	
	Dvbbs.execute("UPDATE Dv_Message Set DelS=2 WHERE sender='"&Dvbbs.MemberName&"' And DelS=1")
	'sucmsg=sucmsg+"<br>"+"<li>删除短信息成功。删除的消息将不可恢复。"
	Dvbbs.Dvbbs_Suc("<li>"+template.Strings(37))
	UPDATE_User_Msg(Dvbbs.Membername)
End Sub

'删除的消息将置于您的回收站
Sub Delete()
If CheckID(id) = False Then
	ErrCodes=ErrCodes+"<meta http-equiv=refresh content=""2;URL="&Request.ServerVariables("HTTP_REFERER")&"""><li>"+template.Strings(51)
Else
	Dvbbs.execute("UPDATE Dv_Message Set DelR=1 WHERE incept='"&Dvbbs.MemberName&"' And id="&Dvbbs.checkStr(id))
	Dvbbs.execute("UPDATE Dv_Message Set DelS=1 WHERE sender='"&Dvbbs.MemberName&"' And id="&Dvbbs.checkStr(id))
	UPDATE_User_Msg(Dvbbs.membername)
	Dvbbs.Dvbbs_Suc("<li>"+template.Strings(36))
End If
End Sub

'-------------------------------------------------------------------------------------------------------------
'显示错误信息
Sub Showerr()
Dim Show_Errmsg
	If ErrCodes<>"" Then 
		Show_Errmsg=Dvbbs.mainhtml(14)
		ErrCodes=Replace(ErrCodes,"{$color}",Dvbbs.mainSetting(1))
		Show_Errmsg=Replace(Show_Errmsg,"{$color}",Dvbbs.mainSetting(1))
		Show_Errmsg=Replace(Show_Errmsg,"{$errtitle}",Dvbbs.Forum_Info(0)&"-"&Dvbbs.Stats)
		Show_Errmsg=Replace(Show_Errmsg,"{$action}",Dvbbs.Stats)
		Show_Errmsg=Replace(Show_Errmsg,"{$ErrString}",ErrCodes)
	End If
	Response.write Show_Errmsg
End Sub

'用户好友下拉名单
Function OPTION_Friend()
DIM i
Sql="SELECT F_friend FROM Dv_Friend WHERE F_userid="&Dvbbs.userid&" ORDER BY F_addtime DESC"
Set Rs=Dvbbs.Execute(Sql)
If not Rs.eof Then
	SQL=Rs.GetRows(-1)
	Rs.Close:Set Rs=Nothing
End if
If IsArray(SQL) Then
	For i=0 To Ubound(SQL,2)
	OPTION_Friend=OPTION_Friend & "<OPTION value="""&SQL(0,i)&""">"&SQL(0,i)&"</OPTION> "
	Next
Else
	OPTION_Friend=""
End If
End Function

'黑名单验证
Function CHKHateName(name)
DIM Sql,Rs
CHKHateName=False
Sql="Select F_friend From Dv_Friend Where (F_userid="&Dvbbs.userid&" or F_username='"& Dvbbs.CheckStr(Name) &"') And F_Mod=2"
Set Rs=Dvbbs.Execute(Sql)
If not Rs.eof Then
	Sql=Rs.GetString(,, ",", "", "")
	Rs.Close:Set Rs=Nothing
	If instr(Sql,name) or instr(Sql,Dvbbs.Membername) Then CHKHateName=True
End If
End Function

'更新用户短信通知信息（新短信条数||新短讯ID||发信人名）
Sub UPDATE_User_Msg(username)
	Dim msginfo,i,UP_UserInfo,newmsg
	newmsg=newincept(username)
	If newmsg>0 Then
		msginfo=newincept(username) & "||" & inceptid(1,username) & "||" & inceptid(2,username)
	Else
		msginfo="0||0||null"
	End If
	Dvbbs.execute("UPDATE [Dv_User] Set UserMsg='"&Dvbbs.CheckStr(msginfo)&"' WHERE username='"&Dvbbs.CheckStr(username)&"'")
	If username=Dvbbs.MemberName Then
		Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@usermsg").text=msginfo
	Else
		Call Dvbbs.NeedUpdateList(username,1)
	End If
End Sub

'统计留言
Function newincept(iusername)
Dim Rs
Rs=Dvbbs.execute("SELECT Count(id) FROM Dv_Message WHERE flag=0 And issend=1 And DelR=0 And incept='"& Dvbbs.CheckStr(iusername) &"'")
    newincept=Rs(0)
	Set Rs=nothing
	If isnull(newincept) Then newincept=0
End Function

Function inceptid(stype,iusername)
	Set Rs=Dvbbs.execute("SELECT top 1 id,sender FROM Dv_Message WHERE flag=0 And issend=1 And DelR=0 And incept='"& Dvbbs.CheckStr(iusername) &"'")
	If not rs.eof Then
		If stype=1 Then
			inceptid=Rs(0)
		Else
			inceptid=Rs(1)
		End If
	Else
		If stype=1 Then
			inceptid=0
		Else
			inceptid="null"
		End If
	End If
	Set Rs=nothing
End Function

Function Get_ForumCSS()
	Dim Sid
	sid = Request.Cookies("skin")("skinid_0")
	If Not IsNumeric(sid) Or sid = "" Then Sid=Application(Forum_CacheName & "_Dv_Setup")(17,0)
	Get_ForumCSS=Application(Forum_CacheName &"_Forum_CSS"&Sid)
End Function  

Function CheckID(CHECK_ID)
	Dim Delid,Fixid
	CheckID=True
	Delid=replace(CHECK_ID,"'","")
	Delid=replace(Delid,";","")
	Delid=replace(Delid,"--","")
	Delid=replace(Delid,")","")
	Fixid=replace(Delid,",","")
	Fixid=Trim(replace(fixid," ",""))
	If Delid="" or isnull(Delid) Then  CheckID=False
	If Not IsNumeric(fixid) Then CheckID=False
End Function

Function EncodeJS(str)
EncodeJS = Replace(Replace(Replace(Replace(Replace(str,chr(10),""),"\","\\"),"'","\'"),VbCrLf,"\n"),chr(13),"")
End Function

%>
12

messanger.asp - 源码说明

本页面展示了「一个功能强大的asp招聘求职系统」中的 messanger.asp 源码文件，采用 ASP 编程语言编写，共 667 行代码。您可以在线阅读完整代码内容，也可以返回资源详情页下载完整源码包进行本地学习和开发。

虫虫开发者社区收录了大量与ASP相关的技术资源，包括源代码、技术文档、电路图等，是电子工程师和嵌入式开发者的专业学习平台。

⌨️ 快捷键说明

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