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

📄 user_friend_code.asp

📁 个人网站比较简短
💻 ASP
📖 第 1 页 / 共 3 页
字号:
🔍
123 
End Sub

Sub ManageGroup()
    Dim rsUserFriendGroup, GetFriendGroup, j, i
    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
        Else
            GetFriendGroup = Split(rsUserFriendGroup(0), "$")
        End If
        If UBound(GetFriendGroup) < 1 Then
            FoundErr = True
            ErrMsg = ErrMsg & "<li>数据库信息错误或删除了网站默认组！</li>"
            Exit Sub
        End If
    End If
    Set rsUserFriendGroup = Nothing
    Response.Write "    <br><table width='100%' border='0' align='center' cellpadding='2' cellspacing='1' class='border'>" & vbCrLf
    Response.Write "  <tr align='center' height='22' class='title'>" & vbCrLf
    Response.Write "    <td width='60'>ID</td>" & vbCrLf
    Response.Write "    <td width='200'>成员组名</td>" & vbCrLf
    Response.Write "    <td width='80'>成员数量</td>" & vbCrLf
    Response.Write "    <td>操 作</td>" & vbCrLf
    Response.Write "  </tr>" & vbCrLf
    j = 0
'Response.Write "aaa="&Conn.Execute("select count(*) from PE_Friend where UserName='" & UserName &"' and GroupID=1")(0)
'response.end
    For i = UBound(GetFriendGroup) To 0 Step -1
        j = j + 1
        Response.Write "     <tr align='center' class='tdbg' onMouseOut=""this.className='tdbg'"" onMouseOver=""this.className='tdbg2'"">" & vbCrLf
        Response.Write "    <td width='60'>" & j & "</td>" & vbCrLf
        Response.Write "    <td width='200'>" & GetFriendGroup(i) & "</td>" & vbCrLf
        Response.Write "    <td width='80'>" & vbCrLf
        Response.Write Conn.Execute("select count(*) from PE_Friend where UserName='" & UserName & "' and GroupID=" & i & "")(0)
        Response.Write "    </td>" & vbCrLf
        If i <> 0 Then
            Response.Write "    <td><a href='User_Friend.asp?Action=ModifyGroup&GroupID=" & i & "'>修改</a>" & vbCrLf
        Else
            Response.Write "    <td><font color='#CCCCCC'>修改</font>" & vbCrLf
        End If
        If i = 0 Or i = 1 Then
            Response.Write " | <font color='#CCCCCC'>删除</font> | " & vbCrLf
        Else
            Response.Write " | <a href='User_Friend.asp?Action=DelGroup&GroupID=" & i & "' onclick=""return confirm('删除该分组后，该分组中的好友也将删除，确定要删除此组吗？');"">删除</a> | " & vbCrLf
        End If
        Response.Write "<a href='User_Friend.asp?GroupID=" & i & "'>列出名单</a></td>    </tr>" & vbCrLf
    Next
    Response.Write "    </table>" & vbCrLf
    Response.Write "    <br>" & vbCrLf
    Response.Write "    <b>&nbsp;&nbsp;注：</b><br>" & vbCrLf
    Response.Write "    &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;默认组黑名单，拒收所有来自黑名单的短信。" & vbCrLf
End Sub


Sub ModifyGroup()
    Dim GroupID, rsUserFriendGroup, GetFriendGroup
    GroupID = Request("GroupID")
    If GroupID = "" Or IsNull(GroupID) Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>成员组ID不能为空！</li>"
        Exit Sub
    Else
        GroupID = PE_CLng(GroupID)
    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
        Else
            GetFriendGroup = Split(rsUserFriendGroup(0), "$")
        End If
        If UBound(GetFriendGroup) < 1 Or UBound(GetFriendGroup) < GroupID Then
            FoundErr = True
            ErrMsg = ErrMsg & "<li>数据库信息错误或删除了默认组！</li>"
            Exit Sub
        End If
    End If
    Set rsUserFriendGroup = Nothing

    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>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<input name='GroupName' type='text' id='GroupName' value='" & GetFriendGroup(GroupID) & "' size='20' maxlength='20'>&nbsp;&nbsp;<font color='#FF0000'>*</font>&nbsp;不超过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='SaveModifyGroup'>" & vbCrLf
    Response.Write "                    <input type='hidden' name='GroupID' value='" & GroupID & "'>" & vbCrLf
    Response.Write "                    <input type='submit' value=' 修 改 '>" & vbCrLf
    Response.Write "                    <input type='button' name='cancel' value=' 取 消 ' onClick=""JavaScript:window.location.href='User_Friend.asp?Action=ManageGroup'"">" & vbCrLf
    Response.Write "                </td>" & vbCrLf
    Response.Write "            </tr>" & vbCrLf
    Response.Write "  </table></form>" & vbCrLf
End Sub

Sub DelGroup()
    Dim GroupID, rsUserFriendGroup, GroupName, GetFriendGroup
    GroupID = Request("GroupID")
    If GroupID = "" Or IsNull(GroupID) Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>成员组ID不能为空！</li>"
        Exit Sub
    Else
        GroupID = PE_CLng(GroupID)
    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
        Else
            GetFriendGroup = Split(rsUserFriendGroup(0), "$")
        End If
        If UBound(GetFriendGroup) < 1 Or UBound(GetFriendGroup) < GroupID Then
            FoundErr = True
            ErrMsg = ErrMsg & "<li>数据库信息错误或删除了默认组！</li>"
            Exit Sub
        End If
    End If
    If InStr(rsUserFriendGroup(0), "$" & GetFriendGroup(GroupID)) + Len("$" & GetFriendGroup(GroupID)) - 1 = Len(rsUserFriendGroup(0)) Then
        GroupName = Left(rsUserFriendGroup(0), InStr(rsUserFriendGroup(0), "$" & GetFriendGroup(GroupID)) - 1)
    Else
        Dim RightLength
        RightLength = Len(rsUserFriendGroup(0)) - (InStr(rsUserFriendGroup(0), "$" & GetFriendGroup(GroupID)) + Len("$" & GetFriendGroup(GroupID)) - 1)
        GroupName = Left(rsUserFriendGroup(0), InStr(rsUserFriendGroup(0), "$" & GetFriendGroup(GroupID)) - 1) & Right(rsUserFriendGroup(0), RightLength)
    End If
    Set rsUserFriendGroup = Nothing
    Conn.Execute ("update PE_User set UserFriendGroup= '" & GroupName & "' where UserName='" & UserName & "'")
    Conn.Execute ("Delete from PE_Friend Where GroupID=" & GroupID & " and UserName='" & UserName & "'")
    Call WriteSuccessMsg("删除组成功！", "User_Friend.asp")

End Sub



Sub SaveModifyGroup()
    Dim rsUserFriendGroup, GetFriendGroup, GroupName, GroupID, i
    Dim strTemp
    strTemp = ""
    GroupID = Request("GroupID")
    If GroupID = "" Or IsNull(GroupID) Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>成员组ID不能为空！</li>"
        Exit Sub
    Else
        GroupID = PE_CLng(GroupID)
    End If
    If GroupID = 0 Then
        FoundErr = True
        ErrMsg = ErrMsg & "<li>默认黑名单组禁止修改！</li>"
        Exit Sub
    End If
    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
        Else
            GetFriendGroup = Split(rsUserFriendGroup(0), "$")
        End If
        If UBound(GetFriendGroup) < 1 Or UBound(GetFriendGroup) < GroupID Then
            FoundErr = True
            ErrMsg = ErrMsg & "<li>数据库信息错误或删除了默认组！</li>"
            Exit Sub
        Else
            For i = 0 To UBound(GetFriendGroup)
                If i = GroupID Then
                    strTemp = strTemp & "$" & GroupName
                Else
                    If strTemp = "" Then
                        strTemp = GetFriendGroup(i)
                    Else
                        strTemp = strTemp & "$" & GetFriendGroup(i)
                    End If
                End If
            Next
        End If
    End If
    Set rsUserFriendGroup = Nothing
    Conn.Execute ("update PE_User set UserFriendGroup= '" & strTemp & "' where UserName='" & UserName & "'")
    Call CloseConn
    Response.Redirect "User_Friend.asp?Action=ManageGroup"
End Sub

%>
123

⌨️ 快捷键说明

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