www.gusucode.com > ASP+ACCESS学生论坛设计与实现(源代码+论文+开题报告) > ASP+ACCESS学生论坛设计与实现(源代码+论文+开题报告)\13学生论坛ASPAC\BBS\fileshow.asp
<!--#include FILE="conn.asp"--> <!--#include file="inc/const.asp" --> <!--#include file="inc/dv_ubbcode.asp"--> <!--#include file="inc/dv_clsother.asp" --> <!--#include file="inc/ubblist.asp"--> <% '2003-12-9 Edit by Yangzheng Mybbs.Loadtemplates("show") Dim username Dim abgcolor Dim bbsurl,Sql Dim MyIsBoard,MyDepth bbsurl="" Mybbs.stats=Template.Strings(22) Mybbs.Nav() If Mybbs.BoardID=0 then MyIsBoard=2 MyDepth=0 Else MyIsBoard=1 MyDepth=Mybbs.Board_Data(4,0) End If Dim dv_ubb Dim EmotPath EmotPath=Split(Mybbs.Forum_emot,"|||")(0) 'em心情路径 Set dv_ubb=new Dvbbs_UbbCode If Cint(Mybbs.GroupSetting(49))=0 then Mybbs.AddErrCode(54) Mybbs.ShowErr() If request("action")="send" Then card() ElseIf request("action")="save" Then cardsave() ElseIf request("action")="cards" Then showcard() Else main() End If Mybbs.ActiveOnline Mybbs.NewPassword() Set dv_ubb=Nothing Mybbs.Footer() '=====================贺卡演示==================== Sub showcard() Mybbs.stats=Template.Strings(49) Mybbs.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=Mybbs.Mainsetting(1) blackcolor=Mybbs.Mainsetting(3) If request("id")="" or Not IsNumeric(request("id")) Then Response.redirect "showerr.asp?ErrCodes=<li>"&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=<li>"&template.Strings(23)&"&action=OtherErr" Else msnid=clng(request("msmid")) End If '取出短信内容 Set Rs=Mybbs.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=Mybbs.htmlencode(trim(rs(0))) incept=Mybbs.htmlencode(trim(rs(1))) title=Mybbs.htmlencode(rs(2)) body=rs(3) sendtime=rs(4) Else Response.redirect "showerr.asp?ErrCodes=<li>"&template.Strings(50)&"&action=OtherErr" End If Rs.close '取出文件内容 Set Rs=Mybbs.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=<li>"&template.Strings(51)&"&action=OtherErr" Else Response.redirect "showerr.asp?ErrCodes=<li>"&template.Strings(50)&"&action=OtherErr" End If Rs.close:Set Rs=Nothing '判断文件是否本论坛,若不是则采用表中的记录. If InStr(F_Filename,":")=0 or InStr(F_Filename,"//")=0 Then If Mybbs.Forum_Setting(75)="0" Then F_Filename=bbsurl&"UploadFile/"&F_Filename Else F_Filename="showimg.asp?Boardid="&Mybbs.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,Mybbs.UserGroupID,2,1) Case 2 showfile="[flash=500,350]"&F_Filename&"[/flash]" ubblists=ubblist(showfile) showfile=dv_ubb.Dv_UbbCode(showfile,Mybbs.UserGroupID,2,1) Case Else showfile="[upload="&F_FileType&"]viewfile.asp?ID="&F_ID&"[/upload]" ubblists=ubblist(showfile) showfile=dv_ubb.Dv_UbbCode(showfile,Mybbs.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,Mybbs.UserGroupID,2,1)) Response.Write Tempwrite End Sub '贮存发送贺卡 Sub cardsave() Mybbs.stats=Template.Strings(36) Mybbs.Head_var 0,0,template.Strings(0),"show.asp" If Mybbs.UserID=0 Then Mybbs.AddErrCode(6) Mybbs.ShowErr() End if Dim cid,sname,rname,ctitle,body Dim msmid,cardurl,msmbody,Rs,SQl cid = Mybbs.checkStr(trim(request.form("saveid"))) sname = Mybbs.checkStr(trim(request.form("sname"))) rname = Mybbs.checkStr(trim(request.form("subject"))) '收信人名 ctitle = Mybbs.checkStr(trim(request.form("title"))) body = Html2Ubb(request.form("Body")) body = Mybbs.checkStr(body) If cid="" or Not IsNumeric(cid) Then Response.redirect "showerr.asp?ErrCodes=<li>"&template.Strings(23)&"&action=OtherErr" If Not (IsEmpty(session("lastpost")) or Mybbs.boardmaster or Mybbs.master or Mybbs.superboardmaster) Then If DateDiff("s",session("lastpost"),Now())<10 Then Response.redirect "showerr.asp?ErrCodes=<li>"&template.Strings(37)&"&action=OtherErr" End If If Mybbs.chkpost=False Then Mybbs.AddErrCode(16) Mybbs.ShowErr() If Replace(rname,",","")="" Then Response.redirect "showerr.asp?ErrCodes=<li>"&template.Strings(38)&"&action=OtherErr" Else rname=split(rname,",") End If If ctitle="" Then Response.redirect "showerr.asp?ErrCodes=<li>"&template.Strings(39)&"&action=OtherErr" ElseIf Mybbs.strLength(ctitle)>50 Then Response.redirect "showerr.asp?ErrCodes=<li>"&template.Strings(40)&"&action=OtherErr" End If If Mybbs.strLength(body)>15360 Then Response.redirect "showerr.asp?ErrCodes=<li>"&template.Strings(41)&"&action=OtherErr" if body="" Then Response.redirect "showerr.asp?ErrCodes=<li>"&template.Strings(42)&"&action=OtherErr" Dim msg,ISOK,i,SendNum ISOK=False Dim k:K=0 Dim OKlist SendNum=UBound(rname)+1 If Mybbs.UserToday(1)<SendNum Then SendNum=Mybbs.UserToday(1) End if For i=0 to SendNum-1 If Not IsFind(rname(i)) Then msg = msg &Template.Strings(43) msg = Replace(msg,"{$rname}",rname(i)) Else If K>Cint(Mybbs.GroupSetting(33))-1 Then msg = msg & Template.Strings(44) msg=Replace(msg,"{$rennum}",Mybbs.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)&"','"&Mybbs.membername&"','"&ctitle&"','"&body&"',"&SqlNowString&",0,1)" Mybbs.Execute(sql) update_user_msg(rname(i)) set Rs=Mybbs.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 Mybbs.Execute("update [dv_message] set content='"&Mybbs.checkStr(msmbody)&"' where id="&msmid) Mybbs.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 = Session(Mybbs.CacheName & "UserID") iUserInfo(36) = Mybbs.UserToday(0) & "|" & Mybbs.UserToday(1) + SendNum & "|" & Mybbs.UserToday(2) Session(Mybbs.CacheName & "UserID") = iUserInfo Mybbs.Execute("Update [Dv_User] Set UserToday='" & iUserInfo(36) & "' Where UserID = " & Mybbs.UserID) End If If ISOK Then Dim sucmsg sucmsg=sucmsg+"<br>"+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 Mybbs.Dvbbs_suc(sucmsg) End Sub '编写贺卡内容 Sub card() Mybbs.stats=Template.Strings(33) Mybbs.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 Mybbs.UserID=0 Then Response.redirect "showerr.asp?ErrCodes=<li>"&template.Strings(34)&"&action=OtherErr" If request("id")="" or not isnumeric(request("id")) Then Response.redirect "showerr.asp?ErrCodes=<li>"&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=Mybbs.Execute("select * from [DV_Upfile] where F_ID="&sid) If Not (Rs.EOF And Rs.BOF) Then F_Filename=Mybbs.htmlencode(rs("F_Filename")) '判断文件是否本论坛,若不是则采用表中的记录. If InStr(F_Filename,":")=0 or InStr(F_Filename,"//")=0 Then If Mybbs.Forum_Setting(75)="0" Then F_Filename=bbsurl&"UploadFile/"&F_Filename Else F_Filename="showimg.asp?Boardid="&Mybbs.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"),Mybbs.Membername) then showfile="[img]"&F_Filename&"[/img]" ubblists=ubblist(showfile) showfile=dv_ubb.Dv_UbbCode(showfile,Mybbs.UserGroupID,2,1) Else Response.redirect "showerr.asp?ErrCodes=<li>"&template.Strings(35)&"&action=OtherErr" End if Case 2 If Renzhen(Rs("F_boardid"),Mybbs.Membername) then showfile="[flash=500,350]"&F_Filename&"[/flash]" ubblists=ubblist(showfile)&"39," showfile=dv_ubb.Dv_UbbCode(showfile,Mybbs.UserGroupID,2,1) Else Response.redirect "showerr.asp?ErrCodes=<li>"&template.Strings(35)&"&action=OtherErr" End if Case Else Response.redirect "showerr.asp?ErrCodes=<li>"&template.Strings(35)&"&action=OtherErr" End Select Else Mybbs.AddErrCode(35) Mybbs.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}",Mybbs.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(Mybbs.lanstr(5),"||") If request("id")="" or not IsNumeric(request("id")) Then Response.redirect "showerr.asp?ErrCodes=<li>"&template.Strings(23)&"&action=OtherErr" Else sid=clng(request("id")) End If If Mybbs.boardid=0 Then Mybbs.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 Mybbs.head_var 1,Mybbs.Board_Data(4,0),"","" 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="&Mybbs.Boardid End if Dim Rs Set Rs=Mybbs.Execute(Sql) If Not(Rs.EOF And Rs.BOF) Then Mybbs.Execute("update [DV_Upfile] set F_ViewNum=F_ViewNum+1 where F_ID="& sid) F_ID=rs(0) F_AnnounceID=rs(1) 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=Mybbs.HtmlEnCode(F_Readme) Else F_Readme="<font color=gray>"&Template.Strings(24)&"</font>" End If '判断文件是否本论坛,若不是则采用表中的记录. If InStr(F_Filename,":")=0 or InStr(F_Filename,"//")=0 Then If Mybbs.Forum_Setting(75)="0" Then F_Filename=bbsurl&"UploadFile/"&F_Filename Else F_Filename="showimg.asp?Boardid="&Mybbs.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="<a href=dispbbs.asp?Boardid="&F_BoardID&"&ID="&F_AnnounceID(0)&"&replyID="&F_AnnounceID(1)&"&skin=1 target=_blank title="&Template.Strings(9)&">"&Template.Strings(25)&"</a>" Else golist=Template.Strings(26) End If Select Case F_Type Case 1 F_typename=Selfiletype(1) '图片集 IF Renzhen(F_BoardID,Mybbs.Membername) Then showfile="[IMG]"&F_Filename&"[/img]" ubblists=ubblist(showfile)&"39," showfile=dv_ubb.Dv_UbbCode(showfile,Mybbs.UserGroupID,2,1) csend="<a href=fileshow.asp?action=send&id="&f_id&"><img title="&Template.Strings(32)&" src=skins/default/newmail.gif border=0 width=28 height=11></a>" Else csend="" showfile=Template.Strings(31)&F_typename End if case 2 F_typename=Selfiletype(2) 'Flash集 IF Renzhen(F_BoardID,Mybbs.Membername) Then showfile="[flash=500,350]"&F_Filename&"[/flash]" ubblists=ubblist(showfile)&"39," showfile=dv_ubb.Dv_UbbCode(showfile,Mybbs.UserGroupID,2,1) csend="<a href=fileshow.asp?action=send&id="&f_id&"><img title="&Template.Strings(32)&" src=skins/default/newmail.gif border=0 width=28 height=11></a>" Else showfile=Template.Strings(31)&F_typename csend="" End if case 3 F_typename=Selfiletype(3) '音乐集 IF Renzhen(F_BoardID,Mybbs.Membername) Then showfile="<img src=skins/default/filetype/"&F_FileType&".gif border=0><a href="&Mybbs.htmlencode(F_Filename)&" target=_blank title="&Template.Strings(28)&">"&Mybbs.htmlencode(F_Filename)&"</a>" csend="<a href=fileshow.asp?action=send&id="&f_id&"><img title="&Template.Strings(32)&" src=skins/default/newmail.gif border=0 width=28 height=11></a>" Else showfile=Template.Strings(31)&F_typename csend="" End if Case 4 F_typename=Selfiletype(4) '电影集 IF Renzhen(F_BoardID,Mybbs.Membername) Then showfile="<img src=skins/default/filetype/"&F_FileType&".gif border=0><a href="&Mybbs.htmlencode(F_Filename)&" target=_blank title="&Template.Strings(28)&">"&Mybbs.htmlencode(F_Filename)&"</a>" csend="<a href=fileshow.asp?action=send&id="&f_id&"><img title="&Template.Strings(32)&" src=skins/default/newmail.gif border=0 width=28 height=11></a>" Else showfile=Template.Strings(31)&F_typename csend="" End if Case Else F_typename=Selfiletype(0) '文件集 IF Renzhen(F_BoardID,Mybbs.Membername) Then showfile="[upload="&F_FileType&"]viewfile.asp?ID="&F_ID&"[/upload]" ubblists=ubblist(showfile)&"39," showfile=dv_ubb.Dv_UbbCode(showfile,Mybbs.UserGroupID,2,1) csend="<a href=fileshow.asp?action=send&id="&f_id&"><img title="&Template.Strings(32)&" src=skins/default/newmail.gif border=0 width=28 height=11></a>" Else showfile=Template.Strings(31)&F_typename csend="" End if End Select Dim edit edit="" If Mybbs.GroupSetting(48)=1 Then If Mybbs.master or Mybbs.superboardmaster or Mybbs.boardmaster Then edit="<a title="&Template.Strings(29)&" href=myfile.asp?action=edit&editid="&Clng(F_ID)&"><img src=skins/default/editfile.gif border=0 width=10 height=10></a> <a title="&Template.Strings(30)&" href=myfile.asp?action=fdel&delid="&Clng(F_ID)&"><img height=10 src=skins/default/delete.gif width=10 border=0></a>" ElseIf F_Username=Mybbs.membername Then edit="<a title="&Template.Strings(29)&" href=myfile.asp?action=edit&editid="&Clng(F_ID)&"><img src=skins/default/editfile.gif border=0 width=10 height=10></a> <a title="&Template.Strings(30)&" href=myfile.asp?action=fdel&delid="&Clng(F_ID)&"><img height=10 src=skins/default/delete.gif width=10 border=0></a>" Else edit="" End If End If Tempwrite=Template.html(13) Tempwrite=Replace(Tempwrite,"{$f_userid}",Clng(F_UserID)) Tempwrite=Replace(Tempwrite,"{$f_username}",Mybbs.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=Mybbs.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="&Mybbs.userid&" ORDER BY F_addtime DESC" Set Rs=Mybbs.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 & "<OPTION value="""&SQL(0,i)&""">"&SQL(0,i)&"</OPTION> " 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="&Mybbs.userid&" or F_username='"&name&"') And F_Mod=2" Set Rs=Mybbs.Execute(Sql) If not Rs.eof Then Sql=Rs.GetString(,, ",", "", "") Rs.Close:Set Rs=Nothing If instr(Sql,name) or instr(Sql,Mybbs.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 Mybbs.execute("UPDATE [Dv_User] Set UserMsg='"&Mybbs.CheckStr(msginfo)&"' WHERE username='"&Mybbs.CheckStr(username)&"'") If username=Mybbs.MemberName Then UP_UserInfo=Session(Mybbs.CacheName & "UserID") UP_UserInfo(30)=msginfo Session(Mybbs.CacheName & "UserID")=UP_UserInfo Else Call Mybbs.NeedUpdateList(username,1) End If End Sub '统计留言 Function newincept(iusername) Dim Rs Rs=Mybbs.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=Mybbs.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 Mybbs.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 Mybbs.SqlQueryNum=Mybbs.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() Mybbs.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 = "(<p>)" Str = re.Replace(Str,"") re.Pattern = "(<\/p>)" Str = re.Replace(Str,CHR(10) & CHR(10)) re.Pattern = "(<STRONG>)" Str = re.Replace(Str,"<b>") re.Pattern = "(<\/STRONG>)" Str = re.Replace(Str,"</b>") Html2Ubb = Str Else Html2Ubb = "" End If End Function %>