<%
'==================================================================
'程序说明：用于自动生成新闻静态页，手动添加分页功能，自动生成页码
'
'程序作者：Www.Leadbbs.Com 简体中文版 QQ: 7275244
'
'程序用途：演示用，CopyLeft :p
'
'时间：2005年9月28日
'
'使用方法：绝对路径下建立info目录，建立Template.Html文件，
'===================================================================
if Request.ServerVariables("REQUEST_METHOD") = "POST" then
Dim Fso 'FileSystemObject
Dim Mp '存放MapPath
Dim ObjStream 'ObjStream
Dim ObjHtml 'ObjHtml建立文件
Dim FileName '文件名
Dim CountPage '计算内容中的页数
Dim ContentTemp '内容临时变量
Dim i '临时计数变量
Dim NewsContent '存储新闻内容变量
Dim NowPage '存放当前页数变量
Dim NewsPage '存储分页信息
FileName = "Test"
NewsContent = ""
NewsPage = ""
Content = Request("Content")
'写入数据库
'Insert Into Article
'按照标记分页程式
ContentTemp = Split(Content,"$分页符$")
CountPage = Ubound(ContentTemp)
if CountPage = -1 then
Response.Write("错误：没有输入新闻内容！")
Response.End()
End if
'==============
'输出检测信息
'==============
'Response.Write("共有页数:" & CountPage+1)
'Response.Write("每页显示信息为：<br>")
'For i = 0 to CountPage
'Response.Write("第" & i + 1 & "页:" & ContentTemp(i) & "<br>")
'Next
'==============
'检测输出结束
'==============
'开始生成HTML页
Set Fso = CreateObject("Scripting.FileSystemObject")
For i = 0 to CountPage
'==================
'判断页数，成生页码
'==================
if CountPage > 0 then '不是单页新闻，需要显示分页信息
if i = 0 then
NowPage = 1 '当前页
NewsPage = GetPageCount(NowPage,CountPage+1,FileName)
else
NowPage = i + 1
NewsPage = GetPageCount(NowPage,CountPage+1,FileName)
FileName = FileName & "_" & NowPage
end if
end if
'==================
'生成页码结束
'==================
Mp = Server.MapPath("/Template.Html")
Set ObjStream = Fso.OpenTextFile(Mp,1,-2)
while not ObjStream.AtEndOfStream
NewsContent= NewsContent & ObjStream.ReadLine & vbcrlf '读出文件内容
wend
'Response.Write("文件：" & FileName & ".Html 第" & i + 1 & "次写入值为：" & ContentTemp(i) & "<br>")
NewsContent=Replace(NewsContent,"{Content}",ContentTemp(i))
NewsContent=Replace(NewsContent,"{NewsPage}",NewsPage)
Dir = Server.MapPath("/info") & "\"
Set ObjHtml = Fso.CreateTextFile(Dir & "/" & FileName & ".Html")
ObjHtml.WriteLine NewsContent
NewsContent = "" '复原新闻内容变量
FileName = Left(FileName,4) '复原原文件名称
Next
Set Fso = Nothing
Response.Redirect(Request.ServerVariables("HTTP_REFERER"))
End if
Function GetPageCount(NowPage,CountPage,FileName) '自动生成页码
'==========显示结果============
'上一页 1 2 3 下一页
'上一页 ... 4 5 6 下一页
'上一页 1 2 3 ... 下一页
'上一页 ... 4 5 6 ... 下一页
'==============================
Dim ShowPageNum '定义显示页码数量
Dim PageUp '上页
Dim PageDown '下页
Dim i '循环变量
ShowPageNum = 7 '最好是单数，好看一些 ... 11 12 13 <14> 15 16 17 ...
PageUp = ""
PageDown = ""
if NowPage=1 then
GetPageCount = GetPageCount & "<a href=""" & FileName & ".html""><font color=""#ff0000""><b>1</b></font></a> "
else
GetPageCount = GetPageCount & "<a href=""" & FileName & ".html"">1</a> "
end if
if CountPage <= ShowPageNum then
For i = 2 to CountPage
GetPageCount = GetPageCount & "<a href=""" & FileName & "_" & i & ".html"">" & GetColor(i,NowPage) & "</a> "
Next
else '页数大于自定义的显示页码数量
if (NowPage - 3) > 1 and (NowPage + 3) < CountPage then
GetPageCount = "... "
For i = NowPage - 3 to NowPage + 3
GetPageCount = GetPageCount & "<a href=""" & FileName & "_" & i & ".html"">" & GetColor(i,NowPage) & "</a> "
Next
GetPageCount = GetPageCount & "..."
else
if (NowPage - 3) > 1 and (NowPage + 3) => CountPage then
GetPageCount = "... "
For i = CountPage - ShowPageNum to CountPage
GetPageCount = GetPageCount & "<a href=""" & FileName & "_" & i & ".html"">" & GetColor(i,NowPage) & "</a> "
Next
else
For i = 2 to ShowPageNum
GetPageCount = GetPageCount & "<a href=""" & FileName & "_" & i & ".html"">" & GetColor(i,NowPage) & "</a> "
Next
GetPageCount = GetPageCount & "..."
end if
end if
End if
'加首头页尾
if NowPage > 1 then
if NowPage > 2 then
PageUp = "<a href=""" & FileName & "_" & NowPage - 1 & ".html"">上页</a> "
else
PageUp = "<a href=""" & FileName & ".html"">上页</a> "
end if
end if
if NowPage < CountPage then
PageDown = "<a href=""" & FileName & "_" & NowPage + 1 & ".html"">下页</a> "
End if
GetPageCount = "<a href=""" & FileName & ".html"">首页</a> " & PageUp & GetPageCount & PageDown & "<a href=""" & FileName & "_" & CountPage & ".html"">末页</a>"
End Function
Function GetColor(i,NowPage) '当前页标志色
if i = NowPage then
GetColor = "<font color=""#ff0000""><b>" & NowPage & "</b></font>"
else
GetColor = i
end if
End Function
%>
<form name="form1" method="post" action="1.asp">
<textarea name="Content" cols="100" rows="8"></textarea>
<input type="button" name="Submit" value="插入分页" onClick="form1.Content.value+='$分页符$';form1.Content.focus();">
<input type="submit" name="Submit" value="提交">
</form>
