[求助]asp点歌插件无法多用户发送且判断语句不正常执行 - ASP技术论坛

问题点数：0 回复次数：0

[求助]asp点歌插件无法多用户发送且判断语句不正常执行

以下代码大致有如下问题：
1、此页有文件格式设置，如mp3等，但事实是不管用，格式不对也能发送成功；
2、多用户发送点歌祝福不成功，只为所填第一个会员成功发送。
3、超过5个用户，也不报错，且为所填第一个会员成功发送！
按道理讲，只要有判断不符合设置，都应该通过“success()”调用来显示错误信息，每条信息前都有小圆点且分行显示，但事实上远没达到所要的效果。最主要的是乍看代码，向多用户发送应该行的，但却不能成功，问题应该出在“success()”调用上，请高手帮忙！

<%
If Not BBS94KK.Founduser Then BBS94KK.GoToErr(10)
bbs94kk.head("点歌发送")
dim errmsg,isfull,Content
isfull=false
Content=Content&"<center><table border='0' width='100%' cellpadding=0 cellspacing=0 align=center><tr height='25'><td width='33.3%' align=center><a href=qq_dglistall.asp>所有点歌列表</a></td><td width='33.3%' align=center><a href=qq_dglistme.asp>我的点歌列表</a></td><td width='33.3%' align=center><a href=qq_dgwrite.asp>我要点歌</a></td></tr></table></center> "
dim lincept,lcontent,lmedianame,lurl,successmsg

'===================================================
'BY 凌峰 ,修正点歌漏洞.增加JS脚本检测函数和格式检查
'===================================================
 lincept=FilterJS(replace(Request.Form("incept"),"'",""))
 lincept=Trim(lincept)
 lcontent=FilterJS(replace(Request.Form("content"),"'",""))
 lcontent=replace(server.htmlencode(lcontent),chr(13)," ")
 lmedianame=FilterJS(replace(Request.Form("medianame"),"'",""))
 lurl=Trim(Request.Form("url"))
 lurl=FilterJS(replace(lurl,"'","''"))
 If Not CheckExt(lurl) Then
 errmsg=errmsg+" "+"<li>未支持的歌曲格式,请检查歌曲连接!"
 end if
'=====================================================

 if instr(lincept,"全体会员")>0 then
 lincept="全体会员"
 isfull=true
 else
 lincept=split(lincept,"|")
 if ubound(lincept)>=5 then
 errmsg=errmsg+" "+"<li>最多只能发送给5个用户"
 end if
 end if


 if len(lmedianame)>20 then '--------------判断名字
 errmsg=errmsg+" "+"<li>歌曲名不能多于20字"
 end if
 if len(lcontent)>50 then '--------------判断名字
 errmsg=errmsg+" "+"<li>祝福语不能多于50字" end if
 dim haverr '是否有不存在的用户
 haverr=false
 call updata()
 call CloseDB()
 call success()
bbs94kk.footer()

'===================================
sub updata()
 dim sql,rs,ii
 if isfull then
 SQL = "INSERT INTO [media] (sender,incept,content,sendtime,medianame,url)VALUES ('"& bbs94kk.myname &"','"& lincept &"','"& lcontent &"',"&dg_NowString&",'"& lmedianame &"','"& lurl &"')"
 connDG.ExeCute(SQL)
 errmsg=""
 call showmessage("点歌祝福已成功发出! <li>你向论坛所有的会员发送了点歌祝福 ","qq_dgwrite.asp")
 else
 for ii=0 to ubound(lincept)
 sql="select name from [kk_user] where name='"&lincept(ii)&"'"
 set rs=bbs94kk.Execute(Sql)
 if rs.eof and rs.bof then
 errmsg="<li>论坛没有["&lincept(ii)&"]这个用户"
 haverr=true
 else
 rs.close
 sql="select * from [kk_user] where name='"&bbs94kk.myname&"'"
 set rs=bbs94kk.Execute(Sql)
 if rs("coin")<dg_money then '此处判断使用点歌必须拥有的最低资产标准，可自行修改为你所需要的
 errmsg="您的社区币已经低于"&dg_money&"元，不能再点歌了。每点一首歌将花费您"&dg_money&"元社区币 "
 haverr=true
 else

 SQL = "INSERT INTO media (sender,incept,content,sendtime,medianame,url)VALUES ('"& bbs94kk.myname &"','"& lincept(ii) &"','"& lcontent &"',"&dg_NowString&",'"& lmedianame &"','"& lurl &"')"
 connDG.ExeCute(SQL)
 BBS94KK.Execute"update [kk_user] set coin=coin-'"&dg_money&"' where name='"&bbs94kk.myname&"'"
 dim sender,title,body
 sender=bbs94kk.myname
 title="送给您的祝福"
 body=""&bbs94kk.myname&" 点了一首歌 "&lmedianame&" 给你！"&chr(10)&"祝福语："&lcontent&" "&chr(10)&"[B][URL=qq_dglistme.asp]点击这里查看点歌[/URL][/B]"
 bbs94kk.Execute("update [kk_user] set NewSmsNum=NewSmsNum+1 where name='"&lincept(ii)&"'")
 sql="insert into [kk_sms] (name,Content,Myname) values('"&sender&"','"&body&"','"&lincept(ii)&"')"
 bbs94kk.Execute(sql)
 Call showmessage("<li>点歌祝福已成功发出!系统已向["&lincept(ii)&"]发出短消息通知，并自动扣除您金钱："&dg_money&"元！","qq_dgwrite.asp")
 Session(BBS94KK.CacheName & "MyInfo") = Empty
 rs.close
 set rs=nothing
 end if
 end if
 next
 end if
end sub

'=======================================================
'BY 凌峰 ,修正点歌漏洞.增加JS脚本检测函数和格式检查函数
'=======================================================
Function FilterJS(v)
 If Not Isnull(V) Then
 Dim t
 Dim re
 Dim reContent
 Set re=new RegExp
 re.IgnoreCase =True
 re.Global=True
 re.Pattern="(&#)"
 t=re.Replace(v,"&#")
 re.Pattern="(script)"
 t=re.Replace(t,"script")
 re.Pattern="(js:)"
 t=re.Replace(t,"js:")
 re.Pattern="(value)"
 t=re.Replace(t,"value")
 re.Pattern="(about:)"
 t=re.Replace(t,"about:")
 re.Pattern="(file:)"
 t=re.Replace(t,"file:")
 re.Pattern="(Document.cookie)"
 t=re.Replace(t,"Documents.cookie")
 re.Pattern="(vbs:)"
 t=re.Replace(t,"vbs:")
 re.Pattern="(on(mouse|Exit|error|click|key))"
 t=re.Replace(t,"on$2")
 t = Replace(t,"--","－－")
 t = Replace(t,";","；")
 t = Replace(t,",","，")
 t = Replace(t,"(","（")
 t = Replace(t,")","）")
 t = Replace(t,"0x","Ox")
 t = Replace(t,"@","＠")
 t = Replace(t,"%","％")
 t = Replace(t,"<","＜")
 t = Replace(t,">","＞")
 FilterJS=t
 Set Re=Nothing
 End If
End Function

Function CheckExt(Name)
 if Not Isnull(Name) Then
 dim temp
 temp = LCase(Right(Name,4))
 if Instr(temp,"mp3") <> 0 then
 CheckExt = True
 ElseIf Instr(temp,"mid") <> 0 then
 CheckExt = True
 ElseIf Instr(temp,"avi") <> 0 then
 CheckExt = True
 ElseIf Instr(temp,"wav") <> 0 then
 CheckExt = True
 ElseIf Instr(temp,"wma") <> 0 then
 CheckExt = True
 ElseIf Instr(temp,"swf") <> 0 then
 CheckExt = True
 ElseIf Instr(temp,"mpg") <> 0 then
 CheckExt = True
 ElseIf Instr(temp,"ram") <> 0 then
 CheckExt = True
 ElseIf Instr(temp,"asf") <> 0 then
 CheckExt = True
 ElseIf Instr(temp,"ra") <> 0 then
 CheckExt = True
 ElseIf Instr(temp,"rm") <> 0 then
 CheckExt = True
 Else
 CheckExt = False
 End If
 End If
End Function
'====================================================
'函数结束
'===================================================

sub success()
Content=Content&"<table border='0' width='100%' cellpadding=0 cellspacing=0 align=center ><tr><td width='100%'>"
if haverr then
Content=Content&"<ul>操作结果： "&errmsg&""
Else
Content=Content&"<ul>操作结果： "&errmsg&""
end if
Content=Content&"</td></tr><tr><td width='100%' align='center'><a href='javascript:history.go(-1)'> << 返回上一页</a></td></tr></table> "
Call BBS94KK.ShowTable("点歌发送情况",Content)
end sub%>

[[it] 本帖最后由 thbwn 于 2008-2-11 14:37 编辑 [/it]]

搜索更多相关主题的帖子: 语句　 asp　插件　点歌　用户　