风格选择:黄绿 | 天蓝 | 红灰
导航
SEO首页>>网站建设>>程序开发>>ASP生成HTML长文章分页代码
ASP生成HTML长文章分页代码
<%'容错处理
'On Error Resume Next
%>


<%
dim title,author,keyword,original,pic,smallpic,picshow,content,bigclassid,smallclassid,sql,special_id
dim ddate,nnow,nnowx,rannum,top1
ddate=date()
nnow=now()'记录当前时间
'=======X1:以下代码生成3位随机数========
randomize
rannum=cstr(cint(rnd*1000))
if len(rannum)=2 then
rannum="0" &rannum
end if
'=======End X1==========================
nnowx=now & rannum


'==========X2:数据处理====================
if Title="" then
%>
<script language=javascript>
     history.back()
     alert("请填写新闻标题!")
</script>
<%
Response.End
end if
Author=replace(trim(Request.Form("Author")),"'","''")
keyword=replace(trim(Request.Form("keyword")),"'","''")
Original=replace(trim(Request.Form("Original")),"'","''")
pic=replace(trim(Request.Form("pic")),"'","''")
smallpic=replace(pic,left(pic,9),"sFile_up")
special_id=trim(request.Form("special_id"))
if Request.Form("picshow")="" then
picshow=0
else
picshow=1
end if
if request("top1")="" then
top1=0
else
top1=1
end if
Content=replace(trim(Request.Form("Content")),"'","''")
if Content="" then
%>
<script language=javascript>
     history.back()
     alert("请输入新闻内容!")
</script>
<%
Response.End
end if


BigClassID=Request.Form("BigClassID")
if BigClassID=0 then
%>
<script language=javascript>
     history.back()
     alert("请选择该新闻所属的大类,如果系统中还没有新闻大类的话,请在《大类管理》中添加新类别!")
</script>
<%
Response.End
end if


SmallClassID=Request.Form("SmallClassID")
if SmallClassID=0 then
%>
<script language=javascript>
     history.back()
     alert("请选择该新闻所属的小类,如果系统中还没有新闻小类的话,请在《小类管理》中添加新类别!")
</script>
<%
Response.End
end if
'==========End X2=======================
%>



<%'生成HTML文件名,建立文件夹,指定文件路径
dim fname,folder,filepath
fname = makefilename(nnowx)  'makefilename为自定义函数 ,生成文件名
folder = "../Article_file/"&ddate&"/"
filepath = folder&fname
%>


<%
'============X3: 将数据存入数据库====================
sql="Insert INTO News (Title,Author,keyword,pic,smallpic,picshow,Original,Content,BigClassID,SmallClassID,[top],Special_ID,UpdateTime,FilePath) VALUES "
sql=sql & "(" & "'"& title & "'" & ","
sql=sql & "'"& Author &"'"&","
sql=sql & "'"& keyword &"'"&","
sql=sql & "'"& pic &"'"&","
sql=sql & "'"& smallpic &"'"&","
sql=sql & "'"& picshow &"'"&","
sql=sql & "'"& original &"'"&","
sql=sql & "'"& Content &"'"&","
sql=sql & BigClassID &","
sql=sql & SmallClassID &","
sql=sql & top1 &","
sql=sql & Special_ID &","
sql=sql & "'" & nnow &"'"&","
sql=sql & "'"& filepath &"')"
conn.Execute (sql)
'==============End X3=======================================


dim mb_code,fso,fout,rs1,mb_html
'打开模板代码,并将其中特殊代码转变为接受值
sql="select mb_id,mb_html from news_template where mb_id=1"
set rs=conn.execute(sql)
mb_html=rs("mb_html")
set rs=nothing
'==============X4:内分页处理========================
If InStr(Content,"分页符")<>0 Then
'================X4.1:以下要将分页的第一页的文件名改掉,不然路径不对!
set rs1=server.CreateObject("adodb.recordset")
rs1.open "select top 1 filepath from news order by newsid desc",conn,1,3
rs1("filepath")=cstr("../Article_file/"&ddate&"/"&makefilename(nnowx&"_1"))
rs1.update
rs1.close
set rs1=nothing
'================End X4.1=========================
'==============X4.2:对分页信息的预处理==================
dim arrcontent,InnerPageNum,rollnum,pagelist
arrcontent=split(content,"分页符")
InnerPageNum=ubound(arrcontent)
pagelist=" "
for rollnum=0 to InnerPageNum
  fname = makefilename(nnowx&"_"&(rollnum+1))  'makefilename为自定义函数
  pagelist=pagelist & "<a href="&fname&" target='_self'>["&(rollnum+1 target=_blank)&"]</a> "
next
'==============End X4.2===========================
for rollnum=0 to InnerPageNum
  mb_code=mb_html
  mb_code=replace(mb_code,"$keyword$",keyword)
  mb_code=replace(mb_code,"$updatetime$",nnow)
  mb_code=replace(mb_code,"$title$",title)
  mb_code=replace(mb_code,"$Author$",Author)
  mb_code=replace(mb_code,"$pic$",pic)
  mb_code=replace(mb_code,"$Original$",Original)
  mb_code=replace(mb_code,"$content$",arrcontent(rollnum)&"<br><center>分页:"&pagelist&"</center>")
  '重新确定文件夹及文件名
  fname = makefilename(nnowx&"_"&(rollnum+1))  'makefilename为自定义函数
  folder = "../Article_file/"&ddate&"/"
  filepath = folder & fname
  '========X4.3 生成Shmtl文件==============
  Set fso = Server.CreateObject("Scripting.FileSystemObject")
  '如果文件夹不存在则新建
  if not fso.Folderexists(Server.MapPath(folder)) then fso.CreateFolder(Server.MapPath(folder))
  Set fout = fso.CreateTextFile(Server.MapPath(filepath))
  fout.WriteLine mb_code
  fout.close
  set fout=nothing
  set fso=nothing
  '==========End X4.3======================
next
else
mb_code=mb_html
mb_code=replace(mb_code,"$keyword$",keyword)
mb_code=replace(mb_code,"$updatetime$",nnow)
mb_code=replace(mb_code,"$title$",title)
mb_code=replace(mb_code,"$Author$",Author)
mb_code=replace(mb_code,"$pic$",pic)
mb_code=replace(mb_code,"$Original$",Original)
mb_code=replace(mb_code,"$content$",content)
'生成HTML页面
Set fso = Server.CreateObject("Scripting.FileSystemObject")
'如果文件夹不存在则新建
if not fso.Folderexists(Server.MapPath(folder)) then fso.CreateFolder(Server.MapPath(folder))
Set fout = fso.CreateTextFile(Server.MapPath(filepath))
fout.WriteLine mb_code
fout.close
set fout=nothing
set fso=nothing
end if
'=================End X4============================
%>
内容来源:EX工作室-SEO资料站
浏览次数:0
ex 发布于 2008-1-26
评论内容
签写评论
你的姓名:
评论主题:
支持UBB: 粗体 斜体 下划线 居中 超级连接 Email连接 插入图片 关闭上传图片 Flash图片 realplay视频文件 Media Player视频文件 飞行字 移动字 发光字
评论内容:
验 证 码:   看不清楚请点击换图
 
会员登陆
用户名  
密    码  
验证码      5200
登陆  |  注册会员
验证码无法显示,请下载修复!

广告推荐
CopyRight © 2007 一厢工作室旗下网站→EX工作室SEO资料站
版权所有 多放合作    E-mail:czx1372@163.com    交流群:23115093 粤ICP备06022088号