newfile_news.asp

仿雅虎论坛静态生成html版 后台管理：admin/admin.asp 用户名：admin 密码：admin TOP/top.htm 顶部模板 left.htm 左边树形菜单模板

<!--#include file="const.asp"-->
<!--#include file="UserPost_Const.asp"-->
<!--#include file="code.asp"-->
<!--#include file="char.asp"-->
<!--#include file="BtBBS_Fun.asp"-->
<!--#include file="../conn.asp"-->
<%dim err
 StarTime = Timer():AccessNum=0
 username=Request.Cookies("username")
 login=BT_SF()
 Bmid=Request.QueryString("boardid")
 if IsNumeric(Bmid)=false then Response.Redirect "index.asp" end if '-----------------------论坛状态及访问控制-----------------
 
   BT_Board():aRS=Application(BBSname&"BT_Board")
   if aRS(0,0)<>-1 and VarType(aRS)<>0 then 
    For i=0 to UBound(aRS,2)
     If aRS(0,i)=cint(Bmid) then
      boardname=aRS(3,i)
      bbsid=aRS(1,i)
      Flname=aRS(2,i)
     End if
    Next
   end if
 
Call JCC_Board_Top
titlename=htmlencode(Request.Form("titlename"))
err=""
if len(titlename)>TitleLen then titlename="":err="<tr><td><li>标题长度超过规定的"&cstr(TitleLen)&"字节</li></td></tr>" end if  '不允许标题长度超过规定的字节

nl=ubbcode(Request.Form("nl"))
if len(nl)>FileLen then nl="":err=err+"<tr><td><li>内容长度超过规定的"&cstr(FileLen)&"字节</li></td></tr>" end if  '不允许内容长度超过规定的字节
if Request.Form("ftbq")<>"" then nl="<img src=../../images/ftbq/"+Request.Form("ftbq")+">"+nl end if
Call Login_EN
  if login<>"Y" then
   Response.Write "<table width=743><tr><td height=30 class=light>&nbsp;<img src=../images/nav.gif>&nbsp;<a href=index.asp><font class=NavColor>论坛首页</font></a>>> <a href=index.asp?bbsid="&bbsid&"><font class=NavColor>"&Flname&"</a>  >>  </font><a href=dislist.asp?boardid="&Bmid&"><font class=NavColor>"&boardname&"</font></a>  >>  新帖子</font></td></tr></table>"
   Response.Write "<br><br><table width=300><tr><td class=light>可能存在下列错误</td></tr> "&err&" <tr><td><li>尚未登陆或用户名/密码错误!</li></td></tr><tr><td align=center><a href=# onclick=history.go(-1)>返回</a> &nbsp;<a href=exit.asp>登陆</a></td></tr></table><br>"
    %></form><form name=newfile  method="post" action="login.asp">
    <table border=1 width=230 cellspacing=0 cellpadding=0 align=center class=table1>
    <tr><td width=80 height=30 align=center class=light1><b>用户名:</b></td><td class=light>   
    <INPUT class=fminpt name=username type=text size=20></td></tr>
    <tr><td height=30 align=center class=light1><b>密&nbsp;&nbsp;码:</b></td><td class=light>
    <INPUT class=fminpt name=password type=password size=20></td></tr>
    <tr><td align=center height=30 class=light1><B>有效期:</B></td><td class=light><Select name=CkiExp><option value=-1>无效<option value=365>一年<option value=1>一天<option value=2>两天<option value=7>一周<option value=31>一月</select></td></tr>
    </td></tr>
    <tr><td colspan=2 align=center height=30 class=light1><input type=Submit value="完成" name=add>&nbsp; <input type="reset" name="Clear" value="重写"></td></tr>
    </form>
    </table><br><br><%
   titlename=""
   nl=""
  end if
  if err<>"" then
   login="N"
   Response.Write "<br><br><table width=300><tr><td class=light>可能存在下列错误</td></tr> "&err&" <tr><td align=center><a href=# onclick=history.go(-1)>返回</a></td></tr></table><br>"
  end if
Response.Write "<script src=online.asp?userwz=发新帖&dis=NO></script>"
if titlename<>"" and nl<>"" and username=Request.Form("username") then
 AccessNum=AccessNum+1
 Set rs = Server.CreateObject("ADODB.Recordset")
 sql="SELECT top 1 * FROM BT_Topic "
 rs.open sql,conn,1,3
 rs.AddNew
 rs("BoardName")=boardname
 rs("BoardID")=Bmid
 rs("Subject")=titlename
 rs("PostUser")=username
 rs("PostTime")=date()+time()
 rs("LastPostTime")=date()+time()
 rs("LastPostUser")="------"
 rs("PollID")="file" 
 rs.Update 
 TitleID=cstr(rs("id"))
 titlefilename="fileid"+TitleID+".html"
 rs("FileName")=titlefilename
 rs.Update 
  '--------------读取页面模板文件
   top1="<script language=""JavaScript"" src=""../../inc/Top1_bbs.js""></script>"
   tom1="<script language=""JavaScript"" src=""../../inc/Tom1_bbs.js""></script>"
 '--------------
 '--------------编辑好Html文件内容
 '------------------------编辑login用户信息-----
 AccessNum=AccessNum+1
 Set rs3 = Server.CreateObject("ADODB.Recordset")
 sql3="select top 1 id,UserPage,头像ID,签名,注册时间,等级,声望,积分,经验,金钱,主题数,回复数 from 用户资料 where 用户名='"&username&"' "
 rs3.open sql3,conn,1,3
 if rs3.BOF and rs3.EOF then
  Response.Write "没有这个用户"
 else
   
  rs3("声望")=rs3("声望")+usersw_z
  rs3("积分")=rs3("积分")+userjf_z
  rs3("经验")=rs3("经验")+userjy_z
  rs3("金钱")=rs3("金钱")+usermoney_z
  rs3("主题数")=rs3("主题数")+1
  rs3.Update
  '处理用户等级
   AccessNum=AccessNum+1
   Set rsdj = Server.CreateObject("ADODB.Recordset")
   rsdj2="select * from 论坛等级 where 所需积分<="&rs3("积分")&" and 所需经验<="&rs3("经验")&" and 所需声望<="&rs3("声望")&" and 所需发帖量<="&rs3("主题数")+rs3("回复数")&" "
   rsdj.open rsdj2,conn,1,1
   rsdj.MoveLast
   rs3("等级")=rsdj("等级名称")
   rsdj.close
   set rsdj=nothing'----------------
  rs3.Update
  UserPage=rs3("UserPage")
  imageid=rs3("头像ID")
  regtime=cstr(rs3("注册时间"))
  'userdj=cstr(rs3("等级"))
  'usersw=cstr(rs3("声望"))
  'userjf=cstr(rs3("积分"))
  'userjy=cstr(rs3("经验"))
  'titlenum=cstr(rs3("主题数")+rs3("回复数"))
 end if
 rs3.Close 
 set rs3=nothing
 '-------------------------------------------编辑完内容nl
 AccessNum=AccessNum+1
 Set rs1 = Server.CreateObject("ADODB.Recordset")
 sql1="select id,所属分类,版面名称,主题总数,版面最后发帖 from 版面分类 where id="&Bmid&" "
 rs1.open sql1,conn,1,3
   rs1("主题总数")=rs1("主题总数")+1
   rs1("版面最后发帖")=rs("id")
   '下面代码文件导航处
   top="<script src=../online.asp?userwz="&titlename&"&dis=NO></script><table width=743 cellpadding=5><tr><td height=30 class=light>&nbsp;<img src=../../images/nav.gif>&nbsp;<a href=../index.asp><font class=NavColor>论坛首页</a>&nbsp;>></font>&nbsp;<a href=../index.asp?bbsid="&cstr(bbsid)&"><font class=NavColor>"&Flname&"</a>&nbsp;>></font>&nbsp;<a href=../dislist.asp?boardid="+Bmid+"><font class=NavColor>"+boardname+"</font></a>&nbsp;>>&nbsp;<a href=# onclick=history.go(-1)><font class=NavColor>返回</font></a></td></tr></table>"
   '下面代码回复处
   nl=top+"<table  border=0 width=743 cellspacing=0 cellpadding=5 align=center style='table-layout:fixed; word-break:break-all'><tr><td width=100% class=light1 align=center><font class=HeadFont><b class=""aTitle""><!--Title1-->"&titlename&"<!--Title2--></b></font><br>"&cstr(rs("PostTime"))&"</td></tr><tr><td align=right>作者:<a href=../LookUserInfo.asp?username="+rs("PostUser")+" title='查看作者资料'><font class=TBtwofont><b>"+rs("PostUser")+"</b></font></a>&nbsp;<a href=../EditPost.asp?BoardID="&BmID&"&Post=0&File=fileid"&titleid&".html&PostUser="&UserName&"><img src=../../images/edit.gif border=0 alt='编辑该帖子'></a></td></tr><tr><td style='LEFT: 0px; WIDTH: 743; WORD-WRAP: break-word' valign=top class=light><span id=""BodyLabel"" class=""content"" style=""display:block;padding:0px 10px""><!--BeginNl0-->"+nl+"<!--EndNl0--></span></td></tr><tr><td align=right>【 字体：<a href=""javascript:ContentSize(16)"">大</a> <a href=""javascript:ContentSize(14)"">中</a> <a href=""javascript:ContentSize(12)"">小</a> 】</td></tr><tr><td class=light1>&nbsp;<b>评论:</b></td></tr></table>"
   rs.Update
   fromto="<table  border=1 width=743 cellspacing=0 cellpadding=2 align=center class=table1><tr><td width=170 class=light>&nbsp;&nbsp;*快速回复<br><br>&nbsp;&nbsp;默认支持UBB,如果你不希望<br><br>&nbsp;&nbsp;支持UBB或要其它功能你可<br><br>&nbsp;&nbsp;以用<a href=../retitle.asp?boardid="&Bmid&"&titleid="&cstr(rs("id"))&"&boardname="&boardname&"&titlename="&titlename&"><FONT color=#990000>高级回复</font></a>进行编辑</td><td class=light><form name=refile  method=post action=../refile.asp?titleid="&cstr(rs("id"))&"><br>&nbsp;标题&nbsp;&nbsp;&nbsp;<INPUT class=fminpt name=titlename type=text size=50 value=Re:"&titlename&"><br>&nbsp;内容&nbsp;&nbsp;&nbsp;<TEXTAREA class=fminpt ROWS=10 COLS=50 name=nl></textarea><br><br>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<input type=Submit value=完成 name=add>&nbsp; <input type=reset name=Clear value=重写></td></tr></form></td></tr></table><br><script src=../filetom.asp?BoardID="&Bmid&"&filename="&titlefilename&"></script>"
   nl="<center>"+top1+nl+"<!--FileBZ-->"+fromto+tom1+"</center>"'完成html文件的编辑
  rs1.Update
  rs1.close
  set rs1=nothing
 '--------------添加html文件
   rs.Close 
   DIM myFile
   Const ForReading = 1
   Const Forwriting = 2
   Const ForAppending = 8
   myFile="bbs"+Bmid+"/"+titlefilename
   myFolder="bbs"+Bmid
   myFile = Server.MapPath(myFile)
   myFolder=server.MapPath(myFolder)
   Application.lock
   set fileStreamObj = CreateObject("Scripting.FileSystemObject")
   if fileStreamObj.FolderExists(myFolder) then
    Response.Write ""
   else
    fileStreamObj.CreateFolder(myFolder)
   end if
   fileStreamObj.CreateTextFile(myFile)