[求助]asp点歌插件无法多用户发送且判断语句不正常执行
以下代码大致有如下问题：1、此页有文件格式设置，如mp3等，但事实是不管用，格式不对也能发送成功；
2、多用户发送点歌祝福不成功，只为所填第一个会员成功发送。
3、超过5个用户，也不报错，且为所填第一个会员成功发送！
按道理讲，只要有判断不符合设置，都应该通过“success()”调用来显示错误信息，每条信息前都有小圆点且分行显示，但事实上远没达到所要的效果。最主要的是乍看代码，向多用户发送应该行的，但却不能成功，问题应该出在“success()”调用上，请高手帮忙！
<!--#include file="inc.asp"-->
<!--#include file="qq_dgconn.asp"-->
<!--#include file="qq_ClsMain.asp"-->
<%
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><b>所有点歌列表</b></a></td><td width='33.3%' align=center><a href=qq_dglistme.asp><b>我的点歌列表</b></a></td><td width='33.3%' align=center><a href=qq_dgwrite.asp><b>我要点歌</b></a></td></tr></table></center><br>"
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+"<br>"+"<li>未支持的歌曲格式,请检查歌曲连接!"
end if
'=====================================================
if instr(lincept,"全体会员")>0 then
lincept="全体会员"
isfull=true
else
lincept=split(lincept,"|")
if ubound(lincept)>=5 then
errmsg=errmsg+"<br>"+"<li>最多只能发送给5个用户"
end if
end if
if len(lmedianame)>20 then '--------------判断名字
errmsg=errmsg+"<br>"+"<li>歌曲名不能多于20字"
end if
if len(lcontent)>50 then '--------------判断名字
errmsg=errmsg+"<br>"+"<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("点歌祝福已成功发出!<br><li>你向论坛所有的会员发送了点歌祝福<br>","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>论坛没有<font color=red>["&lincept(ii)&"]</font>这个用户"
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="您的社区币已经低于<font color=#FF0000>"&dg_money&"</font>元，不能再点歌了。每点一首歌将花费您<font color=#FF0000>"&dg_money&"</font>元社区币<br>"
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>点歌祝福已成功发出!系统已向<font color=green>["&lincept(ii)&"]</font>发出短消息通知，并自动扣除您金钱：<font color=#FF0000>"&dg_money&"</font>元！","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,"<I>&#</I>")
re.Pattern="(script)"
t=re.Replace(t,"<I>script</I>")
re.Pattern="(js:)"
t=re.Replace(t,"<I>js:</I>")
re.Pattern="(value)"
t=re.Replace(t,"<I>value</I>")
re.Pattern="(about:)"
t=re.Replace(t,"<I>about:</I>")
re.Pattern="(file:)"
t=re.Replace(t,"<I>file:</I>")
re.Pattern="(Document.cookie)"
t=re.Replace(t,"<I>Documents.cookie</I>")
re.Pattern="(vbs:)"
t=re.Replace(t,"<I>vbs:</I>")
re.Pattern="(on(mouse|Exit|error|click|key))"
t=re.Replace(t,"<I>on$2</I>")
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><b>操作结果：</b><br>"&errmsg&""
Else
Content=Content&"<ul><b>操作结果：</b><br>"&errmsg&""
end if
Content=Content&"</td></tr><tr><td width='100%' align='center'><a href='javascript:history.go(-1)'> << 返回上一页</a></td></tr></table><br>"
Call BBS94KK.ShowTable("点歌发送情况",Content)
end sub%>
<!--#include file="qq_dgconn.asp"-->
<!--#include file="qq_ClsMain.asp"-->
<%
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><b>所有点歌列表</b></a></td><td width='33.3%' align=center><a href=qq_dglistme.asp><b>我的点歌列表</b></a></td><td width='33.3%' align=center><a href=qq_dgwrite.asp><b>我要点歌</b></a></td></tr></table></center><br>"
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+"<br>"+"<li>未支持的歌曲格式,请检查歌曲连接!"
end if
'=====================================================
if instr(lincept,"全体会员")>0 then
lincept="全体会员"
isfull=true
else
lincept=split(lincept,"|")
if ubound(lincept)>=5 then
errmsg=errmsg+"<br>"+"<li>最多只能发送给5个用户"
end if
end if
if len(lmedianame)>20 then '--------------判断名字
errmsg=errmsg+"<br>"+"<li>歌曲名不能多于20字"
end if
if len(lcontent)>50 then '--------------判断名字
errmsg=errmsg+"<br>"+"<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("点歌祝福已成功发出!<br><li>你向论坛所有的会员发送了点歌祝福<br>","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>论坛没有<font color=red>["&lincept(ii)&"]</font>这个用户"
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="您的社区币已经低于<font color=#FF0000>"&dg_money&"</font>元，不能再点歌了。每点一首歌将花费您<font color=#FF0000>"&dg_money&"</font>元社区币<br>"
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>点歌祝福已成功发出!系统已向<font color=green>["&lincept(ii)&"]</font>发出短消息通知，并自动扣除您金钱：<font color=#FF0000>"&dg_money&"</font>元！","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,"<I>&#</I>")
re.Pattern="(script)"
t=re.Replace(t,"<I>script</I>")
re.Pattern="(js:)"
t=re.Replace(t,"<I>js:</I>")
re.Pattern="(value)"
t=re.Replace(t,"<I>value</I>")
re.Pattern="(about:)"
t=re.Replace(t,"<I>about:</I>")
re.Pattern="(file:)"
t=re.Replace(t,"<I>file:</I>")
re.Pattern="(Document.cookie)"
t=re.Replace(t,"<I>Documents.cookie</I>")
re.Pattern="(vbs:)"
t=re.Replace(t,"<I>vbs:</I>")
re.Pattern="(on(mouse|Exit|error|click|key))"
t=re.Replace(t,"<I>on$2</I>")
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><b>操作结果：</b><br>"&errmsg&""
Else
Content=Content&"<ul><b>操作结果：</b><br>"&errmsg&""
end if
Content=Content&"</td></tr><tr><td width='100%' align='center'><a href='javascript:history.go(-1)'> << 返回上一页</a></td></tr></table><br>"
Call BBS94KK.ShowTable("点歌发送情况",Content)
end sub%>
[[it] 本帖最后由 thbwn 于 2008-2-11 14:37 编辑 [/it]]
