<%
REM -----------------------------------
REM 作 者：王勤军 qinjunit@yahoo.com
REm 创作日期：2004-10-12
REM 修改日期：2005年1月24日 星期一
REM -----------------------------------
'函数 实用数据分页显示函数
'参数：DataSQL ----------- 当前页面数据的SQL语句
'参数：CountSQL ----------- 查询总条数的SQL语句
'参数：Page ----------- 哪 页
'参数：PageSize ----------- 页 次
'参数：THeadStrings ------- 显示表头列名称定义，用“,”分隔，与DataSQL里面的列名对应。
'实 例：=======================================
'<!--#include virtual="inc/conn.asp"-->
'<!--#include virtual="inc/RW_DataPager.asp"-->
'<%
'dim iPageSize,CurPage
' iPageSize = 18
' CurPage = 1
'if (Request.Form <> "") then
' if IsEmpty(Request.Form("p")) then
' CurPage = 1
' elseif IsNumeric(Request.Form("p")) then
' CurPage = CLng(Request.Form("p"))
' end if
'end if
'ShowRecords "exec p_show accounts,"&iPageSize&","&CurPage&",'account_code,account_password,account_serial,account_type,account_money,stock_time'","select count(account_code) as total from [accounts]",CLng(CurPage),iPageSize,"卡号,密码,序列号,卡类型,卡金额,入库时间"
'CloseDB()
'% >
''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub ShowRecords(DataSQL,CountSQL,Page,PageSize,ModelStrings,THeadStrings)
dim total,rs,DatMessages
dim UseDataModel
if (Request.Form("pagerTotal") <> "") then
total = CLng(Request.Form("PagerTotal"))
else
total = conn.execute(CountSQL)(0)
end if
if Len(ModelStrings)<8 then '模版长度在此定义为8
UseDataModel = false
else
UseDataModel = true
end if
DatMessages = DatMessages & "<table width=""100%"" border=""0"" align=""center"" cellpadding=""0"" cellspacing=""0"" style=""Border-Collapse:collapse;word-break:break-all"">"
DatMessages = DatMessages & "<form name=""frmPager"" id=""frmPager"" method=""post"">"
if Clng(total) <> 0 then
'set rs = conn.execute(DataSQL)
REM 非存储过程分页====================
set rs=server.createobject("ADODB.RECORDSET")
rs.Open DataSQL,conn,1,1
rs.PageSize=PageSize
rs.AbsolutePage=Page
REM ==================================
dim thArray,ColCount,k,thStr,i
i = 1 '初始化记数器
ColCount = rs.Fields.Count '获取总列数
if not UseDataModel then '不使用模版操作
if Len(THeadStrings)<1 then
for k = 0 to (rs.Fields.Count-1)
thStr = thStr & rs.Fields(k).name&","
next
thArray = Split((Mid(thStr,1,len(thStr)-1)),",")
else
thArray = Split(THeadStrings,",")
End if
DatMessages = DatMessages & "<tr bgcolor=""#BFE8FB"">"
for k=0 to (ColCount-1)
DatMessages = DatMessages & "<th class='hyxxtext'>"&thArray(k)&"</th>"
next
DatMessages = DatMessages & "</tr>"
else
DatMessages = DatMessages & "<tr><td>"
end if
'---------数据循环开始------------'
while (not rs.eof and i<PageSize)
if not UseDataModel then
if (i mod 2 =0 ) then
DatMessages = DatMessages & "<tr bgcolor=""#E1F4FD"">"
else
DatMessages = DatMessages & "<tr bgcolor=""#FFFFFF"">"
end if
for k=0 to (ColCount-1)
DatMessages = DatMessages & "<td>"&rs(k)&"</td>"
next
DatMessages = DatMessages & "</tr>"
else '批量替换模版数据
Dim OneNoteString
OneNoteString = ModelStrings
for k=0 to (ColCount-1)
if IsNull(rs(k)) then
OneNoteString = Replace(OneNoteString,"{$DATA#"&(k+1)&"}","")
else
OneNoteString = Replace(OneNoteString,"{$DATA#"&(k+1)&"}",HtmlString(rs(k)))
end if
next
DatMessages = DatMessages & OneNoteString
end if
i=i+1
rs.movenext
wend
rs.close()
set rs = nothing
'----------数据循环结束-----------'
if not UseDataModel then
DatMessages = DatMessages & "<tr bgcolor=""#f3f3f3""><td colspan="""&(ColCount+1)&""" align=""left"" height=""22"" valign=""middle"">"&Data_Pager(total,Page,PageSize)&"</td></tr>"
else
DatMessages = DatMessages & "</td></tr><tr bgcolor=""#f3f3f3""><td align=""left"" height=""22"" valign=""middle"">"&Data_Pager(total,Page,PageSize)&"</td></tr>"
end if
else
DatMessages = DatMessages & "<tr bgcolor=""#f3f3f3""><td colspan="""&(ColCount+1)&""" align=""center"" height=""120"" valign=""middle"">没有符合要求数据</td></tr>"
end if
DatMessages = DatMessages & "</form></table>"
Response.Write(DatMessages)
End Sub
function Data_Pager(total,curPage,pagesize)
'''''''''''''''''''''''''''''''
dim JSGoFunction
JSGoFunction = "<script language=""javascript"">"&_
"function PostPager(n){var obj = document.frmPager;obj.p.value = n;obj.pagerCurrent.value = n;obj.submit();}</script>"
'''''''''''''''''''''''''''''''''''''''''''''
dim pstr,jumpstr,totalpage
dim prePage,nextPage
jumpstr = "<input type='text' name='p' style='width:30px;hight:12px' value='"&curPage&"' class='entxt' onkeydown=""if(event.keyCode==13){if(doCheck(this)){event.returnValue=false;PostPager(this.value);}else{event.returnValue=false;}}"" >"
if (total mod pagesize > 0) then
totalpage = Fix(total/pagesize) + 1
else
totalpage = total/pagesize
end if
if (curPage>totalpage) then curPage=totalpage
if (curPage<1) then curPage = 1
if (curPage=1) then
prePage = "上一页"
else
prePage = "<a href=""javascript:PostPager(" &(curPage-1)& ");"">上一页</a>"
end if
if (curPage = totalpage) then
nextPage = "下一页"
else
nextPage = "<a href=""javascript:PostPager(" &(curPage+1)& ");"">下一页</a>"
end if
pstr = "<style type=""text/css"">* {font-size:12px;};.entxt {font-size:10px;font-family:'verdana'}</style>"&JSGoFunction &"<script language=""Javascript"">function doCheck(el){var r=new RegExp(""^\\s*(]"&totalpage&"){alert'\d+)\s*$"");if(r.test(el.value)){if(RegExp.$1<1||RegExp.$1>"&totalpage&"){alert(""页数超出范围！"");document.all['p'].select();return false;}return true;}alert(""页索引无效！"");document.all['p'].select();return false;}</script>"
Data_Pager = pstr & "共 <span class='entxt'>"&total&"</span> 条 每页<span class='entxt'>"&pagesize&"</span>条 当前<span class='entxt'><font color=red class='entxt'>"&curPage&"</font>/"&totalpage&"</span>页 <a href=""javascript:PostPager(1);"">首页</a> "&prePage&" "& nextPage &" <a href=""javascript:PostPager("&totalpage&");"">尾页</a> 跳到"&jumpstr&"页<input type=""hidden"" value="""&total&""" name=""pagerTotal""><input type=""hidden"" value="""&curPage&""" name=""pagerCurrent"">"
end function
Const fsobj = "Scripting.FileSystemObject"
'从物理文件中获取专题模板内容
'参数：sTemplateFile --------------- 模板文件相对路径
'返回：该文本文件的内容
Function GetTemplateContent(sTemplateFile)
dim fso,hf
set fso = Server.CreateObject(fsobj)
set hf = fso.OpenTextFile(Server.mappath(sTemplateFile))
GetTemplateContent = hf.ReadAll
hf.Close
set hf=nothing
set fo=nothing
End Function
'生成专题主页面文件
'参数：URLPath --------------- 文件相对路径
'参数：iSubcode --------------- 专题编号
'参数：subContent --------------- 专题内容
'返回：生成静态html文件
Sub SetSubjectFile(URLPath,iSubcode,subContent)
dim fso,hf
set fso = Server.CreateObject(fsobj)
set hf = fso.CreateTextFile(Server.mappath(URLPath)&"/"&iSubcode&".html",true)
hf.write subContent
hf.Close
set hf=nothing
set fo=nothing
End Sub
'获取模板循环内容块
'参数 sCycleName ------------ 循环名称，经测试名称必须为英文名称。
'参数 sTptContent ------------ 模块内容
'说明：
'[$TitleCycle-S] 循环开始标志
'[$TitleContent**] 循环内容,即要替换的内容
'[$TitleCycle-E] 循环结束标志
'以上循环名称为 "TitleCycle"
Function tpt_CycleContent(sCycleName,sTptContent)
dim ps,pe
ps = Instr(1,sTptContent,"[$"&sCycleName&"-S]",1) + len("[$"&sCycleName&"-S]")
pe = Instr(ps,sTptContent,"[$"&sCycleName&"-E]",1)
if (pe<=ps) or (ps<=0) or (pe<=0) then
tpt_CycleContent = "Error:not found."
Exit Function
end if
tpt_CycleContent = Mid(sTptContent,ps,(pe-ps))
End Function
'清除循环开始和结尾标记
'参数 sCycleName ------------ 循环名称，经测试名称必须为英文名称。
'参数 sTptContent ------------ 模块内容
Function tpt_CycleTagClear(sCycleName,sTptContent)
if (Instr(1,sTptContent,"[$"&sCycleName&"-S]",1)>0) and (Instr(1,sTptContent,"[$"&sCycleName&"-E]",1)>0) then
tpt_CycleTagClear = Replace(Replace(sTptContent,"[$"&sCycleName&"-S]",""),"[$"&sCycleName&"-E]","")
else
tpt_CycleTagClear = sTptContent
end if
End Function
'清除模板中的循环内容
'参数 sCycleName ------------ 循环名称，经测试名称必须为英文名称。
'参数 sTptContent ------------ 模块内容
Function tpt_CycleClear(sCycleName,sTptContent)
if (Instr(1,sTptContent,"[$"&sCycleName&"-S]",1)>0) and (Instr(1,sTptContent,"[$"&sCycleName&"-E]",1)>0) then
dim ps,pe
ps = Instr(1,sTptContent,"[$"&sCycleName&"-S]",1)
pe = Instr(ps,sTptContent,"[$"&sCycleName&"-E]",1)+ len("[$"&sCycleName&"-E]")
if (pe<=ps) or (ps<=0) or (pe<=0) then
tpt_CycleClear = sTptContent
Exit Function
else
tpt_CycleClear = Replace(sTptContent,Mid(sTptContent,ps,(pe-ps)),"")
end if
else
tpt_CycleClear = sTptContent
end if
End Function
'按指定模板内容循环
'参数 RsArray ------------ 数据集、二维数组 (字段名或字段名索引，数据索引)
'参数 ReplaceArray ------------ 替换集、二维数组 (待替换的内容,数据集索引,模板规则)
'参数 CycleCont ------------ 循环模板
'说明：
'CycleCont可以通过函数 tpt_CycleContent(sCycleName,sTptContent) 获得
'ReplaceArray 实例说明
'Dim rpArray(1,2)
' rpArray(0,0) = "[$PicContent]" 模板中的内容
' rpArray(0,1) = 1 数据集中的第2列
' rpArray(0,2) = "<img src='http://www.witol.com/ImageFiles/$' border='0'>" 模板规则
' ====模板规则中的$即数据库集中相应列的内容====
' rpArray(1,0) = "[$Pic]" 模板中的内容
' rpArray(1,1) = 0 数据集中的第2列
' rpArray(1,2) = "" 不应用模板规则
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function tpt_Cycle(RsArray,ReplaceArray,CycleCont)
dim i,k,RsCount,RpCount
dim MidStr,RetStrings,rCycleCont
RsCount = UBound(RsArray,2)
RpCount = UBound(ReplaceArray)
for i=0 to RsCount
''''''''''''''''用当前数据替换模板内容
for k=0 to RpCount
MidStr = RsArray(CInt(ReplaceArray(k,1)),i)
if IsNull(MidStr) then MidStr =" "
if k=0 then rCycleCont = CycleCont
if len(ReplaceArray(k,2)) <1 then
rCycleCont = Replace(rCycleCont,ReplaceArray(k,0),MidStr)
else
rCycleCont = Replace(rCycleCont,ReplaceArray(k,0),Replace(ReplaceArray(k,2),"$",MidStr))
end if
next
''''''''''''''''''''''''''''''''''''''''
RetStrings = RetStrings & rCycleCont
next
tpt_Cycle = RetStrings
End Function
'''获取含子循环的数据内容
'参数 RsArray ------------ 数据集、二维数组 (字段名或字段名索引，数据索引)
'参数 ReplaceArray ------------ 替换集、二维数组 (待替换的内容,数据集索引,模板规则)
'参数 CycleCont ------------ 循环模板
'参数 ChildCycle ------------ 子循环一维数组 ChildCycle(含变量的SQL语句,对应关系列索引,替换关系二维数组,循环块标记名称)
'说明：具体说明参见函数 Function tpt_Cycle(RsArray,ReplaceArray,CycleCont)
'关于ChileCycle参数的实例 ================================
'dim rpArray2(2,2)
' rpArray2(0,0) = "[$TopicID]"
' rpArray2(0,1) = 0
' rpArray2(0,2) = ""
' rpArray2(1,0) = "[$TopicContent]"
' rpArray2(1,1) = 1
' rpArray2(1,2) = ""
' rpArray2(2,0) = "[$TopicClass]"
' rpArray2(2,1) = 2
' rpArray2(2,2) = ""
'dim ChildCycle(3)
' ChildCycle(0) = "select i_id,i_title,i_class from ls_info_main join listtable on ls_info_main.i_tcode=listtable.listid where listtable.unoffical=0 and i_flag=1 and listtable.listcode like '$%' order by idcode asc"
' ChildCycle(1) = 0
' ChildCycle(2) = rpArray2
' ChildCycle(3) = "TopicCycle"
''''''''''''''''''''''''''''''''''''''''''''''''''
Function tpt_MultiCycle(RsArray,ReplaceArray,CycleCont,ChildCycle)
dim i,k,RsCount,RpCount
dim MidStr,RetStrings,rCycleCont
RsCount = UBound(RsArray,2)
RpCount = UBound(ReplaceArray)
for i=0 to RsCount
''''''''''''''''用当前数据替换模板内容
for k=0 to RpCount
MidStr = RsArray(CInt(ReplaceArray(k,1)),i)
if IsNull(MidStr) then MidStr=" "
if k=0 then rCycleCont = CycleCont
if len(ReplaceArray(k,2)) <1 then
rCycleCont = Replace(rCycleCont,ReplaceArray(k,0),MidStr)
else
rCycleCont = Replace(rCycleCont,ReplaceArray(k,0),Replace(ReplaceArray(k,2),"$",MidStr))
end if
next
REM Child Added
if IsArray(ChildCycle) then
if (UBound(ChildCycle)=3) then
dim rs,sql,mRsArray
dim mCycleCont,cCycleTpt
sql = Replace(ChildCycle(0),"$",RsArray(ChildCycle(1),i))
cCycleTpt = tpt_CycleContent(ChildCycle(3),rCycleCont)
set rs = conn.Execute(sql)
if not rs.eof then
mRsArray = rs.GetRows()
mCycleCont = tpt_MultiCycle(mRsArray,ChildCycle(2),cCycleTpt,"") 'Get Data
rCycleCont = Replace(rCycleCont,cCycleTpt,mCycleCont) 'Replace Template with Data
rCycleCont = tpt_CycleTagClear(ChildCycle(3),rCycleCont) 'Clear Template Tag
else
rCycleCont = tpt_CycleClear(ChildCycle(3),rCycleCont) 'Clear Template
end if
rs.Close()
set rs = nothing
end if
end if
Rem End
''''''''''''''''''''''''''''''''''''''''
RetStrings = RetStrings & rCycleCont
next
tpt_MultiCycle = RetStrings
End Function
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'批量替换模板内容
'参数 tptContent ------------ 模板内容
'参数 ReplaceArray ------------ 替换集、二维数组 (待替换的内容,替换内容,模板规则)
'说明 模板规则里一般包含替换内容的指定符号"$"
Function tpt_ReWrite(tptContent,ReplaceArray)
Dim RpCount,i,RetStrings
RetStrings = tptContent
RpCount = UBound(ReplaceArray)
for i=0 to RpCount
if (len(ReplaceArray(i,2))<1) then
RetStrings = Replace(RetStrings,ReplaceArray(i,0),ReplaceArray(i,1))
else
RetStrings = Replace(RetStrings,ReplaceArray(i,0),Replace(ReplaceArray(i,2),"$",ReplaceArray(i,1)))
end if
next
tpt_ReWrite = RetStrings
End Function
%>
