sms.asp

BBS源码 利用ASP的一个功能齐全的BBS论坛源码

<!--#include file="Inc.asp"-->
<!--#include file="Inc/Page_Cls.asp"-->
<!--#include file="inc/ubb_Cls.asp"-->
<SCRIPT src="inc/Fun.js"></SCRIPT>
<%
Dim Action,AllSmsSize,ID,BBS94KK_Ubb
If Not BBS94KK.FoundUser Then BBS94KK.GoToErr(10)
BBS94KK.Position=BBS94KK.Position&" → <a href=UserInfo.asp>用户控制面版<a>"
Call BBS94KK.Head("处理信件")
Response.Write(ShowMyInfo())
ID=BBS94KK.CheckNum(request.querystring("ID"))
Action=Lcase(Request.querystring("Action"))
Select Case Action
Case"save"
	SaveSms
Case"del"
	Dim Temp
	Temp=Len(BBS94KK.execute("Select Content From [KK_Sms] where ID="&ID&" and MyName='"&BBS94KK.MyName&"'")(0))
	BBS94KK.execute("Delete From [KK_sms] where ID="&ID&" and MyName='"&BBS94KK.MyName&"'")
	BBS94KK.Execute("Update [KK_User] set SmsSize=SmsSize-"&Temp&" where Name='"&BBS94KK.MyName&"'")
	Response.redirect Request.ServerVariables("HTTP_REFERER")
Case"delall"
	'Temp=BBS94KK.Execute("select count(ID) From[KK_Sms] where MyName='"&MyName&"'")(0)
	BBS94KK.Execute("Delete From[KK_sms] where MyName='"&BBS94KK.MyName&"'")
	BBS94KK.Execute("Update [KK_User] set SmsSize=0 where Name='"&BBS94KK.MyName&"'")
	Session(BBS94KK.CacheName & "MyInfo") = Empty
	Response.Redirect Request.ServerVariables("HTTP_REFERER")
Case"write"
	WriteSms
Case Else
	Set BBS94KK_ubb=New BBS94KKubb_Cls
	ReadSms
	Set BBS94KK_ubb=Nothing
End Select
BBS94KK.Footer()
Set BBS94KK=Nothing


Sub ShowMySmsInfo()
	Dim SmsSize,content
	If BBS94KK.MyAdmin=1 then 
		SmsSize=100
	ElseIf BBS94KK.MyAdmin=2 then
		SmsSize=50
	ElseIf BBS94KK.MyAdmin=3 then
		SmsSize=25
	Else
		SmsSize=10
	End if
	SmsSize=SmsSize*1024
	AllSmsSize=int(BBS94KK.MySmsSize)/SmsSize*100
	If AllSmsSize>100 Then AllSmsSize=100
	IF AllSmsSize<0 Then AllSmsSize=0
	IF AllSmsSize>0 And AllSmsSize<1 Then AllSmsSize=1
	Content="<table border=0 height=40><tr><td width='35%'>&nbsp;<a href='Sms.asp'><img src='Images/sms.gif' width='16' height='16' border='0'> 收取留言</a>&nbsp;<a href='?Action=write'><img border='0' src='Images/xie.gif'> 写新留言</a>&nbsp;<a onclick=checkclick('按确定将清空邮箱的信件！！\n\n您确定要删除吗？') href='Sms.asp?Action=delall'><img src='Images/del.gif' width='18' height='18' border='0'> 清空留言板</a></td><td width='13%' align='right'>信箱容量：</td><td width='12%'><table width='250' height='10' border='1' cellpadding='0' cellspacing='0' style='TABLE-LAYOUT: fixed; WORD-BREAK: break-all;border-collapse:collapse' bordercolor='#006699' bgcolor='#C8E9FB'><tr><td width='250'><img src='Images/hr1.gif' width='"&int(BBS94KK.MySmsSize)/SmsSize*250&"' height='10'></td></tr></table></td><td width='13%'>已使用 <font color=red>"&Int(AllSmsSize)&" </font>%</td><tr></table>"
Call BBS94KK.ShowTable("论坛留言信箱",Content)
End Sub



Sub ReadSms()
  Dim Temp,Content,CanWrite,UserPic,Rs,Pages,strPageInfo,intPageNow,Arr_Rs,I,Caption
  	BBS94KK.ExeCute("Update [KK_user] Set NewSmsNum=0 Where Name='"&BBS94KK.MyName&"'")
	intPageNow = Request.QueryString("page")
	Set Pages = New Cls_PageView
	Pages.strTableName = "[KK_Sms]"
	Pages.strFieldsList = "ID,name,Content,Addtime,IsNew,UbbString"
	Pages.strCondiction = "MyName='"&BBS94KK.MyName&"'"
	Pages.strOrderList = "ID desc"
	Pages.strPrimaryKey = "ID"
	Pages.intPageSize = 10
	Pages.intPageNow = intPageNow
	Pages.strCookiesName = "Sms"&BBS94KK.MyName'客户端记录总数
	Pages.Reloadtime=3'每三分钟更新Cookies
	Pages.strPageVar = "page"
	Pages.InitClass
	Arr_Rs = Pages.arrRecordInfo
	strPageInfo = Pages.strPageInfo
	Set Pages = nothing
	If IsArray(Arr_Rs) Then
	For i = 0 to UBound(Arr_Rs, 2)
	BBS94KK_ubb.UbbString=Arr_Rs(5,I)
	Set Rs=BBS94KK.execute("select top 1 IsQQpic,QQ,Pic,PicW,PicH from [KK_User] where Name='"&Arr_Rs(1,I)&"'")
	 If Not Rs.eof then
		 CanWrite=True
		IF rs("IsQQpic") then
			UserPic="<img src='http://qqshow-user.tencent.com/"&Rs("QQ")&"/11/'>"
		Else
			UserPic="<img border='0' src='"&rs("pic")&"' width='"&rs("picw")&"' height='"&rs("pich")&"'>"
		End If
	Else
		CanWrite=False
		UserPic="<img src=Images/AutoSms.gif border=0 >"
	End if
	Rs.Close
	Temp="<tr onmouseover=javascript:this.bgColor='#FCFFEC' onmouseout=javascript:this.bgColor=''><td width='20%' valign='top'><table border='0' cellpadding='0' cellspacing='5' style='border-collapse: collapse' width='100%'><tr><td width='100%' align='center' >"
	Temp=Temp&"<b>"&Arr_Rs(1,I)&"</b><br>"&UserPic&"</td></tr></table></td><td width='80%' valign='top'><table border='0' cellpadding='0' cellspacing='0' style='border-collapse: collapse'  width='100%' height='25'><tr><td width='100%'>"
	IF CanWrite Then Temp=Temp&"<a href='UserInfo.asp?Name="&Arr_Rs(1,I)&"'><img  border='0' src='images/info.GIF'></a> <a href='?Action=Write&Name="&Arr_Rs(1,I)&"'><img border='0' src='images/newmail.gif'></a> <a href='?Action=write&Name="&Arr_Rs(1,I)&"&id="&Arr_Rs(0,I)&"'><img border='0' src='Images/reply.gif'></a> "
	Temp=Temp&"<a onclick=checkclick('按确定将删除这条留言！！\n\n您确定要删除吗？') href='?id="&Arr_Rs(0,I)&"&Action=del'><img border='0' alt='删除' src='Images/del.gif'></a></td></tr></table><hr width='98%' size='1'><blockquote>"
	IF Arr_Rs(4,I) Then Temp=Temp&"<img src='Images/New.Gif' alt='新的留言' >"
	Temp=Temp&"<SPAN style='line-height:150%;table-layout:fixed;word-wrap:break-word;word-break:break-all;width:100%'><img src='Images/tl.gif' border='0'> "&BBS94KK_Ubb.UBB(Arr_Rs(2,I),2)&"</span><p></p><div align=right><img src='Images/xie.gif' border='0'> 留言时间： "&Arr_Rs(3,I)&"</div></blockquote></td></tr>"
	Content=Content&Temp
	Next
	Content=Content&"<tr><td colspan='2' height=25>"&strPageInfo
	End If
	BBS94KK.Execute("Update [KK_Sms] Set IsNew=False where MyName='"&BBS94KK.MyName&"'")
	Caption="收取留言"
	ShowMySmsInfo()
	Call BBS94KK.ShowTable(Caption,Content)
End Sub

Sub WriteSms()
	Dim Name,Rs,Caption,Content
	If AllSmsSize=100 Then
		Caption="系统警告":Content="<br><P>&nbsp;&nbsp;亲爱的用户，您的论坛留言信箱容量已满，请尽快删除一些信件！</p><br>"
	Else
		Name=request.querystring("Name")
		If Not BBS94KK.Fun.CheckName(Name) Then BBS94KK.GoToErr(1)
		Set Rs=BBS94KK.execute("select Content from [KK_sms] where name='"&Name&"' and Id="&ID&"")
		if not Rs.eof then 
		Temp=Rs("Content")
		Temp=vbcrlf & vbcrlf& vbcrlf &"============在 "&Name&" 的来信中提到=========="& vbcrlf&BBS94KK.Fun.StrLeft(Temp,250)&""
		End if
		Rs.Close
		ShowMySmsInfo()
		Caption="发送留言"
		If BBS94KK.BbsCache(18)>0 Then Caption=Caption & " [每次发送将收取您的金钱"&BBS94KK.BbsCache(18)&"元]"
		Content="</tr><tr><td><form method=POST name=kk action='?Action=save' name=kbbs><p style='margin: 10'>留言对象：<input class=submit type=text name='name' size=20 value='"&Name&"'><p style='margin: 10'>功能按钮：<img onClick=Cbold() <img src=""Pic/Ubb/U_1.gif""  border=0 alt=粗体字> <img src=""Pic/Ubb/U_2.gif"" onClick=Citalic() border=0 alt=斜体字 > <img src=""Pic/Ubb/U_3.gif"" onClick=Cunder() border=0 alt=下划线> "&_
				"<img src=""Pic/Ubb/U_4.gif"" onClick=center() border='0' alt='居中'> <img src=""Pic/Ubb/U_5.gif"" onClick=fly() border=0 alt=飞行字> <img src=""Pic/Ubb/U_6.gif"" onClick=move() border=0 alt=移动字> <img src=""Pic/Ubb/U_7.gif"" onClick=Insert(""[light]内容[/light]"") border=0 alt=发光字> <img src=""Pic/Ubb/U_8.gif"" onClick=ying() border=0 alt=阴影字> <img src=""Pic/Ubb/U_9.gif"" onClick=Curl() border='0' alt='超连接'> <img src=""Pic/Ubb/U_10.gif"" onClick=Cemail() border='0' alt='Email连接'> <img src=""Pic/Ubb/U_11.gif"" onClick=showpic() border='0' alt='更多的心情图片'> <img src=""Pic/Ubb/U_12.gif"" onClick=image() border=0 alt=图片> <img src=""Pic/Ubb/U_13.gif"" onClick=swf() border=0 alt=Flash动画 > <img onClick=Cwmv()  src=""Pic/Ubb/U_14.gif"" border=0 alt='Media Player视频文件'> <img src=""Pic/Ubb/U_15.gif"" onClick=Crm() border=0 alt=realplay视频文件>  <img onClick=Csound() src=""Pic/Ubb/U_16.gif"" border='0' alt='插入背景音乐'> "&_
				"<p style='margin: 10'><textarea onkeydown=presskey(); rows=9 name='content' cols=90>"&Temp&"</textarea><p style='margin: 10'><input type='submit' value=' 发 送 '> <input type='reset' value=' 重 置 '> [按  Ctrl+Enter 直接发送]</form><div id='MaoDiv' style='position: absolute; width:570px; height:160px; display:none;'><iframe id='MView' name='MView' src='about:blank' frameborder='0' scrolling='no' valign='top' width='100%' height='100%'></iframe></div>"
	End If
	Call BBS94KK.ShowTable(Caption,Content)
End Sub

Sub SaveSms()
	If int(BBS94KK.MyCoin)<int(BBS94KK.BbsCache(18)) Then BBS94KK.GoToErr(58)
	Dim Temp,Content,Caption,ToName,TmpUbbString
	BBS94KK.Fun.CheckMake()
	If Session(BBS94KK.CacheName&"SmsTime")+1/1440>now() then BBS94KK.GoToErr(42)
	ToName=BBS94KK.Fun.GetStr("Name")
	Content=BBS94KK.Fun.GetStr("Content")
	If ToName="" or Content=""  then BBS94KK.GoToErr(40)
	TmpUbbString=BBS94KK.Fun.UbbString(Content)
	If Not BBS94KK.Fun.CheckName(ToName) Then BBS94KK.GoToErr(41)
	IF Len(Content)>1000 Then BBS94KK.GoToErr(18)
	If BBS94KK.execute("select Name From [KK_User] where name='"&ToName&"'").eof Then BBS94KK.GoToErr(41)
	BBS94KK.execute("insert into [KK_sms](name,Content,Myname,ubbString)values('"&BBS94KK.MyName&"','"&Content&"','"&ToName&"','"&TmpUbbString&"')")
	BBS94KK.execute("update [KK_user] Set Coin=Coin-"&int(BBS94KK.BbsCache(18))&" where Name='"&BBS94KK.MyName&"'")
	BBS94KK.ExeCute("Update [KK_user] Set NewSmsNum=NewSmsNum+1,SmsSize=SmsSize+"&Len(Content)&" Where Name='"&ToName&"'")
	Session(BBS94KK.CacheName&"SmsTime")=Now()
	Caption="留 言 成 功"
	Content="<Div style='margin:15;line-height: 150%'><li>已经成功的给 <b>"&ToName&"</b> 留言<li>本站扣除您的手续费 <b>"&BBS94KK.BbsCache(18)&"元</b><li><a href=index.asp>返回首页</a> ·<a href=Sms.asp>返回我的信箱</a></Div>"
	Call BBS94KK.ShowTable(Caption,Content)
End Sub
Function ShowMyInfo()
	Response.Write BBS94KK.Template.ReadTemplate("用户控制面版")
End Function
%>