<% Dvbbs.Loadtemplates("show") Dim username Dim abgcolor Dim bbsurl,Sql Dim MyIsBoard,MyDepth Dim replyID bbsurl="" Dvbbs.stats=Template.Strings(22) Dvbbs.Nav() If Dvbbs.BoardID=0 then MyIsBoard=2 MyDepth=0 Else MyIsBoard=1 MyDepth=Application(Dvbbs.CacheName&"_boardlist").documentElement.selectSingleNode("board[@boardid='"&Dvbbs.BoardID&"']/@depth").text End If Dim dv_ubb Dim EmotPath EmotPath=Split(Dvbbs.Forum_emot,"|||")(0) 'em心情路径 Set dv_ubb=new Dvbbs_UbbCode dv_ubb.PostType=2 If Cint(Dvbbs.GroupSetting(49))=0 then Dvbbs.AddErrCode(54) Dvbbs.ShowErr() If request("action")="send" Then card() ElseIf request("action")="save" Then cardsave() ElseIf request("action")="cards" Then showcard() Else main() End If Dvbbs.ActiveOnline Dvbbs.NewPassword() Set dv_ubb=Nothing Dvbbs.Footer() '=====================贺卡演示==================== Sub showcard() Dvbbs.stats=Template.Strings(49) Dvbbs.Head_var 0,0,template.Strings(0),"show.asp" Dim cid,msnid,Rs Dim sender,incept,body,title,sendtime Dim F_Filename,ftype,flag Dim showfile Dim Tempwrite Dim redcolor,blackcolor redcolor=Dvbbs.Mainsetting(1) blackcolor=Dvbbs.Mainsetting(3) If request("id")="" or Not IsNumeric(request("id")) Then Response.redirect "showerr.asp?ErrCodes=
  • "&template.Strings(23)&"&action=OtherErr" Else cid=clng(request("id")) End If If request("msmid")="" or Not IsNumeric(request("msmid")) Then Response.redirect "showerr.asp?ErrCodes=
  • "&template.Strings(23)&"&action=OtherErr" Else msnid=clng(request("msmid")) End If '取出短信内容 Set Rs=Dvbbs.Execute("select sender,incept,title,content,sendtime from Dv_message where id="&msnid&" order by id desc") If not (rs.eof and rs.bof) Then sender=Dvbbs.htmlencode(trim(rs(0))) incept=Dvbbs.htmlencode(trim(rs(1))) title=Dvbbs.htmlencode(rs(2)) body=rs(3) sendtime=rs(4) Else Response.redirect "showerr.asp?ErrCodes=
  • "&template.Strings(50)&"&action=OtherErr" End If Rs.close '取出文件内容 Set Rs=Dvbbs.Execute("select F_Filename,F_Type,F_Flag from [DV_Upfile] where F_ID="&cid&" order by F_ID desc") If Not (Rs.EOF And Rs.BOF) Then F_Filename=rs(0) ftype=cint(rs(1)) flag=Cint(rs(2)) If flag<>3 Then Response.redirect "showerr.asp?ErrCodes=
  • "&template.Strings(51)&"&action=OtherErr" Else Response.redirect "showerr.asp?ErrCodes=
  • "&template.Strings(50)&"&action=OtherErr" End If Rs.close:Set Rs=Nothing '判断文件是否本论坛,若不是则采用表中的记录. If InStr(F_Filename,":")=0 or InStr(F_Filename,"//")=0 Then If Dvbbs.Forum_Setting(75)="0" Then F_Filename=bbsurl&"UploadFile/"&F_Filename Else F_Filename="showimg.asp?Boardid="&Dvbbs.BoardID&"&filename="&F_Filename End If End If Select Case ftype Case 1 showfile="[img]"&F_Filename&"[/img]" ubblists=ubblist(showfile) showfile=dv_ubb.Dv_UbbCode(showfile,Dvbbs.UserGroupID,2,1) Case 2 showfile="[flash=500,350]"&F_Filename&"[/flash]" ubblists=ubblist(showfile) showfile=dv_ubb.Dv_UbbCode(showfile,Dvbbs.UserGroupID,2,0) Case Else showfile="[upload="&F_FileType&"]viewfile.asp?ID="&F_ID&"[/upload]" ubblists=ubblist(showfile) showfile=dv_ubb.Dv_UbbCode(showfile,Dvbbs.UserGroupID,2,1) End Select Tempwrite=Template.html(15) Tempwrite=Replace(Tempwrite,"{$sendtime}",sendtime) Tempwrite=Replace(Tempwrite,"{$sender}",sender) Tempwrite=Replace(Tempwrite,"{$incept}",incept) Tempwrite=Replace(Tempwrite,"{$redcolor}",redcolor) Tempwrite=Replace(Tempwrite,"{$title}",title) Tempwrite=Replace(Tempwrite,"{$showfile}",showfile) Tempwrite=Replace(Tempwrite,"{$blackcolor}",blackcolor) Ubblists=Ubblist(body) Tempwrite=Replace(Tempwrite,"{$dvbody}",dv_ubb.Dv_UbbCode(body,Dvbbs.UserGroupID,2,1)) Response.Write Tempwrite End Sub '贮存发送贺卡 Sub cardsave() Dvbbs.stats=Template.Strings(36) Dvbbs.Head_var 0,0,template.Strings(0),"show.asp" If Dvbbs.UserID=0 Then Dvbbs.AddErrCode(6) Dvbbs.ShowErr() End if Dim cid,sname,rname,ctitle,body Dim msmid,cardurl,msmbody,Rs,SQl cid = Dvbbs.checkStr(trim(request.form("saveid"))) sname = Dvbbs.checkStr(trim(request.form("sname"))) rname = Dvbbs.checkStr(trim(request.form("subject"))) '收信人名 ctitle = Dvbbs.checkStr(trim(request.form("title"))) body = Html2Ubb(request.form("Body")) body = Dvbbs.checkStr(body) If cid="" or Not IsNumeric(cid) Then Response.redirect "showerr.asp?ErrCodes=
  • "&template.Strings(23)&"&action=OtherErr" If Not (IsEmpty(session("lastpost")) or Dvbbs.boardmaster or Dvbbs.master or Dvbbs.superboardmaster) Then If DateDiff("s",session("lastpost"),Now())<10 Then Response.redirect "showerr.asp?ErrCodes=
  • "&template.Strings(37)&"&action=OtherErr" End If If Dvbbs.chkpost=False Then Dvbbs.AddErrCode(16) Dvbbs.ShowErr() If Replace(rname,",","")="" Then Response.redirect "showerr.asp?ErrCodes=
  • "&template.Strings(38)&"&action=OtherErr" Else rname=split(rname,",") End If If ctitle="" Then Response.redirect "showerr.asp?ErrCodes=
  • "&template.Strings(39)&"&action=OtherErr" ElseIf Dvbbs.strLength(ctitle)>50 Then Response.redirect "showerr.asp?ErrCodes=
  • "&template.Strings(40)&"&action=OtherErr" End If If Dvbbs.strLength(body)>15360 Then Response.redirect "showerr.asp?ErrCodes=
  • "&template.Strings(41)&"&action=OtherErr" if body="" Then Response.redirect "showerr.asp?ErrCodes=
  • "&template.Strings(42)&"&action=OtherErr" Dim msg,ISOK,i,SendNum ISOK=False Dim k:K=0 Dim OKlist SendNum=UBound(rname)+1 If Dvbbs.UserToday(1)Cint(Dvbbs.GroupSetting(33))-1 Then msg = msg & Template.Strings(44) msg=Replace(msg,"{$rennum}",Dvbbs.GroupSetting(33)) msg=Replace(msg,"{$rname}",rname(i)) Else '插入短信并获得ID sql="insert into dv_message (incept,sender,title,content,sendtime,flag,issend) values ('"&rname(i)&"','"&Dvbbs.membername&"','"&ctitle&"','"&body&"',"&SqlNowString&",0,1)" Dvbbs.Execute(sql) update_user_msg(rname(i)) set Rs=Dvbbs.Execute("select top 1 id from dv_message order by id desc") msmid=rs(0) rs.close cardurl=bbsurl&"fileshow.asp?action=cards&id="&cid&"&msmid="&msmid cardurl="[URL="&cardurl&"]"&Template.Strings(28)&"[/URL]" msmbody=body+chr(13)+chr(13)+chr(10)+chr(10)+chr(10)+cardurl Dvbbs.Execute("update [dv_message] set content='"&Dvbbs.checkStr(msmbody)&"' where id="&msmid) Dvbbs.Execute("update [DV_Upfile] set F_Flag=3 where F_ID="&cid) K=K+1 ISOK=True OKlist=OKlist&Template.Strings(45) OKlist=Replace(OKlist,"{$rname}",rname(i)) End If End If cardurl="" Next Set Rs=Nothing '更新用户今日短信数据 If SendNum > 0 Then Dim iUserInfo iUserInfo = Dvbbs.UserToday(0) & "|" & Dvbbs.UserToday(1) + SendNum & "|" & Dvbbs.UserToday(2) Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@usertoday").text=iUserInfo Dvbbs.Execute("Update [Dv_User] Set UserToday='" & iUserInfo & "' Where UserID = " & Dvbbs.UserID) End If If ISOK Then Dim sucmsg sucmsg=sucmsg+"
    "+Template.Strings(46)&OKlist session("lastpost")=Now() If Msg<>"" Then sucmsg=sucmsg&Template.Strings(47)&msg Else Response.redirect "showerr.asp?ErrCodes="&msg&Template.Strings(48)&"&action=OtherErr" End If Dvbbs.Dvbbs_suc(sucmsg) End Sub '编写贺卡内容 Sub card() Dvbbs.stats=Template.Strings(33) dvbbs.Head_var 0,0,template.Strings(0),"show.asp" Dim sid,showfile Dim F_Filename,F_Type Dim frs,Rs,SQl Dim Postubb Dim Tempwrite If Dvbbs.UserID=0 Then Response.redirect "showerr.asp?ErrCodes=
  • "&template.Strings(34)&"&action=OtherErr" If request("id")="" or not isnumeric(request("id")) Then Response.redirect "showerr.asp?ErrCodes=
  • "&template.Strings(23)&"&action=OtherErr" Else sid=CLng(request("id")) End If 'F_ID,F_Username,F_Filename,F_FileType,F_Type,F_Readme,F_ViewNum,F_Flag,F_boardid Set Rs=Dvbbs.Execute("select * from [DV_Upfile] where F_ID="&sid) If Not (Rs.EOF And Rs.BOF) Then F_Filename=Dvbbs.htmlencode(rs("F_Filename")) '判断文件是否本论坛,若不是则采用表中的记录. If InStr(F_Filename,":")=0 or InStr(F_Filename,"//")=0 Then If Dvbbs.Forum_Setting(75)="0" Then F_Filename=bbsurl&"UploadFile/"&F_Filename Else F_Filename="showimg.asp?Boardid="&Dvbbs.BoardID&"&filename="&F_Filename End If End If F_Type=cint(rs("F_Type")) Select Case F_Type Case 1 If Renzhen(Rs("F_boardid"),Dvbbs.Membername) then showfile="[img]"&F_Filename&"[/img]" ubblists=ubblist(showfile) showfile=dv_ubb.Dv_UbbCode(showfile,Dvbbs.UserGroupID,2,1) Else Response.redirect "showerr.asp?ErrCodes=
  • "&template.Strings(35)&"&action=OtherErr" End if Case 2 If Renzhen(Rs("F_boardid"),Dvbbs.Membername) then showfile="[flash=500,350]"&F_Filename&"[/flash]" ubblists=ubblist(showfile)&"39," showfile=dv_ubb.Dv_UbbCode(showfile,Dvbbs.UserGroupID,2,0) Else Response.redirect "showerr.asp?ErrCodes=
  • "&template.Strings(35)&"&action=OtherErr" End if Case Else Response.redirect "showerr.asp?ErrCodes=
  • "&template.Strings(35)&"&action=OtherErr" End Select Else Dvbbs.AddErrCode(35) Dvbbs.ShowErr() End If Rs.close:Set Rs=Nothing Tempwrite=Template.html(14) Tempwrite=Replace(Tempwrite,"{$showfile}",showfile) Tempwrite=Replace(Tempwrite,"{$friend}",OPTION_Friend) Tempwrite=Replace(Tempwrite,"{$sname}",Dvbbs.Membername) Tempwrite=Replace(Tempwrite,"{$sid}",Sid) Tempwrite=Replace(Tempwrite,"{$postubb}",Temp_UBB) Response.Write Tempwrite End Sub Sub main() Dim Tempwrite Dim sid Dim F_ID, F_AnnounceID, F_BoardID, F_UserID ,F_Username, F_Filename, F_FileType, F_Type, F_FileSize, F_Readme, F_DownNum, F_ViewNum, F_DownUser, F_Flag, F_AddTime Dim F_typename,Selfiletype Dim golist,showfile,csend Selfiletype=Split(Dvbbs.lanstr(5),"||") If request("id")="" or not IsNumeric(request("id")) Then Response.redirect "showerr.asp?ErrCodes=
  • "&template.Strings(23)&"&action=OtherErr" Else sid=clng(request("id")) End If If Dvbbs.boardid=0 Then dvbbs.Head_var 0,0,template.Strings(0),"show.asp" Sql="select F_ID,F_AnnounceID,F_BoardID,F_UserID,F_Username,F_Filename,F_FileType,F_Type ,F_FileSize,F_Readme,F_DownNum,F_ViewNum,F_DownUser,F_Flag,F_AddTime from [DV_Upfile] where F_ID="&sid Else Dvbbs.head_var 1,Application(Dvbbs.CacheName&"_boardlist").documentElement.selectSingleNode("board[@boardid='"&Dvbbs.BoardID&"']/@depth").text,"","" Sql="select F_ID,F_AnnounceID,F_BoardID,F_UserID,F_Username,F_Filename,F_FileType,F_Type ,F_FileSize,F_Readme,F_DownNum,F_ViewNum,F_DownUser,F_Flag,F_AddTime from [DV_Upfile] where F_ID="&sid&" and F_boardid="&Dvbbs.Boardid End if Dim Rs Set Rs=Dvbbs.Execute(Sql) If Not(Rs.EOF And Rs.BOF) Then Dvbbs.Execute("update [DV_Upfile] set F_ViewNum=F_ViewNum+1 where F_ID="& sid) F_ID=rs(0) F_AnnounceID=rs(1) replyID=F_AnnounceID F_BoardID=rs(2) F_UserID=rs(3) F_Username=rs(4) F_Filename=rs(5) F_FileType=rs(6) F_Type=rs(7) F_FileSize=rs(8) F_Readme=Rs(9) F_DownNum=rs(10) F_ViewNum=rs(11) 'F_DownUser=rs(12) 'F_Flag=rs(13) F_AddTime=rs(14) End If Rs.Close:Set Rs=Nothing If F_Readme<>"" or Not IsNull(F_Readme) Then F_Readme=Dvbbs.HtmlEnCode(F_Readme) Else F_Readme=""&Template.Strings(24)&"" End If '判断文件是否本论坛,若不是则采用表中的记录. If InStr(F_Filename,":")=0 or InStr(F_Filename,"//")=0 Then If Dvbbs.Forum_Setting(75)="0" Then F_Filename=bbsurl&"UploadFile/"&F_Filename Else F_Filename="showimg.asp?Boardid="&Dvbbs.BoardID&"&filename="&F_Filename End If End If If Not IsNull(F_AnnounceID) And F_AnnounceID<>"" And InStr(F_AnnounceID,"|")>0 Then F_AnnounceID=split(F_AnnounceID,"|") golist=""&Template.Strings(25)&"" Else golist=Template.Strings(26) End If Select Case F_Type Case 1 F_typename=Selfiletype(1) '图片集 IF Renzhen(F_BoardID,Dvbbs.Membername) Then showfile="[IMG]"&F_Filename&"[/img]" ubblists=ubblist(showfile)&"39," showfile=dv_ubb.Dv_UbbCode(showfile,Dvbbs.UserGroupID,2,1) csend="" Else csend="" showfile=Template.Strings(31)&F_typename End if case 2 F_typename=Selfiletype(2) 'Flash集 IF Renzhen(F_BoardID,Dvbbs.Membername) Then Showfile = "[FLASH=500,350]" & F_Filename & "[/FLASH]" Ubblists = Ubblist(Showfile) & "39," showfile=dv_ubb.Dv_UbbCode(showfile,Dvbbs.UserGroupID,2,0) csend="" Else showfile=Template.Strings(31)&F_typename csend="" End if case 3 F_typename=Selfiletype(3) '音乐集 IF Renzhen(F_BoardID,Dvbbs.Membername) Then showfile=""&Dvbbs.htmlencode(F_Filename)&"" csend="" Else showfile=Template.Strings(31)&F_typename csend="" End if Case 4 F_typename=Selfiletype(4) '电影集 IF Renzhen(F_BoardID,Dvbbs.Membername) Then showfile=""&Dvbbs.htmlencode(F_Filename)&"" csend="" Else showfile=Template.Strings(31)&F_typename csend="" End if Case Else F_typename=Selfiletype(0) '文件集 IF Renzhen(F_BoardID,Dvbbs.Membername) Then showfile="[upload="&F_FileType&"]viewfile.asp?ID="&F_ID&"[/upload]" ubblists=ubblist(showfile)&"39," showfile=dv_ubb.Dv_UbbCode(showfile,Dvbbs.UserGroupID,2,1) csend="" Else showfile=Template.Strings(31)&F_typename csend="" End if End Select Dim edit edit="" If Dvbbs.GroupSetting(48)=1 Then If Dvbbs.master or Dvbbs.superboardmaster or Dvbbs.boardmaster Then edit=" " ElseIf F_Username=Dvbbs.membername Then edit=" " Else edit="" End If End If Tempwrite=Template.html(13) Tempwrite=Replace(Tempwrite,"{$f_userid}",Clng(F_UserID)) Tempwrite=Replace(Tempwrite,"{$f_username}",Dvbbs.HtmlEnCode(f_username)) Tempwrite=Replace(Tempwrite,"{$showfile}",showfile) Tempwrite=Replace(Tempwrite,"{$edit}",edit) Tempwrite=Replace(Tempwrite,"{$f_typename}",f_typename) Tempwrite=Replace(Tempwrite,"{$f_filesize}",f_filesize & "") Tempwrite=Replace(Tempwrite,"{$f_viewnum}",f_viewnum) Tempwrite=Replace(Tempwrite,"{$f_downnum}",f_downnum) Tempwrite=Replace(Tempwrite,"{$f_addtime}",f_addtime) Tempwrite=Replace(Tempwrite,"{$golist}",golist) Tempwrite=Replace(Tempwrite,"{$f_readme}",f_readme) Tempwrite=Replace(Tempwrite,"{$csend}",csend) Response.Write Tempwrite End Sub Function IsFind(UserName) IsFind=False If UserName<>"" Then USerName=replace(UserName,"'","") Dim Rs Set Rs=Dvbbs.Execute("select Count(*) from [dv_user] where username='"&USerName&"'") If Rs(0)>0 Then IsFind=True Set Rs=Nothing End If End Function '用户好友下拉名单 Function OPTION_Friend() DIM i,Rs Sql="SELECT F_friend FROM Dv_Friend WHERE F_userid="&Dvbbs.userid&" ORDER BY F_addtime DESC" Set Rs=Dvbbs.Execute(Sql) If not Rs.eof Then SQL=Rs.GetRows(-1) Rs.Close:Set Rs=Nothing End if If IsArray(SQL) Then For i=0 To Ubound(SQL,2) OPTION_Friend=OPTION_Friend & " " Next Else OPTION_Friend="" End If End Function '黑名单验证 Function CHKHateName(name) DIM Sql,Rs CHKHateName=False Sql="Select F_friend From Dv_Friend Where (F_userid="&Dvbbs.userid&" or F_username='"&name&"') And F_Mod=2" Set Rs=Dvbbs.Execute(Sql) If not Rs.eof Then Sql=Rs.GetString(,, ",", "", "") Rs.Close:Set Rs=Nothing If instr(Sql,name) or instr(Sql,Dvbbs.Membername) Then CHKHateName=True End If End Function '更新用户短信通知信息(新短信条数||新短讯ID||发信人名) Sub UPDATE_User_Msg(username) Dim msginfo,i,UP_UserInfo,newmsg newmsg=newincept(username) If newmsg>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)&"'") If username=Dvbbs.MemberName Then Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@usermsg").text=msginfo Else Call Dvbbs.NeedUpdateList(username,1) End If End Sub '统计留言 Function newincept(iusername) Dim Rs Rs=Dvbbs.execute("SELECT Count(id) FROM Dv_Message WHERE flag=0 And issend=1 And DelR=0 And incept='"& iusername &"'") newincept=Rs(0) Set Rs=nothing If isnull(newincept) Then newincept=0 End Function Function inceptid(stype,iusername) Dim Rs Set Rs=Dvbbs.execute("SELECT top 1 id,sender FROM Dv_Message WHERE flag=0 And issend=1 And DelR=0 And incept='"& iusername &"'") If not rs.eof Then If stype=1 Then inceptid=Rs(0) Else inceptid=Rs(1) End If Else If stype=1 Then inceptid=0 Else inceptid="null" End If End If Set Rs=nothing End Function '认证论坛的文件的判断 Function renzhen(boardid,username) Dim boarduser,rrs,Board_Setting,BoardMaster,i Dim sql renzhen=false If Dvbbs.Master then renzhen=true Elseif boardid=0 then renzhen=true Else sql="select boarduser,Board_Setting,BoardMaster from Dv_board where boardid="&boardid set rrs=server.createobject("adodb.recordset") rrs.open sql,conn,1,1 Dvbbs.SqlQueryNum=Dvbbs.SqlQueryNum+1 Board_Setting=split(rrs("board_setting"),",") If cint(Board_Setting(2))=1 then If not (isnull(rrs(2)) or rrs(2)="") then BoardMaster=split(rrs(2), "|") For i = 0 to ubound(BoardMaster) If trim(BoardMaster(i))=trim(username) then renzhen=true Exit for End if Next End if If renzhen=false then If isnull(rrs(0)) or rrs(0)="" then renzhen=false Else boarduser=split(rrs(0), ",") For i = 0 to ubound(boarduser) If trim(boarduser(i))=trim(username) then renzhen=true Exit for End if Next End if End if Else renzhen=true End if rrs.close Set rrs=nothing End if End function '只读,获得UBB模板 Function Temp_UBB() Dvbbs.Loadtemplates("post") Dim TempArray,i Temp_UBB = template.html(3) TempArray = Split(template.html(9),"|") For i = 1 To Ubound(TempArray) Temp_UBB = Replace(Temp_UBB,"{$ubb"&i&"}",TempArray(0) & TempArray(i)) Next End function '发贴时用,为了减少入库量 Function Html2Ubb(str) If Str<>"" And Not IsNull(Str) Then Dim re Set re=new RegExp re.IgnoreCase =True re.Global=True re.Pattern = "( )" Str = re.Replace(Str,Chr(9)) re.Pattern = "(

    )" Str = re.Replace(Str,"") re.Pattern = "(<\/p>)" Str = re.Replace(Str,CHR(10) & CHR(10)) re.Pattern = "()" Str = re.Replace(Str,"") re.Pattern = "(<\/STRONG>)" Str = re.Replace(Str,"") Html2Ubb = Str Else Html2Ubb = "" End If End Function %>