📄 user_friend_code.asp
字号:
End If
Response.Write "</td>"
Response.Write " <td align='center'>"
Response.Write "<a href='User_Message.asp?Action=New&inceptUser=" & rsFriend("FriendName") & "'>发短消息</a>"
Response.Write "</td>"
Response.Write "</tr>"
FriendNum = FriendNum + 1
If FriendNum >= MaxPerPage Then Exit Do
rsFriend.MoveNext
Loop
End If
rsFriend.Close
Set rsFriend = Nothing
Response.Write "</table>"
Response.Write "<table width='100%' border='0' cellpadding='0' cellspacing='0'>"
Response.Write " <tr>"
Response.Write " <td width='200' height='30'><input name='chkAll' type='checkbox' id='chkAll' onclick='CheckAll(this.form)' value='checkbox'>选中本页显示的所有用户</td><td>"
Response.Write "<input name='submit1' type='submit' value='删除选定的用户' onClick=""document.myform.Action.value='DelFriend'"" >"
Response.Write " <select name='GroupID'>" & vbCrLf
Response.Write "<option value=''>将选定的用户移动到...</option>"
For i = UBound(GetFriendGroup) To 0 Step -1
Response.Write "<option value='" & i & "'>" & GetFriendGroup(i) & "</option>"
Next
Set rsGroup = Nothing
Response.Write " </select>" & vbCrLf
Response.Write " <input name='submit1' type='submit' value='移动' onClick=""document.myform.Action.value='Move'"" >"
Response.Write "<input name='Action' type='hidden' id='Action' value=''>"
Response.Write " </td></tr>"
Response.Write "</table>"
Response.Write "</td>"
Response.Write "</form></tr></table>"
Response.Write ShowPage(strFileName, totalPut, MaxPerPage, CurrentPage, True, True, "个用户", True)
End Sub
Sub SaveNewFriend()
Dim FriendName, GroupID, rsFriendName, rsFriend, sqlFriend, rsFriendExist, i
FriendName = ReplaceBadChar(Request.Form("FriendName"))
GroupID = Request.Form("GroupID")
If FriendName = "" Then
FoundErr = True
ErrMsg = ErrMsg & "<li>成员用户名不能为空！</li>"
Exit Sub
End If
If GroupID = "" Then
FoundErr = True
ErrMsg = ErrMsg & "<li>成员组ID不能为空！</li>"
Exit Sub
Else
GroupID = PE_CLng(GroupID)
End If
FriendName = Split(FriendName, ",")
Dim strTemp
For i = 0 To UBound(FriendName)
If strTemp = "" Then
strTemp = FriendName(i)
Else
If FoundInArr(strTemp, FriendName(i), ",") = False And FriendName(i) <> UserName Then
strTemp = strTemp & "," & FriendName(i)
End If
End If
Next
FriendName = Split(strTemp, ",")
Set rsFriend = Server.CreateObject("adodb.recordset")
sqlFriend = "select * from PE_Friend"
rsFriend.open sqlFriend, Conn, 1, 3
For i = 0 To UBound(FriendName)
If i >= 5 Then
FoundErr = True
ErrMsg = ErrMsg & "<li>最多只能发送给6个用户，您的名单5位以后的请重新添加！</li>"
Exit For
End If
Set rsFriendName = Conn.Execute("select UserName From PE_User Where UserName='" & FriendName(i) & "'")
If rsFriendName.BOF And rsFriendName.EOF Then
FoundErr = True
ErrMsg = ErrMsg & "<li>添加的用户名不存在！</li>"
Exit Sub
End If
Set rsFriendExist = Conn.Execute("select UserName From PE_Friend Where FriendName='" & FriendName(i) & "' and UserName='" & UserName & "'")
If Not (rsFriendExist.BOF And rsFriendExist.EOF) Then
FoundErr = True
ErrMsg = ErrMsg & "<li>禁止重复添加用户！</li>"
Exit Sub
End If
rsFriend.addnew
rsFriend("UserName") = UserName
rsFriend("FriendName") = FriendName(i)
rsFriend("AddTime") = Now()
rsFriend("GroupID") = GroupID
rsFriend.Update
Next
Set rsFriend = Nothing
Call WriteSuccessMsg("添加成功！", "User_Friend.asp")
End Sub
Sub AddFriend()
Dim sqlGroup, rsGroup, GetFriendGroup, i, strHTML
strHTML = "<script language=javascript>" & vbCrLf
strHTML = strHTML & "function CheckSubmit(){" & vbCrLf
strHTML = strHTML & " if(document.form1.FriendName.value==''){" & vbCrLf
strHTML = strHTML & " alert('成员用户名不能为空！');" & vbCrLf
strHTML = strHTML & " document.form1.FriendName.focus();" & vbCrLf
strHTML = strHTML & " return false;" & vbCrLf
strHTML = strHTML & " }" & vbCrLf
strHTML = strHTML & "}" & vbCrLf
strHTML = strHTML & "</script>" & vbCrLf
strHTML = strHTML & "<form method='post' action='User_Friend.asp' name='form1' onSubmit='javascript:return CheckSubmit();'>" & vbCrLf
strHTML = strHTML & " <br> <table width='100%' border='0' align='center' cellpadding='2' cellspacing='1' class='border'>" & vbCrLf
strHTML = strHTML & " <tr class='title'>" & vbCrLf
strHTML = strHTML & " <td height='22' colspan='2'><div align='center'>添 加 成 员</div></td>" & vbCrLf
strHTML = strHTML & " </tr>" & vbCrLf
strHTML = strHTML & " <tr class='tdbg'>" & vbCrLf
strHTML = strHTML & " <td width='25%' class='tdbg5' align='right'>成员用户名：</td>" & vbCrLf
strHTML = strHTML & " <td> <input name='FriendName' type='text' id='FriendName' size='25' maxlength='30'> <font color='#FF0000'>*</font></td>" & vbCrLf
strHTML = strHTML & " </tr>" & vbCrLf
strHTML = strHTML & " <tr class='tdbg'>" & vbCrLf
strHTML = strHTML & " <td width='25%' class='tdbg5' align='right'>成 员 组：</td>" & vbCrLf
strHTML = strHTML & " <td> <select name='GroupID'>" & vbCrLf
sqlGroup = "select UserFriendGroup from PE_User where UserName='" & UserName & "'"
Set rsGroup = Conn.Execute(sqlGroup)
If rsGroup.BOF And rsGroup.EOF Then
FoundErr = True
ErrMsg = ErrMsg & "<li>用户未登陆或用户名错误！</li>"
Exit Sub
Else
If rsGroup(0) = "" Or IsNull(rsGroup(0)) Then
FoundErr = True
ErrMsg = ErrMsg & "<li>数据库信息错误或删除了网站默认组！</li>"
Exit Sub
Else
GetFriendGroup = Split(rsGroup(0), "$")
End If
If UBound(GetFriendGroup) < 1 Then
FoundErr = True
ErrMsg = ErrMsg & "<li>数据库信息错误或删除了默认组！</li>"
Exit Sub
End If
End If
For i = UBound(GetFriendGroup) To 0 Step -1
If i = UBound(GetFriendGroup) Then
strHTML = strHTML & "<option value='" & i & "' selected>" & GetFriendGroup(i) & "</option>"
Else
strHTML = strHTML & "<option value='" & i & "'>" & GetFriendGroup(i) & "</option>"
End If
Next
Set rsGroup = Nothing
strHTML = strHTML & " </select> <font color='#FF0000'>*</font></td>" & vbCrLf
strHTML = strHTML & " </tr>" & vbCrLf
strHTML = strHTML & " <tr class='tdbg'>" & vbCrLf
strHTML = strHTML & " <td align='center' colspan='2'>" & vbCrLf
strHTML = strHTML & " <input type='hidden' name='Action' value='SaveNewFriend'>" & vbCrLf
strHTML = strHTML & " <input type='submit' value='添加成员'>" & vbCrLf
strHTML = strHTML & " <input type='button' name='cancel' value=' 取 消 ' onClick=""JavaScript:window.location.href='User_Friend.asp'"">" & vbCrLf
strHTML = strHTML & " </td>" & vbCrLf
strHTML = strHTML & " </tr>" & vbCrLf
strHTML = strHTML & " </table></form>" & vbCrLf
strHTML = strHTML & " <br>" & vbCrLf
strHTML = strHTML & " <b> 注：</b><br>" & vbCrLf
strHTML = strHTML & " 1、可以用英文状态下的逗号将用户名隔开实现添加多个用户，最多<b>5</b>个用户。<br> 2、已经添加过的成员，不允许重复添加。" & vbCrLf
Response.Write strHTML
End Sub
Sub CreateNewGroup()
Response.Write "<script language=javascript>" & vbCrLf
Response.Write "function CheckSubmit(){" & vbCrLf
Response.Write " if(document.form1.GroupName.value==''){" & vbCrLf
Response.Write " alert('新创建的组名称不能为空！');" & vbCrLf
Response.Write " document.form1.GroupName.focus();" & vbCrLf
Response.Write " return false;" & vbCrLf
Response.Write " }" & vbCrLf
Response.Write "}" & vbCrLf
Response.Write "</script>" & vbCrLf
Response.Write "<form method='post' action='User_Friend.asp' name='form1' onSubmit='javascript:return CheckSubmit();'>" & vbCrLf
Response.Write " <br><table width='100%' border='0' align='center' cellpadding='2' cellspacing='1' class='border'>" & vbCrLf
Response.Write " <tr class='title'>" & vbCrLf
Response.Write " <td height='22' colspan='2'><div align='center'>创 建 新 组</div></td>" & vbCrLf
Response.Write " </tr>" & vbCrLf
Response.Write " <tr class='tdbg'>" & vbCrLf
Response.Write " <td width='25%' class='tdbg5' align='right'>新组名称：</td>" & vbCrLf
Response.Write " <td> <input name='GroupName' type='text' id='GroupName' size='20' maxlength='20'> <font color='#FF0000'>*</font> 不超过6个汉字</td>" & vbCrLf
Response.Write " </tr>" & vbCrLf
Response.Write " <tr class='tdbg'>" & vbCrLf
Response.Write " <td align='center' colspan='2'>" & vbCrLf
Response.Write " <input type='hidden' name='Action' value='SaveNewGroup'>" & vbCrLf
Response.Write " <input type='submit' value='添加成员组'>" & vbCrLf
Response.Write " <input type='button' name='cancel' value=' 取 消 ' onClick=""JavaScript:window.location.href='User_Friend.asp'"">" & vbCrLf
Response.Write " </td>" & vbCrLf
Response.Write " </tr>" & vbCrLf
Response.Write " </table></form>" & vbCrLf
Response.Write " <br>" & vbCrLf
Response.Write " <b> 注：</b><br>" & vbCrLf
Response.Write " 网站限制创建8个分组。" & vbCrLf
End Sub
Sub SaveNewGroup()
Dim rsUserFriendGroup, GetFriendGroup, GroupName
GroupName = ReplaceBadChar(Request("GroupName"))
If GroupName = "" Then
FoundErr = True
ErrMsg = ErrMsg & "<li>新创建的组名称不能为空！</li>"
Exit Sub
End If
If GetStrLen(GroupName) > 12 Then
FoundErr = True
ErrMsg = ErrMsg & "<li>新创建的组名称不能超过6个汉字！</li>"
Exit Sub
End If
Set rsUserFriendGroup = Conn.Execute("select UserFriendGroup from PE_User where UserName='" & UserName & "'")
If rsUserFriendGroup.BOF And rsUserFriendGroup.EOF Then
FoundErr = True
ErrMsg = ErrMsg & "<li>用户未登陆或用户名错误！</li>"
Exit Sub
Else
If rsUserFriendGroup(0) = "" Or IsNull(rsUserFriendGroup(0)) Then
FoundErr = True
ErrMsg = ErrMsg & "<li>数据库信息错误或删除了网站默认组！</li>"
Exit Sub
End If
If UBound(Split(rsUserFriendGroup(0), "$")) < 1 Or UBound(Split(rsUserFriendGroup(0), "$")) > 7 Then
FoundErr = True
ErrMsg = ErrMsg & "<li>数据库信息错误或删除了网站默认组或添加组超过8个了！</li>"
Exit Sub
Else
GetFriendGroup = rsUserFriendGroup(0) & "$" & GroupName
End If
End If
Set rsUserFriendGroup = Nothing
Conn.Execute ("update PE_User set UserFriendGroup= '" & GetFriendGroup & "' where UserName='" & UserName & "'")
Response.Redirect "User_Friend.asp?Action=ManageGroup"
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -