%
'go/look_ip/pag/postagree/postvote/printpage/report/sendpage
'Dvbbs.ErrType=1
UserFlashGet=0
Dim ErrCodes,Rs,SQL,i
Dim abgcolor,dv_ubb
Dim announceid,replyid,username,rootid,topic,postbuyuser,bgcolor,EmotPath
Dim MailBody,Email,TotalUseTable
Dim T_GetMoneyType,replyid_a,AnnounceID_a,RootID_a
Dim IsThisBoardMaster '确定当前用户是否本版版主,防止下面的操作影响到 Dvbbs.BoardMaster导致出错
IsThisBoardMaster = Dvbbs.BoardMaster
Select Case Request("t")
Case "1"
'look_ip
Dim canlookip,canlockip,lockid
Look_Ip_Main()
Case "2"
'pag
'Dim AnnounceID,UserName,RootID,Topic,UserEmail,TotalUseTable,PostBuyUser,ReplyID,EmotPath
'Pag_Main()
Case "3"
'postagree
'PostAgree_Main()
Case "4"
'postvote
PostVote_Main()
Case "5"
'printpage
PrintPage_Main()
Case "6"
'report
Report_Main()
Case "7"
'sendpage
SendPage_Main()
Case "8"
SaveFav_boards()
Case Else
'go.asp
Go_Main()
End Select
Dvbbs.PageEnd()
Sub Go_Main()
End Sub
Sub SaveFav_boards()
Dvbbs.LoadTemplates("")
If Dvbbs.Userid=0 Then
Dvbbs.AddErrCode(34)
Dvbbs.ShowErr()
End If
If Dvbbs.Boardid=0 Then
Response.redirect "showerr.asp?ShowErrType="&Dvbbs.ErrType&"&ErrCodes=
请选取要收藏的版面&action=OtherErr"
End If
Dim Rs,Sql,Fav_boards
Set Rs = Dvbbs.Execute("Select Fav_boards From Dv_user Where userid="&Dvbbs.UserID)
If Not Rs.Eof Then
Fav_boards = Trim(Rs(0))
Else
Response.redirect "showerr.asp?ShowErrType="&Dvbbs.ErrType&"&ErrCodes=用户数据不存在。&action=OtherErr"
End If
Rs.Close
Set Rs = Nothing
If Instr(","&Fav_boards&",",","&Dvbbs.Boardid&",") Then
Response.redirect "showerr.asp?ShowErrType="&Dvbbs.ErrType&"&ErrCodes=该版面已经添加到收藏。&action=OtherErr"
Else
If Fav_boards="" or IsNull(Fav_boards) Then
Fav_boards = Fav_boards & Dvbbs.Boardid
Else
Fav_boards = Fav_boards &","& Dvbbs.Boardid
End If
End If
If Len(Fav_boards)<250 Then
Dvbbs.stats="收藏版块操作"
Dvbbs.Nav()
Dvbbs.Execute("update dv_user Set Fav_boards='"&Dvbbs.Checkstr(Fav_boards)&"' Where Userid="&Dvbbs.UserID)
Dvbbs.Dvbbs_Suc("该版块收藏成功!")
Else
Response.redirect "showerr.asp?ShowErrType="&Dvbbs.ErrType&"&ErrCodes=你收藏的版块过多超出限制。&action=OtherErr"
End If
End Sub
'================查看用户来源信息===================
Sub Look_Ip_Main()
Dvbbs.LoadTemplates("dispuser")
CanLookIP=False
CanLockIP=False
If (Dvbbs.Master Or Dvbbs.SuperBoardMaster Or Dvbbs.BoardMaster) And Cint(Dvbbs.GroupSetting(30))=1 Then
CanLookIP=True
Else
CanLookIP=False
End If
If Dvbbs.UserGroupID>3 And CInt(Dvbbs.GroupSetting(30))=1 Then
CanLookIP=True
End If
If Dvbbs.FoundUserPer And Cint(Dvbbs.GroupSetting(30))=1 Then
CanLookIP=True
ElseIf Dvbbs.FoundUserPer And CInt(Dvbbs.GroupSetting(30))=0 Then
CanLookIP=False
End If
If (Dvbbs.Master or Dvbbs.SuperBoardMaster or Dvbbs.BoardMaster) and Cint(Dvbbs.GroupSetting(31))=1 Then
CanLockIP=True
Else
CanLockIP=False
End If
If Dvbbs.UserGroupID>3 And Cint(Dvbbs.GroupSetting(31))=1 Then
CanLockIP=True
End If
If Dvbbs.FoundUserPer And CInt(Dvbbs.GroupSetting(31))=1 Then
CanLockIP=True
ElseIf Dvbbs.FoundUserPer and Cint(Dvbbs.GroupSetting(31))=0 Then
CanLockIP=False
End If
Dvbbs.stats=template.Strings(13)
Dvbbs.Nav()
Dvbbs.Head_var 0,0,Replace(template.Strings(0),"{$MemberName}",""),"dispuser.asp?Id="&CLng(Request("userid"))
If Not Dvbbs.ChkPost() And Request("action") <> "" Then
Response.redirect "showerr.asp?ShowErrType="&Dvbbs.ErrType&"&ErrCodes=您不要从外部提交数据&action=OtherErr"
End If
If Request("action")="setlockip" Then
Call Setlockip()
ElseIf Request("action")="unlock" Then
Call unlock()
Else
Call lookip()
End If
Showerr()
Dvbbs.Showerr()
Dvbbs.ActiveOnline()
Dvbbs.footer()
End Sub
Sub lookip()
If Not CanLookIP Then
ErrCodes=ErrCodes+""+template.Strings(7)
Exit sub
End If
Dim ip,useraddress,iGetLockIP
ip=Request("ip")
useraddress=lookaddress(replace(ip,"'",""))
iGetLockIP=GetLockIP(replace(ip,"'",""))
LockID=LockID
%>
查看 <%=IP%>的来源 |
<%=useraddress%> |
<%If CanLookIP Then%>
管理操作:
<%If iGetLockIP Then%>
该用户IP已被锁定,解除锁定
<%Else%>
限制该IP不允许访问
<%End If%>
|
<%End If%>
<%
End Sub
Sub Setlockip()
If Not CanLockIP then
ErrCodes=ErrCodes+""+template.Strings(8)
Exit sub
End If
If request("reaction")="yes" Then
Dim sip
sip=cstr(request.form("ip1"))
If sip<>"" Then
If Instr(sip,"*.")>0 Then
ErrCodes=ErrCodes+"前台最多只能限制四类IP,如218.1.2.*"
Exit Sub
End If
If Instr(sip,"*.*.")>0 Then
ErrCodes=ErrCodes+"前台最多只能限制四类IP,如218.1.2.*"
Exit Sub
End If
If Instr(sip,"*.*.*.")>0 Then
ErrCodes=ErrCodes+"前台最多只能限制四类IP,如218.1.2.*"
Exit Sub
End If
If Trim(Dvbbs.CacheData(25,0))<>"" Then
sip=Trim(Dvbbs.CacheData(25,0)) & "|" & Replace(sip,"|","")
End If
End If
If sip<>"" Then
dvbbs.execute("update dv_setup set Forum_LockIP='"&replace(sip,"'","''")&"'")
Dvbbs.loadSetup
End If
sql="insert into dv_log (l_touser,l_username,l_content,l_ip,l_type) values ('-','"&Dvbbs.membername&"','用户操作:限制IP"&Dvbbs.checkstr(Request.Form("ip1"))&"-"&Dvbbs.checkstr(Request.Form("ip2"))&"','"&Dvbbs.UserTrueIP&"',6)"
dvbbs.Execute(SQL)
Dvbbs.Dvbbs_Suc(""+template.Strings(9))
Else
Dim userip,ips,GetIp1,useraddress,ip
If request("ip")<>"" then
userip=request("ip")
ips=Split(userIP,".")
GetIp1=ips(0)&"."&ips(1)&"."&ips(2)&".*"
Else
userip=""
GetIp1=""
GetIp2=""
End If
ip=Request("ip")
useraddress=lookaddress(replace(request("ip"),"'",""))
%>
锁定 <%=IP%> 的来源 |
<%=useraddress%> |
<%
End If
End Sub
sub unlock()
If Not CanLockIP Then
ErrCodes=ErrCodes+""+template.Strings(8)
Exit sub
End If
Dim locklist,unlockip
locklist=Trim(Dvbbs.CacheData(25,0))
If locklist<>"" Then
If Trim(request("id"))="" Then
ErrCodes=ErrCodes+""+template.Strings(10)
Exit sub
End If
locklist = "|" & locklist & "|"
unlockip = Replace(Replace(request("id"),"|",""),"'","")
unlockip = "|" & unlockip
locklist = Replace(locklist,unlockip,"")
unlockip = Split(request("id"),".")
If Ubound(unlockip)<>3 Then
ErrCodes=ErrCodes+""+template.Strings(10)
Exit sub
End If
locklist = Split(locklist,"|")
Dim i,ilocklist
For i = 1 To Ubound(locklist)-1
If i = 1 Then
ilocklist = locklist(i)
Else
ilocklist = ilocklist & "|" & locklist(i)
End If
Next
dvbbs.execute("update dv_setup set Forum_LockIP='"&replace(Trim(ilocklist),"'","")&"'")
Dvbbs.loadSetup
End If
sql="insert into dv_log (l_touser,l_username,l_content,l_ip,l_type) values ('-','"&Dvbbs.membername&"','用户操作:解除IP限制','"&Dvbbs.UserTrueIP&"',6)"
Dvbbs.Execute(SQL)
Dvbbs.Dvbbs_Suc(""+template.Strings(11))
End Sub
Function lookaddress(sip)
Dim str1,str2,str3,str4
Dim num
Dim irs
If isnumeric(left(sip,2)) Then
If sip="127.0.0.1" Then sip="192.168.0.1"
str1=left(sip,instr(sip,".")-1)
sip=mid(sip,instr(sip,".")+1)
str2=left(sip,instr(sip,".")-1)
sip=mid(sip,instr(sip,".")+1)
str3=left(sip,instr(sip,".")-1)
str4=mid(sip,instr(sip,".")+1)
If isNumeric(str1)=0 Or isNumeric(str2)=0 Or isNumeric(str3)=0 Or isNumeric(str4)=0 Then
Else
num=cint(str1)*256*256*256+cint(str2)*256*256+cint(str3)*256+cint(str4)-1
Dim adb,aConnStr,AConn
adb = "data/ipaddress.mdb"
aConnStr = "Provider = Microsoft.Jet.OLEDB.4.0;Data Source = " & Server.MapPath(adb)
Set AConn = Dvbbs.iCreateObject("ADODB.Connection")
aConn.Open aConnStr
sql="select country,city from dv_address where ip1 <="&num&" and ip2 >="&num
Set irs=AConn.Execute(sql)
If irs.eof And irs.bof Then
lookaddress=template.Strings(12)
Else
Do While Not irs.eof
lookaddress=lookaddress & "
" &irs(0) & irs(1)
irs.movenext
Loop
End If
irs.close
Set irs=nothing
AConn.Close
Set AConn=Nothing
End If
Else
lookaddress=template.Strings(12)
End If
End Function
Function getLockIP(sip)
getLockIP=False
Dim locklist
locklist=Trim(dvbbs.CacheData(25,0))
If locklist="" Then Exit Function
Dim i,StrUserIP,StrKillIP
StrUserIP=sip
locklist=Split(locklist,"|")
If StrUserIP="" Then Exit Function
StrUserIP=Split(StrUserIP,".")
If Ubound(StrUserIP)<>3 Then Exit Function
For i= 0 to UBound(locklist)
If locklist(i)<>"" Then
StrKillIP = Split(locklist(i),".")
If Ubound(StrKillIP)<>3 Then Exit For
getLockIP = True
If (StrUserIP(0) <> StrKillIP(0)) And Instr(StrKillIP(0),"*")=0 Then getLockIP=False
If (StrUserIP(1) <> StrKillIP(1)) And Instr(StrKillIP(1),"*")=0 Then getLockIP=False
If (StrUserIP(2) <> StrKillIP(2)) And Instr(StrKillIP(2),"*")=0 Then getLockIP=False
If (StrUserIP(3) <> StrKillIP(3)) And Instr(StrKillIP(3),"*")=0 Then getLockIP=False
If getLockIP Then
LockID=locklist(i)
Exit For
End If
End If
Next
End Function
'显示错误信息
Sub Showerr()
Dim Show_Errmsg
If ErrCodes<>"" Then
Show_Errmsg=Dvbbs.mainhtml(14)
ErrCodes=Replace(ErrCodes,"{$color}",Dvbbs.mainSetting(1))
Show_Errmsg=Replace(Show_Errmsg,"{$color}",Dvbbs.mainSetting(1))
Show_Errmsg=Replace(Show_Errmsg,"{$errtitle}",Dvbbs.Forum_Info(0)&"-"&Dvbbs.Stats)
Show_Errmsg=Replace(Show_Errmsg,"{$action}",Dvbbs.Stats)
Show_Errmsg=Replace(Show_Errmsg,"{$ErrString}",ErrCodes)
End If
Response.write Show_Errmsg
End Sub
'================查看用户来源信息===================
'================帖子投票===========================
Sub PostVote_Main()
Dvbbs.Stats="参与投票"
Dim voteid
Dim announceid
If Dvbbs.IsReadonly() And Not Dvbbs.Master Then Response.Redirect "showerr.asp?ShowErrType="&Dvbbs.ErrType&"&action=readonly&boardid="&dvbbs.boardID
Dim action
Dim vote,votenum
Dim postvote(200)
Dim postvote1
Dim j,votenum_1,votenumlen
Dim vrs
Dim postnum,postoption
If Dvbbs.UserID=0 Then Dvbbs.AddErrCode(34)
If Request("id")="" Then
Dvbbs.AddErrCode(35)
ElseIf Not IsNumeric(Request("id")) Then
Dvbbs.AddErrCode(35)
Else
AnnounceID=Request("id")
End If
If Request("voteid")="" Then
Dvbbs.AddErrCode(35)
ElseIf not IsNumeric(Request("voteid")) Then
Dvbbs.AddErrCode(35)
Else
voteID=Request("voteid")
End If
If CInt(Dvbbs.GroupSetting(9))=0 then Dvbbs.AddErrCode(56)
Dvbbs.ShowErr
'主题已锁定,不能参与投票
Set Rs=Dvbbs.Execute("select locktopic from dv_topic where topicid="&AnnounceID)
If Not (Rs.Eof And Rs.Bof) then
If Rs(0)=1 Then
Dvbbs.AddErrCode(57)
Dvbbs.ShowErr
Exit Sub
End If
End If
'已投票用户不允许再次投票
Set Rs = Dvbbs.Execute("select userid from dv_voteuser where voteid="&voteID&" and userid="&Dvbbs.userid)
If Not(Rs.Eof And Rs.Bof) Then
Dvbbs.AddErrCode(58)
Dvbbs.ShowErr
Exit Sub
End If
Dim Votes,VoteChilds,VoteChildsEP_Item,VoteChildsType
Dim VoteForm,VoteForm_chkbox,VoteForm_Tempstr
Set Rs=Dvbbs.iCreateObject("Adodb.Recordset")
Sql="select * from dv_vote where voteid="&voteid
Rs.Open Sql,Conn,1,3
If Rs.Eof And Rs.Bof Then
Dvbbs.AddErrCode(32)
Dvbbs.ShowErr
Exit Sub
Else
'管理员,超版,版主不受投票限制
If Not (Dvbbs.Master Or Dvbbs.SuperBoardMaster Or Dvbbs.BoardMaster) Then
'文章
If Clng(Rs("UArticle"))>Clng(Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userpost").text) Then Response.redirect "showerr.asp?ShowErrType="&Dvbbs.ErrType&"&ErrCodes=本投票设置了用户发贴最少为 "&Rs("UArticle")&" 才能投票&action=OtherErr"
'金钱
If Clng(Rs("UWealth"))>Clng(Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userwealth").text) Then Response.redirect "showerr.asp?ShowErrType="&Dvbbs.ErrType&"&ErrCodes=本投票设置了用户金钱最少为 "&Rs("UWealth")&" 才能投票&action=OtherErr"
'经验
If Clng(Rs("UEP"))>Clng(Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userep").text) Then Response.redirect "showerr.asp?ShowErrType="&Dvbbs.ErrType&"&ErrCodes=本投票设置了用户积分最少为 "&Rs("UEP")&" 才能投票&action=OtherErr"
'魅力
If Clng(Rs("UCP"))>Clng(Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@usercp").text) Then Response.redirect "showerr.asp?ShowErrType="&Dvbbs.ErrType&"&ErrCodes=本投票设置了用户魅力最少为 "&Rs("UCP")&" 才能投票&action=OtherErr"
'威望
If Clng(Rs("UPower"))>Clng(Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@userpower").text) Then Response.redirect "showerr.asp?ShowErrType="&Dvbbs.ErrType&"&ShowErrType="&Dvbbs.ErrType&"&ErrCodes=本投票设置了用户威望最少为 "&Rs("UPower")&" 才能投票&action=OtherErr"
End If
Dim votenum_temp,n,num_tempstr
If Rs("votetype")=2 Then
'调查投票
Votes = Split(Rs("vote"),"|")
votenum=Split(rs("votenum"),"|")
For i = 0 To Ubound(Votes)
VoteChilds = Split(Votes(i),"@@")
VoteChildsType = VoteChilds(1) '类型:0=单选,1=多选,2=文本
If VoteChildsType = "2" Then
'文本问答型式
VoteForm = Replace(Request.Form("postvote_"&i),"|","")
If Trim(VoteForm)="" Then
Response.redirect "showerr.asp?ShowErrType="&Dvbbs.ErrType&"&ErrCodes=请检查是否有答案未填写?&action=OtherErr"
End If
postoption = postoption & VoteForm &"|"
Else
VoteChildsEP_Item = Split(VoteChilds(3),"$$") '调查的积分
votenum_temp = Split(votenum(i),"$$")
num_tempstr = ""
If VoteChildsType="0" Then
'单选取出相应分数
VoteForm = Request.Form("postvote_"&i)
If Not Isnumeric(VoteForm) or VoteForm = "" Then
Response.redirect "showerr.asp?ShowErrType="&Dvbbs.ErrType&"&ErrCodes=请检查是否有漏选的项目?&action=OtherErr"
Else
VoteForm = Cint(VoteForm)
End If
postoption = postoption & VoteForm &"|"
votenum_temp(VoteForm) = Cint(votenum_temp(VoteForm))+1
For n=0 to Ubound(votenum_temp)-1
num_tempstr = num_tempstr & votenum_temp(n) &"$$"
Next
votenum(i) = num_tempstr
Else
'多选
VoteForm_Tempstr = ""
For each VoteForm in Request.Form("postvote_"&i)
If Not Isnumeric(VoteForm) or VoteForm = "" Then
Response.redirect "showerr.asp?ShowErrType="&Dvbbs.ErrType&"&ErrCodes=请检查是否有漏选的项目?&action=OtherErr"
Else
VoteForm = Cint(VoteForm)
End If
VoteForm_Tempstr = VoteForm_Tempstr & VoteForm &"$$"
votenum_temp(VoteForm) = Cint(votenum_temp(VoteForm))+1
Next
For n=0 to Ubound(votenum_temp)-1
num_tempstr = num_tempstr & votenum_temp(n) &"$$"
Next
votenum(i) = num_tempstr
postoption = postoption & VoteForm_Tempstr &"|"
End If
End If
votenum_1 = votenum_1 &votenum(i)&"|"
Next
postnum=1
Else
'单选及多选投票
votenum=Split(rs("votenum"),"|")
If Rs("votetype")=1 Then
For i = 0 to UBound(votenum)
postvote(i)=request("postvote_"&i&"")
Next
End If
For j = 0 to UBound(votenum)
If rs("votetype")=0 Then
If cint(request("postvote"))=j Then
votenum(j)=votenum(j)+1
postoption=j
End If
votenum_1=""&votenum_1&""&votenum(j)&"|"
postnum=1
Else
If postvote(j)<>"" Then
If cint(postvote(j))=j Then
votenum(j)=votenum(j)+1
postnum=postnum+1
postoption=postoption & j & ","
End If
End If
votenum_1=""&votenum_1&""&votenum(j)&"|"
End If
Next
If postnum="" or isnull(postnum) then
Dvbbs.AddErrCode(59)
Dvbbs.ShowErr
Exit Sub
End If
End If
votenumlen=len(votenum_1)
votenum_1=left(votenum_1,votenumlen-1)
rs("votenum")=votenum_1
rs("voters")=rs("voters")+1
rs.update
postoption = Dvbbs.Checkstr(postoption)
Dvbbs.Execute("update dv_Topic set VoteTotal=voteTotal+"&postnum&" where topicid="&Announceid)
Dvbbs.Execute("insert into dv_voteuser (voteid,userid,voteoption) values ("&voteid&","&Dvbbs.userid&",'"&postoption&"')")
End If
Rs.Close
Set Rs=Nothing
If Dvbbs.Board_Setting(53)<>"0" Then
SQL="update dv_topic set LastPostTime="&SqlNowString&" where Topicid="&announceid&" and istop=0"
Dvbbs.Execute(SQL)
End If
Response.Redirect Request.ServerVariables("HTTP_REFERER")
Dvbbs.ShowErr
End Sub
'================帖子投票===========================
'================打印帖子===========================
Sub PrintPage_Main()
If Dvbbs.BoardID = 0 Then
Response.Write "参数错误"
Response.End
End If
Set dv_ubb=new Dvbbs_UbbCode
Dv_ubb.PostType=1
Dvbbs.LoadTemplates("postjob")
If request("id")="" Then
Dvbbs.AddErrCode(43)
ElseIf Not Isnumeric(request("id")) Then
Dvbbs.AddErrCode(30)
Else
AnnounceID=Clng(request("id"))
End If
If Dvbbs.GroupSetting(2)="0" Then Dvbbs.AddErrcode(31)
Dvbbs.ShowErr()
EmotPath=Split(Dvbbs.Forum_emot,"|||")(0) 'em心情路径
abgcolor="tablebody1"
bgcolor="tablebody2"
Dim Tempwrite,Templist
Dim IsBest,Islock,IsDel,PostUserid
Set Rs=Dvbbs.Execute("select title,PostTable,isbest,locktopic,BoardID,PostUserid from Dv_topic where topicID="&AnnounceID)
If Not(Rs.Bof And Rs.Eof) Then
topic=Rs(0)
TotalUseTable=Rs(1)
IsBest = Rs(2)
Islock = Rs(3)
IsDel = Rs(4)
PostUserid = Rs(5)
Else
Dvbbs.AddErrCode(48)
Exit sub
End If
Rs.close:Set rs=Nothing
If IsBest=1 and Cint(Dvbbs.GroupSetting(41))=0 Then Dvbbs.AddErrCode(8) : Exit sub
If IsDel = 444 Then Dvbbs.AddErrCode(8) : Exit sub
If Dvbbs.Userid <> PostUserid And Cint(Dvbbs.GroupSetting(2)) = 0 Then Dvbbs.AddErrCode(31) : Exit Sub
Tempwrite=template.html(2)
Tempwrite=Replace(Tempwrite,"{$tablewidth}",Dvbbs.Mainsetting(0))
Tempwrite=Replace(Tempwrite,"{$forumname}",Dvbbs.Forum_info(0))
Tempwrite=Replace(Tempwrite,"{$forumurl}",Dvbbs.Get_ScriptNameUrl)
Tempwrite=Replace(Tempwrite,"{$boardtype}",Dvbbs.Boardtype)
Tempwrite=Replace(Tempwrite,"{$boardid}",Dvbbs.boardid)
Tempwrite=Replace(Tempwrite,"{$topic}",Dvbbs.HtmlEncode(Topic))
Tempwrite=Replace(Tempwrite,"{$announceid}",announceid)
'
Dim Page,Record_Count,n,Searchstr
If request("page")<>"" and IsNumeric(request("page")) Then
page=Clng(request("page"))
Else
page=1
End If
Record_Count = 0
Searchstr = "t="&Request.QueryString("t")&"&BoardID="&Dvbbs.boardid&"&id="&Request.QueryString("id")
If Not IsObject(Conn) Then ConnectionDatabase
Dvbbs.SqlQueryNum = Dvbbs.SqlQueryNum + 1
Sql="Select b.UserName,b.Topic,b.dateandtime,b.body,u.UserGroupID,b.postbuyuser,b.Ubblist,B.isbest,B.locktopic,B.GetMoneyType,B.ParentID,b.AnnounceID,b.RootID,b.signflag from "&TotalUseTable&" b left outer Join [Dv_user] u on b.PostUserID=u.userid where b.boardid="&dvbbs.boardid&" and b.rootid="&Announceid&" and b.locktopic<>2 and b.locktopic<>3 and (u.lockuser=0 or u.lockuser is null) order by b.announceid"
'Set Rs=Dvbbs.Execute(Sql)
Set Rs=Dvbbs.iCreateObject("adodb.recordset")
Rs.Open Sql,Conn,1,1
If Rs.Eof And Rs.Bof Then
Dvbbs.AddErrCode(48)
Exit Sub
Else
Record_Count = Rs.RecordCount
If Record_Count Mod Cint(Dvbbs.Board_Setting(27))=0 Then
n = Record_Count \ Cint(Dvbbs.Board_Setting(27))
Else
n = Record_Count \ Cint(Dvbbs.Board_Setting(27))+1
End If
Rs.MoveFirst
If page > n Then page = n
If page < 1 Then page = 1
If page > 1 Then
Rs.Move (page-1) * Clng(Dvbbs.Board_Setting(27))
End if
Sql = Rs.GetRows(Clng(Dvbbs.Board_Setting(27)))
'Sql=Rs.GetRows(-1)
Rs.Close:Set Rs=Nothing
For i=0 to Ubound(sql,2)
postbuyuser=Sql(5,i)
If Sql(9,i)=3 And Sql(10,i)=0 And Not Dvbbs.Boardmaster Then
If Instr(postbuyuser,"|||"&Dvbbs.MemberName&"|||")=0 Then Dvbbs.AddErrCode(8) : Exit Sub
End If
Ubblists=SQL(6,i)
If Sql(13,i)=2 Then
If Dvbbs.master Then
username=Sql(0,i)&" (匿名)"
Else
username="匿名用户"
End If
Else
username=Sql(0,i)
End If
ReplyID_a=Sql(11,i)
AnnounceID_a=Sql(11,i)
RootID_a=Sql(12,i)
Templist=Templist&template.html(3)
Templist=Replace(Templist,"{$username}",username)
Templist=Replace(Templist,"{$dateandtime}",Sql(2,i))
Templist=Replace(Templist,"{$topic}",Dvbbs.HtmlEncode(Sql(1,i)))
Templist=Replace(Templist,"{$body}",SimJsReplace(dv_ubb.Dv_UbbCode(SQL(3,i),SQL(4,i),1,1)))
Next
Tempwrite=Replace(Tempwrite,"{$bbslist}",Templist)
Dvbbs.stats=Dvbbs.HtmlEncode(Sql(1,0))
Dvbbs.head()
Response.write Tempwrite
Response.Write ""
Response.Write ""
End if
Dvbbs.ShowErr()
Dvbbs.ActiveOnline
Dvbbs.Footer()
End Sub
Function SimJsReplace(str)
If IsNull(str) Or str="" Then Exit Function
str=Replace(str,"\","\\")
str=Replace(str,"'","\'")
SimJsReplace=str
End Function
'================打印帖子===========================
'================报告帖子===========================
Sub Report_Main()
Dvbbs.LoadTemplates("postjob")
Dvbbs.stats=template.Strings(0)
Dvbbs.Nav()
If Dvbbs.userid=0 Then
Dvbbs.AddErrCode(6)
End If
Dvbbs.ShowErr()
Dvbbs.head_var 1,Application(Dvbbs.CacheName&"_boardlist").documentElement.selectSingleNode("board[@boardid='"&Dvbbs.BoardID&"']/@depth").text,"",""
If Request("action")="send" then
Report_AnnounceInfo()
Else
Report_Pag()
End If
End Sub
Sub Report_AnnounceInfo()
Dim body,AnnounceID,writer,incept,topic,topic_1,Yrs
If Request("id")="" Or Not IsNumeric(Request("id")) Then
Dvbbs.AddErrCode(30)
Exit Sub
Else
AnnounceID=Clng(Request("id"))
End If
body=Dvbbs.checkStr(request.Form("content"))
writer=Dvbbs.membername
incept=Dvbbs.checkStr(Request.Form("boardmaster"))
Sql="select title from Dv_topic where TopicID="&AnnounceID
Set Yrs=Dvbbs.Execute(sql)
If not(Yrs.bof and Yrs.eof) Then
topic_1=Yrs(0)
topic=template.Strings(0)
body=body&template.Strings(2)
body=Replace(body,"{$dvbbsurl}",Dvbbs.Get_ScriptNameUrl)
body=Replace(body,"{$boardid}",Dvbbs.boardid)
body=Replace(body,"{$announceid}",Announceid)
Else
Dvbbs.AddErrCode(48)
Exit Sub
End If
Yrs.Close
Sql="insert into Dv_message (incept,sender,title,content,sendtime,flag,issend) values ('"&incept&"','"&Dvbbs.membername&"','"&topic&"','"&body&"',"&SqlNowString&",0,1)"
Dvbbs.Execute(Sql)
update_user_msg(incept)
Dvbbs.ActiveOnline
Dvbbs.Dvbbs_suc(""&template.Strings(3))
Set Yrs=Nothing
Dvbbs.Footer()
End sub
Sub Report_Pag()
Dim MainTable,Boardmasterlist,Yrs
Dim Boardmasterl,Boardmastersp
Boardmasterlist=Template.Html(1)
Sql="select boardmaster from Dv_board where boardID="&cstr(Dvbbs.boardid)
Set Yrs=Dvbbs.Execute(Sql)
If Yrs.eof And Yrs.bof Then
Dvbbs.AddErrCode(29)
Exit Sub
ElseIf Yrs(0)="" Or isnull(Yrs(0)) Then
Boardmasterl=Replace(Boardmasterlist,"{$boardmaster}",template.Strings(1))
Else
Boardmastersp=Split(Yrs(0),"|")
For i=0 to Ubound(Boardmastersp)
Boardmasterl=Boardmasterl&Replace(Boardmasterlist,"{$boardmaster}",Boardmastersp(i))
Next
End if
MainTable=Template.Html(0)
MainTable=Replace(MainTable,"{$boardid}",Dvbbs.boardid)
MainTable=Replace(MainTable,"{$announceid}",Request("id"))
MainTable=Replace(MainTable,"{$boardmasterlist}",Boardmasterl)
Response.write MainTable
Dvbbs.ActiveOnline
Dvbbs.Footer()
End Sub
Function update_user_msg(username)
Dim msginfo
if newincept(username)>0 then
msginfo=newincept(username) & "||" & inceptid(1,username) & "||" & inceptid(2,username)
Else
msginfo="0||0||null"
End if
Dvbbs.execute("update [Dv_user] set UserMsg='"&dvbbs.CheckStr(msginfo)&"' where username='"&dvbbs.CheckStr(username)&"'")
End Function
'统计留言
Function newincept(iusername)
Dim Yrs
Set Yrs=Dvbbs.execute("Select Count(id) From Dv_Message Where flag=0 and issend=1 and delR=0 And incept='"& iusername &"'")
newincept=Yrs(0)
set Yrs=nothing
if isnull(newincept) then newincept=0
End Function
Function inceptid(stype,iusername)
Dim Yrs
Set Yrs=Dvbbs.execute("Select top 1 id,sender From Dv_Message Where flag=0 and issend=1 and delR=0 And incept='"& iusername &"'")
If stype=1 then
inceptid=Yrs(0)
Else
inceptid=Yrs(1)
End if
set Yrs=nothing
End Function
'================报告帖子===========================
'================发送页面===========================
Sub SendPage_Main()
Dim announceid,topic,content,postname,incepts
Dvbbs.LoadTemplates("postjob")
Dvbbs.Stats=template.Strings(9)
Dvbbs.Nav()
Dvbbs.ShowErr()
If Cint(Dvbbs.Forum_Setting(2))=0 Then
Dvbbs.AddErrCode(51)
End If
If Cint(dvbbs.GroupSetting(15))=0 Then
Dvbbs.AddErrCode(65)
End If
If Request("id")="" Then
Dvbbs.AddErrCode(43)
ElseIf Not Isnumeric(Request("id")) Then
Dvbbs.AddErrCode(30)
Else
AnnounceID=Clng(Request("id"))
End If
Dvbbs.ShowErr()
Dvbbs.head_var 1,Application(Dvbbs.CacheName&"_boardlist").documentElement.selectSingleNode("board[@boardid='"&Dvbbs.BoardID&"']/@depth").text,"",""
If request("action")="sendmail" Then
If IsValidEmail(trim(Request.Form("mail")))=False Then
Dvbbs.AddErrCode(50)
Else
email=trim(Request.Form("mail"))
End If
If request("postname")="" Then
Dvbbs.AddErrCode(66)
Else
postname=request("postname")
End If
If request("incept")="" Then
Dvbbs.AddErrCode(67)
Else
incepts=request("incept")
End If
If request("content")="" Then
Dvbbs.AddErrCode(68)
Else
content=Dvbbs.HtmlEnCode(request("content"))
End If
Dvbbs.ShowErr()
Set Rs=Dvbbs.Execute("select title from Dv_topic where topicID="&AnnounceID)
If Not(Rs.Bof And Rs.Eof) Then
topic=Dvbbs.HtmlEnCode(Rs(0))
Rs.Close:Set Rs=Nothing
Else
Dvbbs.AddErrCode(48)
End If
Dvbbs.ShowErr()
mailbody=template.html(4)&template.html(6)
mailbody=Replace(mailbody,"{$incepts}",incepts)
mailbody=Replace(mailbody,"{$postname}",postname)
mailbody=Replace(mailbody,"{$bbsname}",Dvbbs.Forum_Info(0))
mailbody=Replace(mailbody,"{$boardtype}",Dvbbs.Boardtype)
mailbody=Replace(mailbody,"{$topic}",topic)
mailbody=Replace(mailbody,"{$content}",content)
mailbody=Replace(mailbody,"{$bbsurl}",Dvbbs.Get_ScriptNameUrl)
mailbody=Replace(mailbody,"{$boardid}",Dvbbs.Boardid)
mailbody=Replace(mailbody,"{$announceid}",announceid)
mailbody=Replace(mailbody,"{$copyright}",Dvbbs.Forum_Copyright)
mailbody=Replace(mailbody,"{$version}",Dvbbs.Forum_Version)
Dim DvEmail
Set DvEmail = New Dv_SendMail
DvEmail.SendObject = Cint(Dvbbs.Forum_Setting(2)) '设置选取组件 0=Jmail,1=Cdonts,2=Aspemail
DvEmail.ServerLoginName = Dvbbs.Forum_info(12) '您的邮件服务器登录名
DvEmail.ServerLoginPass = Dvbbs.Forum_info(13) '登录密码
DvEmail.SendSMTP = Dvbbs.Forum_info(4) 'SMTP地址
DvEmail.SendFromEmail = Dvbbs.Forum_info(5) '发送来源地址
DvEmail.SendFromName = Dvbbs.Forum_info(0) '发送人信息
If DvEmail.ErrCode = 0 Then
DvEmail.SendMail email,topic,mailbody '执行发送邮件
If DvEmail.Count=0 Then
Dvbbs.AddErrCode(51)
End If
Else
Dvbbs.AddErrCode(51)
End If
'Response.write DvEmail.Description
Set DvEmail = Nothing
Dvbbs.ShowErr()
Dvbbs.Dvbbs_suc(""&template.Strings(6))
Else
SendPage_Pag()
End If
Dvbbs.ActiveOnline
Dvbbs.Footer()
End Sub
Sub SendPage_Pag()
Dim Tempwrite
Tempwrite=template.html(7)
Tempwrite=Replace(Tempwrite,"{$bbsname}",Dvbbs.Forum_info(0))
Tempwrite=Replace(Tempwrite,"{$forumurl}",Dvbbs.Get_ScriptNameUrl)
Tempwrite=Replace(Tempwrite,"{$announceid}",Request("id"))
Tempwrite=Replace(Tempwrite,"{$boardid}",Dvbbs.boardid)
Response.write Tempwrite
End Sub
'================发送页面===========================
%>