📄 user_friend.asp
字号:
<%@LANGUAGE="VBSCRIPT" CODEPAGE="936"%>
<%option explicit%>
<!--#include file="../Conn.asp"-->
<!--#include file="../SysCls/KS_UserCommonCls.asp"-->
<%
'===================================================================================================================
'软件名称：科汛网站管理系统
'当前版本：科汛网站管理系统 V2.2 SP2 Free
'Copyright (C) 2005-2006 Kesion.Com All rights reserved.
'产品咨询QQ：9537636,41904294
'技术支持QQ：111394,54004407
'程序版权：科汛网络
'程序开发：科汛网络开发组（总策划：林文仲）
'E-Mail :kesioncms@hotmail.com webmaster@kesion.com
'官方网站：http://www.kesion.com
'演示站点：http://test.kesion.com
'郑重声明:
' ①、免费版本请在程序首页保留版权信息，并做上本站LOGO友情连接,商业版本无此要求;
' ②、任何个人或组织不得在授权允许的情况下删除、修改、拷贝本软件及其他副本上一切关于版权的信息；
' ③、科汛网络保留此软件的法律追究权利
'===================================================================================================================
Dim KSCls
Set KSCls = New User_Friend
KSCls.Execute()
Set KSCls = Nothing
Class User_Friend
Private KSCMS,KSUser
Private CurrentPage,totalPut
Private RS,MaxPerPage,SQL,tablebody,strErr,action,boxName,smscount,smstype,readaction,turl
Private ArticleStatus,ComeUrl,TotalPages
Private Sub Class_Initialize()
MaxPerPage =30
Set KSCMS=New CommonCls
Set KSUser = New UserCls
End Sub
Private Sub Class_Terminate()
Set KSCMS=Nothing
Set KSUser=Nothing
End Sub
Public Sub Execute()
ComeUrl=Request.ServerVariables("HTTP_REFERER")
IF Cbool(KSUser.UserLoginChecked)=false Then
Response.Write "<script>location.href='Login.asp';</script>"
Exit Sub
End If
KSUser.LoadHead()
%>
<TABLE height="540" cellSpacing=0 width=772 align=center border=0>
<TR>
<TD vAlign=top bgColor=#FFFFFF>
<table width="100%" border="0" cellspacing="0" cellpadding="0">
<tr>
<td height="32"> 当前位置 >> <a href="<%=KSCMS.GetConfig("WebUrl")%>"><%=KSCMS.GetConfig("WebName")%></a> >> <a href="index.asp">会员中心</a> >> 用户短消息功能 </td>
</tr>
<tr>
<td>
<%
KSUser.LoadMenu()
%>
</td>
</tr>
</table>
<%
KSUser.MessageMenu()
action=Trim(request("action"))
CurrentPage=Trim(request("page"))
if Isnumeric(CurrentPage) then
CurrentPage=Clng(CurrentPage)
else
CurrentPage=1
end if
select case action
case "info"
call info()
case "addF"
call addF()
case "saveF"
call saveF()
case "删除"
call DelFriend()
case "清空好友"
call AllDelFriend()
case else
call info()
end select
%>
</TD>
</TR>
</TABLE>
<%
KSUser.LoadFoot()
End Sub
sub info()
%>
<div align=center><span class="title">我的好友</span></div>
<table width="85%" border="0" align=center cellpadding=0 cellspacing=1 bgcolor="#efefef">
<form action="User_Friend.asp" method=post name=inbox>
<tr height="23" class="title2">
<td width="25%" height="25" align="center" bgcolor="F4F4EA">姓名</td>
<td width="25%" align="center" bgcolor="F4F4EA">邮件</td>
<td width="25%" align="center" bgcolor="F4F4EA">主页</td>
<td width="10%" align="center" bgcolor="F4F4EA">QQ</td>
<td width="10%" align="center" bgcolor="F4F4EA">发短信</td>
<td width="5%" align="center" bgcolor="F4F4EA">操作</td>
</tr>
<%
set rs=server.createobject("adodb.recordset")
sql="select F.*,U.UserID,U.Email,U.RealName,U.HomePage,U.QQ from KS_Friend F inner join KS_User U on F.Friend=U.UserName where F.Username='"&KSUser.Get_UserName&"' order by F.addtime desc"
rs.open sql,Conn,1,1
if rs.eof and rs.bof then
%>
<tr>
<td height="26" colspan=6 align=center valign=middle bgcolor="#FFFFFF">您的好友列表中没有任何内容。</td>
</tr>
<%else
do while not rs.eof
%>
<tr bgcolor=#ffffff onmouseover="this.style.background='#F5f5f5'" onmouseout="this.style.background='#FFFFFF'">
<td height="25" align=center valign=middle><a href="../ShowUser.Asp?UserID=<%=rs("U.UserID")%>" target=_blank><%=KSCMS.HTMLEncode(rs("friend"))%></a></td>
<td align=center valign=middle><a href="mailto:<%=KSCMS.HTMLEncode(rs("Email"))%>"><%=KSCMS.HTMLEncode(rs("Email"))%></a></td>
<td align=center><a href="<%=KSCMS.HTMLEncode(rs("HomePage"))%>" target=_blank><%=KSCMS.HTMLEncode(rs("HomePage"))%></a></td>
<td align=center><%=KSCMS.HTMLEncode(RS("QQ"))%></td>
<td align=center><a href="User_Message.asp?action=new&touser=<%=KSCMS.HTMLEncode(rs("friend"))%>">发送短信</a></td>
<td align=center><input type=checkbox name=id value=<%=rs("id")%>></td>
</tr>
<%
rs.movenext
loop
end if
rs.close
set rs=Nothing
%>
<tr>
<td colspan=6 align=right valign=middle bgcolor="#FFFFFF"><input type=checkbox name=chkall value=on onClick="CheckAll(this.form)">选中所有显示记录 <input type=button name=action onClick="location.href='User_Friend.asp?action=addF'" value="添加好友"> <input type=submit name=action onClick="{if(confirm('确定删除选定的纪录吗?')){this.document.inbox.submit();return true;}return false;}" value="删除"> <input type=submit name=action onClick="{if(confirm('确定清除所有的纪录吗?')){this.document.inbox.submit();return true;}return false;}" value="清空好友"></td>
</tr>
</form>
</table>
<script language=javascript>
function CheckAll(form)
{
for (var i=0;i<form.elements.length;i++) {
var e = form.elements[i];
if (e.name != 'chkall') e.checked = form.chkall.checked;
}
}
</script>
<%
end sub
sub delFriend()
dim delid
delid=replace(request.form("id"),"'","")
if delid="" or isnull(delid) then
Call KSCMS.AlertHistory("您没有选择要删除好友名单。",-1)
exit sub
else
Conn.Execute("delete from KS_Friend where username='"&KSUser.Get_UserName&"' and id in ("&delid&")")
Call KSCMS.Alert("您已经删除选定的好友记录。","User_Friend.asp")
end if
end sub
sub AllDelFriend()
Conn.Execute("delete from KS_Friend where username='"&KSUser.Get_UserName&"'")
Call KSCMS.Alert("您已经删除了所有好友列表。","User_Friend.asp")
end sub
sub addF()
call userlist()
Response.write "<div align=center style=""margin-top:5px"">"
Call KSCMS.ShowPageParamter(totalPut, MaxPerPage,"User_Friend.asp", True, "个用户", CurrentPage, "Action=" &action)
Response.write "</div>"
%>
<br>
<table border="0" align=center cellpadding=0 cellspacing=1 bgcolor="#efefef">
<form action="User_Friend.asp" method=post name=messager>
<tr>
<td height="25" colspan=2 align=center bgcolor="F4F4EA" class="title">
<input type=hidden name="action" value="saveF">
加入好友--请完整输入下列信息</td>
</tr>
<tr height=50>
<td width=70 valign=middle bgcolor="#FFFFFF"><b>好友：</b></td>
<td height="25" valign=middle bgcolor="#FFFFFF">
<input type=text name="touser" size=50 value="<%=request("myFriend")%>">
使用逗号（,）分开，最多5位用户 </td>
</tr>
<tr>
<td colspan=2 align=center valign=middle bgcolor="#FFFFFF">
<input type=Submit value="保存" name=Submit>
<input type="reset" name="Clear" value="清除">
</td>
</tr>
</form>
</table><br>
<%
end sub
sub saveF()
dim incept,i
if request("touser")="" then
Call KSCMS.AlertHistory("您忘记填写发送对象了吧。",-1)
exit sub
else
incept=KSCMS.ReplaceBadChar(request("touser"))
incept=split(incept,",")
end if
for i=0 to ubound(incept)
set rs=server.createobject("adodb.recordset")
sql="select UserName from KS_User where UserName='"&incept(i)&"'"
set rs=Conn.Execute(sql)
if rs.eof and rs.bof then
Call KSCMS.ShowError("系统没有（"&incept(i)&"）这个用户，操作未成功。")
exit sub
end if
set rs=Nothing
if KSUser.Get_UserName=Trim(incept(i)) then
Call KSCMS.ShowError("不能把自已添加为好友。")
end if
sql="select friend from KS_Friend where username='"&KSUser.Get_UserName&"' and friend='"&incept(i)&"'"
set rs=Conn.Execute(sql)
if rs.eof and rs.bof then
sql="insert into KS_Friend (username,friend,addtime) values ('"&KSUser.Get_UserName&"','"&Trim(incept(i))&"',"&Application("SqlNowString")&")"
set rs=Conn.Execute(sql)
end if
if i>5 then
Call KSCMS.ShowError("每次最多只能添加5位用户，您的名单5位以后的请重新填写。")
exit sub
exit for
end if
next
Call KSCMS.Alert("恭喜您，好友添加成功。","User_Friend.asp")
end sub
sub userlist()
Response.Write "<table bgcolor=F4F4EA width=""80%"" align=center cellpadding=2 cellspacing=1 border=0><tr class=title><td>管理员组:</td></tr></table>"
Response.Write "<table bgcolor=efefef width=""80%"" align=center cellpadding=2 cellspacing=1 border=0><tr>"
dim admin_face
sql="select UserName,Sex,qq,Email from KS_User where GroupID=4 order by UserID"
set rs=Conn.Execute(sql)
i=0
do while not rs.eof
admin_face="<img src=""Images/admin_face.gif"" width=24 height=30>"
if KSUser.Get_UserName=rs(0) then
Response.Write "<td bgcolor=ffffff width=""14%"">" & admin_face&" <a href=User_Friend.asp?action=saveF&touser="&rs(0)&" title=""管理员""><font color=""#0000ff"">"&rs(0)&"</font></a></td>"
else
Response.Write "<td bgcolor=ffffff width=""14%"">" & admin_face&" <a href=User_Friend.asp?action=saveF&touser="&rs(0)&" title=""管理员"">"&rs(0)&"</a></td>"
end if
i=i+1
if i>=6 then
Response.Write "</tr><tr>"
i=0
end if
rs.movenext
loop
Response.Write "</tr></TABLE><br>"
set rs=Nothing
Response.Write "<table bgcolor=#F4F4EA width=""80%"" align=center cellpadding=2 cellspacing=1 border=0><tr class=title><td>非管理员组:</td></tr></table>"
Response.Write "<table bgcolor=#efefef width=""80%"" align=center cellpadding=2 cellspacing=1 border=0><tr>"
dim user_face,user_info,sex,i,n
sql="select UserName,Sex,qq,Email from KS_User where GroupID<>1 order by UserID"
set rs=Server.CreateObject("adodb.recordSet")
rs.Open sql,Conn,1,1
i=0:n=0:TotalPut=0
if not (rs.bof and rs.eof) then
TotalPut=rs.recordcount
if (TotalPut mod MaxPerPage)=0 then
TotalPages = TotalPut \ MaxPerPage
else
TotalPages = TotalPut \ MaxPerPage + 1
end if
if CurrentPage > TotalPages then CurrentPage=TotalPages
if CurrentPage < 1 then CurrentPage=1
rs.move (CurrentPage-1)*MaxPerPage
do while not rs.eof
user_info="性别："& rs("sex") & vbcrlf & "Q Q："& rs("qq") & vbcrlf &"Email："& rs(3)
user_face="<img src=""images/user_face.gif"" width=12 height=11>"
if KSUser.Get_UserName=rs(0) then
Response.Write "<td height=20 bgcolor=ffffff width=""14%"">" & user_face&" <a href=User_Friend.asp?action=saveF&touser="&rs(0)&" title="""& user_info &"""><font color=""#0000ff"">"&rs(0)&"</font></a></td>"
else
Response.Write "<td height=20 bgcolor=ffffff width=""14%"">" & user_face&" <a href=User_Friend.asp?action=saveF&touser="&rs(0)&" title="""& user_info &""">"&rs(0)&"</a></td>"
end if
i=i+1
if i>=6 then
if i=6 then Response.Write "</tr><tr>"
i=0
end if
n=n+1
if n>= MaxPerPage then Exit Do
rs.movenext
loop
else
Response.Write "<td>无任何用户</td>"
end if
Response.Write "</tr></TABLE><br>"
set rs=Nothing
end sub
End Class
%>⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -