忠网广告 系统 用到的几个函数
程序员文章站
2024-02-06 19:40:34
复制代码 代码如下:<% '///************************************************************...
复制代码 代码如下:
<%
'///******************************************************************
' 常用公共函数库 文件名：pubfunction.asp
'******************************************************************///
const go_back="<a href='javascript:history.back(1)'>[返回上页]</a>"
const closer="<a href='javascript:self.close()'>『关闭窗口』</a>"
'//********************************************************************
' pubfgdy(test,tag,bh) 根据分隔符和标号调用指定字符串的指定值函数，参数：test 被分隔的字符串，tag 分隔符，bh 标号
'********************************************************************//
function pubfgdy(test,tag,bh)
pubfgdy=""
if test<>"" and isnumeric(bh)=true then
dim tests
tests=split(test&tag,tag)
if bh<ubound(tests) then
pubfgdy=tests(bh)
end if
else
pubfgdy=""
exit function
end if
end function
'//********************************************************************
' pubcodegf(oldtest) 代码规范函数， 参数：oldtest 原始内容， newtest 新内容
'********************************************************************//
function pubcodegf(oldtest)
dim newtest:newtest=trim(oldtest)
if isnull(newtest) or newtest="" then code_admin="":exit function
newtest=replace(newtest,"'","""")
pubcodegf=newtest
end function
'//********************************************************************
' pubcodehtml(oldtest) 屏蔽html代码函数， 参数：oldtest 原始内容， newtest 新内容
'********************************************************************//
function pubcodehtml(oldtest)
dim newtest:newtest=oldtest
if isnull(newtest) or newtest="" then pubcodehtml="":exit function
newtest=replace(newtest,"<","<")
newtest=replace(newtest,">",">")
newtest=replace(newtest,chr(39),"'") '单引号
newtest=replace(newtest,chr(34),""") '双引号
newtest=replace(newtest,chr(32)," ") '空格
newtest=replace(newtest,chr(9)," ")'table
newtest=replace(newtest,chr(10),"<br>") '回车
newtest=replace(newtest,chr(13),"<br>")
pubcodehtml=newtest
end function
'//********************************************************************
' pubctime() 组合系统时间为正常字符串 含 年、月、日、时、分、秒 如：200412172356
'********************************************************************//
function pubctime()
dim gcchars
gcchars = now()
gcchars = replace(gcchars,"-","")
gcchars = replace(gcchars," ","")
gcchars = replace(gcchars,":","")
gcchars = replace(gcchars,"pm","")
gcchars = replace(gcchars,"am","")
gcchars = replace(gcchars,"上午","")
gcchars = replace(gcchars,"下午","")
gcchars = int(gcchars) + int((10-1+1)*rnd + 1)
pubctime=gcchars
end function
'//********************************************************************
' pubfolderifcz(foldername) 判断目录是否存在，需要 fso支持 参数：foldername
'********************************************************************//
function pubfolderifcz(foldername)
dim fso
folderifcz=false
if foldername<>"" then
foldername=server.mappath(foldername)
set fso = server.createobject("scripting.filesystemobject")
if fso.folderexists(foldername) then
folderifcz=true
end if
set fso = nothing
end if
end function
'//********************************************************************
' pubfileifcz(filename) 判断文件是否存在，需要 fso支持 参数：filename
'********************************************************************//
function pubfileifcz(filename)
dim fso
pubfileifcz=false
if filename<>"" then
filename=server.mappath(filename)
set fso = server.createobject("scripting.filesystemobject")
if fso.fileexist(filename) then
pubfileifcz=true
end if
set fso = nothing
end if
end function
'//********************************************************************
' pubdeletefile(filename) 删除文件，需要 fso支持 参数：filename 预删除文件的相对路径
'********************************************************************//
function pubdeletefile(filename) '删除文件
dim fso
if filename<>"" then
filename=server.mappath(filename)
set fso = server.createobject("scripting.filesystemobject")
if fso.fileexists(filename) then
fso.deletefile filename
pubdeletefile="suc"
end if
set fso = nothing
end if
end function
'//********************************************************************
' pubdeletefolder(foldername) 删除目录，需要 fso支持 参数：foldername 预删除目录的相对路径
'********************************************************************//
function pubdeletefolder(foldername) '删除目录
dim fso
if foldername<>"" then
foldername=server.mappath(foldername)
set fso = server.createobject("scripting.filesystemobject")
if fso.folderexists(foldername) then
fso.deletefolder foldername
pubdeletefolder="suc"
end if
set fso = nothing
end if
end function
'//********************************************************************
' pubcopyfile(filename,filenewname) 拷贝文件，需要 fso支持 参数：filename 预拷贝文件的相对路径，filenewname 拷贝目标名
'********************************************************************//
function pubcopyfile(filename,filenewname)
dim fso,f
if filename<>"" and filenewname<>"" then
filename=server.mappath(filename)
filenewname=server.mappath(filenewname)
set fso = server.createobject("scripting.filesystemobject")
set f = fso.getfile(filename)
f.copy filenewname,true
set fso = nothing
set f = nothing
pubcopyfile="suc"
end if
end function
'//********************************************************************
' pubsetfolder(foldername) 新建目录，需要 fso支持 参数：foldername 目录名称
'********************************************************************//
function pubsetfolder(foldername)
dim fso
if foldername<>"" then
foldername=server.mappath(foldername)
set fso = server.createobject("scripting.filesystemobject")
if fso.folderexists(foldername)=false then
fso.createfolder foldername
end if
set fso = nothing
pubsetfolder="suc"
end if
end function
'/********************************************************************
' pubeditxml(xmlname,rootsite,rootsitesn,texts) 修改某xml一条数据，参数：xmlname 文件名称，rootsite 指定选取的父节点，rootsitesn 要依次更新的子节点号(整数)列表（用“|”分割），texts 赋值内容列表（以 “/$/”分割）
'********************************************************************/
sub pubeditxml(xmlname,rootsite,rootsitesn,texts)
dim fso
if xmlname<>"" then
xmlname=server.mappath(xmlname) '获取xml文件的路径这里根据虚拟目录不同而不同
set fso = server.createobject("scripting.filesystemobject")
if fso.fileexists(xmlname) then '如果文件存在，则继续 ...
dim strsourcefile,objxml,objrootsite,texti,textss,rootsitesns,rootsitesni
strsourcefile = xmlname
set objxml =server.createobject("microsoft.xmldom") '创建一个xml对像
objxml.load(strsourcefile) '把xml文件读入内存
set objrootsite = objxml.documentelement.selectsinglenode(rootsite)
textss=split(texts&"/$/","/$/")
texti=0
rootsitesns=split(rootsitesn&"|","|")
for rootsitesni=0 to ubound(rootsitesns)-1
objrootsite.childnodes.item(rootsitesns(rootsitesni)).text=textss(texti)
texti=texti+1
next
objxml.save(strsourcefile)
set objxml =nothing
'' 释放 fso
set fso = nothing
end if
end if
end sub
'/********************************************************************
' pubnewxml(xmlname,rootsite,rootsitesn,texts,indexsite) 新增 xml一条数据，参数：xmlname 文件名称，rootsite 指定选取的父节点，indexsite 新增内容主节点，rootsitesn 要依次新增的子节点名列表（用“|”分割），texts 赋值内容列表（以 “/$/”分割）
'********************************************************************/
sub pubnewxml(xmlname,rootsite,rootsitesn,texts,indexsite)
dim fso
dim brstr:brstr=chr(13)&chr(10)&chr(9) '规范 xml 样式
if xmlname<>"" then
xmlname=server.mappath(xmlname) '获取xml文件的路径这里根据虚拟目录不同而不同
set fso = server.createobject("scripting.filesystemobject")
if fso.fileexists(xmlname) then '如果文件存在，则继续 ...
dim strsourcefile,objxml,objrootsite,texti,textss,rootsitesns,rootsitesni,xmlnode
strsourcefile = xmlname
set objxml =server.createobject("microsoft.xmldom") '创建一个xml对像
objxml.load(strsourcefile) '把xml文件读入内存
set objrootsite = objxml.documentelement.selectsinglenode(rootsite)
'根据得到的数据循环个节点名、值建立xml片段
xmlnode=brstr&"<"&indexsite&">"
textss=split(texts&"/$/","/$/")
texti=0
rootsitesns=split(rootsitesn&"|","|")
for rootsitesni=0 to ubound(rootsitesns)-1
xmlnode=xmlnode&brstr&"<"&rootsitesns(rootsitesni)&">"&textss(texti)&"</"&rootsitesns(rootsitesni)&">"
texti=texti+1
next
xmlnode=xmlnode&brstr&"</"&indexsite&">"&brstr
dim objxml2,rootnewnode
set objxml2=server.createobject("microsoft.xmldom") '建立一个新xml对像
objxml2.loadxml(xmlnode) '把xml版片段读入内存中
set rootnewnode=objxml2.documentelement '获得objxml2的根节点
objrootsite.appendchild(rootnewnode) '把xml片段插入
objxml.save(strsourcefile)
set objxml =nothing
'' 释放 fso
set fso = nothing
end if
end if
end sub
'//********************************************************************
' pubcsize(tsize) kb、mb、gb 单位转换函数
'********************************************************************//
function pubcsize(tsize)
if tsize>=1073741824 then
pubcsize=round(int((tsize/1073741824)*1000)/1000,2) & " gb"
elseif tsize>=1048576 then
pubcsize=round(int((tsize/1048576)*1000)/1000,2) & " mb"
elseif tsize>=1024 then
pubcsize=round(int((tsize/1024)*1000)/1000,2) & " kb"
else
pubcsize=round(tsize,2) & "b"
end if
end function
'//********************************************************************
' pubifzhengshu(shu) 判断是否为正整数 ， 参数：shu 要判断的数字
'********************************************************************//
function pubifzhengshu(shu)
pubifzhengshu="yes"
dim shus,shui
shus=split(shu,"")
for shui=0 to ubound(shus)
if isnumeric(shus(shui))=false then
pubifzhengshu="no"
exit function
end if
next
end function
'/********************************************************************
' pubpagegs() 格式化分页， rssum 总数，nummer 每页数目，page 当前页码
'********************************************************************/
sub pubpagegs()
if rssum mod nummer > 0 then
thepages=rssum\nummer+1
else
thepages=rssum\nummer
end if
page=trim(request("page"))
if not(isnumeric(page)) then page=1
if int(page)>int(thepages) or int(page)<1 then
viewpage=1
else
viewpage=int(page)
end if
end sub
'//********************************************************************
' pubpage1(maxpage,thepages,viewpage,pageurl,pp,font_color) 通用分页函数 (1)
' maxpage,thepages,viewpage,pageurl 链接地址前缀,pp,font_color 显示字体色
'********************************************************************//
function pubpage1(maxpage,thepages,viewpage,pageurl,pp,font_color)
dim pn,pi,page_num,ppp,pl,pr:pi=1
ppp=pp\2
if pp mod 2 = 0 then ppp=ppp-1
pl=viewpage-ppp
pr=pl+pp-1
if pl<1 then
pr=pr-pl+1:pl=1
if pr>thepages then pr=thepages
end if
if pr>int(thepages) then
pl=pl+thepages-pr:pr=thepages
if pl<1 then pl=1
end if
if pl>1 then
pubpage1=pubpage1&" <a href='"& pageurl &"' title='第一页'>[|<]</a> " & _
" <a href='"& pageurl &"page="&pl-1&"' title='上一页'>[<]</a> "
end if
for pi=pl to pr
if cint(viewpage)=cint(pi) then
pubpage1=pubpage1&" <font color=" & font_color & ">[" & pi & "]</font> "
else
pubpage1=pubpage1&" <a href='"& pageurl &"page="& pi &"' title='第 " & pi & " 页'>[" & pi & "]</a> "
end if
next
if pr<thepages then
pubpage1=pubpage1&" <a href='"& pageurl &"page="&pi&"' title='后一页'>[>]</a> " & _
" <a href='"& pageurl &"page="& thepages &"' title='最后一页'>[>|]</a> "
end if
end function
'//********************************************************************
' pubpage2(viewpage,thepages,pageurl) 通用分页函数 (2)
' maxpage,thepages,viewpage,pageurl 链接地址前缀
'********************************************************************//
function pubpage2(viewpage,thepages,pageurl)
dim re_color,pf0,pf1,pf2,pf3,pf4,pf5
re_color="#c0c0c0"
pf0="已是第一页"
pf1="第一页"
pf2="上一页"
pf3="下一页"
pf4="最后一页"
pf5="已是最后一页"
pubpage2=vbcrlf & "<table border=0 cellspacing=0 cellpadding=0><tr><form action='"&pageurl&"' method=post><td>"
if cint(viewpage)=1 then
pubpage2=pubpage2 & vbcrlf & "<font color="&re_color&">"&pf0&"</font> "
else
pubpage2=pubpage2 & vbcrlf & "<a href='"&pageurl&"page=1' alt='"&pf1&"'>"&pf1&"</a>┋<a href='"&pageurl&"page="&cint(viewpage)-1&"' alt='"&pf2&"'>"&pf2&"</a> "
end if
if cint(viewpage)=cint(thepages) then
pubpage2=pubpage2 & vbcrlf & "<font color="&re_color&" alt='"&pf5&"'>"&pf5&"</font>"
else
pubpage2=pubpage2 & vbcrlf & "<a href='"&pageurl&"page="&cint(viewpage)+1&"' alt='"&pf3&"'>"&pf3&"</a>┋<a href='"&pageurl&"page="&cint(thepages)&"' alt='"&pf4&"'>"&pf4&"</a>"
end if
if cint(thepages)<>1 then
pubpage2=pubpage2 & vbcrlf & " <input type=text name=page value='"&viewpage&"' size=2> <input type=submit value='go'>"
end if
pubpage2=pubpage2 & vbcrlf & "</td></form></tr></table>"
end function
'//********************************************************************************
' pubobject_install(strclassstring) 组件判断函数 值为 true 时 说明服务器支持该组件
' 参数：strclassstring 组件标示
'**********************************************************************************//
function pubobject_install(strclassstring)
on error resume next
pubobject_install=false
dim xtestobj
err=0
set xtestobj=server.createobject(strclassstring)
if err=0 then pubobject_install=true
set xtestobj=nothing
err=0
end function
%>
'///******************************************************************
' 常用公共函数库 文件名：pubfunction.asp
'******************************************************************///
const go_back="<a href='javascript:history.back(1)'>[返回上页]</a>"
const closer="<a href='javascript:self.close()'>『关闭窗口』</a>"
'//********************************************************************
' pubfgdy(test,tag,bh) 根据分隔符和标号调用指定字符串的指定值函数，参数：test 被分隔的字符串，tag 分隔符，bh 标号
'********************************************************************//
function pubfgdy(test,tag,bh)
pubfgdy=""
if test<>"" and isnumeric(bh)=true then
dim tests
tests=split(test&tag,tag)
if bh<ubound(tests) then
pubfgdy=tests(bh)
end if
else
pubfgdy=""
exit function
end if
end function
'//********************************************************************
' pubcodegf(oldtest) 代码规范函数， 参数：oldtest 原始内容， newtest 新内容
'********************************************************************//
function pubcodegf(oldtest)
dim newtest:newtest=trim(oldtest)
if isnull(newtest) or newtest="" then code_admin="":exit function
newtest=replace(newtest,"'","""")
pubcodegf=newtest
end function
'//********************************************************************
' pubcodehtml(oldtest) 屏蔽html代码函数， 参数：oldtest 原始内容， newtest 新内容
'********************************************************************//
function pubcodehtml(oldtest)
dim newtest:newtest=oldtest
if isnull(newtest) or newtest="" then pubcodehtml="":exit function
newtest=replace(newtest,"<","<")
newtest=replace(newtest,">",">")
newtest=replace(newtest,chr(39),"'") '单引号
newtest=replace(newtest,chr(34),""") '双引号
newtest=replace(newtest,chr(32)," ") '空格
newtest=replace(newtest,chr(9)," ")'table
newtest=replace(newtest,chr(10),"<br>") '回车
newtest=replace(newtest,chr(13),"<br>")
pubcodehtml=newtest
end function
'//********************************************************************
' pubctime() 组合系统时间为正常字符串 含 年、月、日、时、分、秒 如：200412172356
'********************************************************************//
function pubctime()
dim gcchars
gcchars = now()
gcchars = replace(gcchars,"-","")
gcchars = replace(gcchars," ","")
gcchars = replace(gcchars,":","")
gcchars = replace(gcchars,"pm","")
gcchars = replace(gcchars,"am","")
gcchars = replace(gcchars,"上午","")
gcchars = replace(gcchars,"下午","")
gcchars = int(gcchars) + int((10-1+1)*rnd + 1)
pubctime=gcchars
end function
'//********************************************************************
' pubfolderifcz(foldername) 判断目录是否存在，需要 fso支持 参数：foldername
'********************************************************************//
function pubfolderifcz(foldername)
dim fso
folderifcz=false
if foldername<>"" then
foldername=server.mappath(foldername)
set fso = server.createobject("scripting.filesystemobject")
if fso.folderexists(foldername) then
folderifcz=true
end if
set fso = nothing
end if
end function
'//********************************************************************
' pubfileifcz(filename) 判断文件是否存在，需要 fso支持 参数：filename
'********************************************************************//
function pubfileifcz(filename)
dim fso
pubfileifcz=false
if filename<>"" then
filename=server.mappath(filename)
set fso = server.createobject("scripting.filesystemobject")
if fso.fileexist(filename) then
pubfileifcz=true
end if
set fso = nothing
end if
end function
'//********************************************************************
' pubdeletefile(filename) 删除文件，需要 fso支持 参数：filename 预删除文件的相对路径
'********************************************************************//
function pubdeletefile(filename) '删除文件
dim fso
if filename<>"" then
filename=server.mappath(filename)
set fso = server.createobject("scripting.filesystemobject")
if fso.fileexists(filename) then
fso.deletefile filename
pubdeletefile="suc"
end if
set fso = nothing
end if
end function
'//********************************************************************
' pubdeletefolder(foldername) 删除目录，需要 fso支持 参数：foldername 预删除目录的相对路径
'********************************************************************//
function pubdeletefolder(foldername) '删除目录
dim fso
if foldername<>"" then
foldername=server.mappath(foldername)
set fso = server.createobject("scripting.filesystemobject")
if fso.folderexists(foldername) then
fso.deletefolder foldername
pubdeletefolder="suc"
end if
set fso = nothing
end if
end function
'//********************************************************************
' pubcopyfile(filename,filenewname) 拷贝文件，需要 fso支持 参数：filename 预拷贝文件的相对路径，filenewname 拷贝目标名
'********************************************************************//
function pubcopyfile(filename,filenewname)
dim fso,f
if filename<>"" and filenewname<>"" then
filename=server.mappath(filename)
filenewname=server.mappath(filenewname)
set fso = server.createobject("scripting.filesystemobject")
set f = fso.getfile(filename)
f.copy filenewname,true
set fso = nothing
set f = nothing
pubcopyfile="suc"
end if
end function
'//********************************************************************
' pubsetfolder(foldername) 新建目录，需要 fso支持 参数：foldername 目录名称
'********************************************************************//
function pubsetfolder(foldername)
dim fso
if foldername<>"" then
foldername=server.mappath(foldername)
set fso = server.createobject("scripting.filesystemobject")
if fso.folderexists(foldername)=false then
fso.createfolder foldername
end if
set fso = nothing
pubsetfolder="suc"
end if
end function
'/********************************************************************
' pubeditxml(xmlname,rootsite,rootsitesn,texts) 修改某xml一条数据，参数：xmlname 文件名称，rootsite 指定选取的父节点，rootsitesn 要依次更新的子节点号(整数)列表（用“|”分割），texts 赋值内容列表（以 “/$/”分割）
'********************************************************************/
sub pubeditxml(xmlname,rootsite,rootsitesn,texts)
dim fso
if xmlname<>"" then
xmlname=server.mappath(xmlname) '获取xml文件的路径这里根据虚拟目录不同而不同
set fso = server.createobject("scripting.filesystemobject")
if fso.fileexists(xmlname) then '如果文件存在，则继续 ...
dim strsourcefile,objxml,objrootsite,texti,textss,rootsitesns,rootsitesni
strsourcefile = xmlname
set objxml =server.createobject("microsoft.xmldom") '创建一个xml对像
objxml.load(strsourcefile) '把xml文件读入内存
set objrootsite = objxml.documentelement.selectsinglenode(rootsite)
textss=split(texts&"/$/","/$/")
texti=0
rootsitesns=split(rootsitesn&"|","|")
for rootsitesni=0 to ubound(rootsitesns)-1
objrootsite.childnodes.item(rootsitesns(rootsitesni)).text=textss(texti)
texti=texti+1
next
objxml.save(strsourcefile)
set objxml =nothing
'' 释放 fso
set fso = nothing
end if
end if
end sub
'/********************************************************************
' pubnewxml(xmlname,rootsite,rootsitesn,texts,indexsite) 新增 xml一条数据，参数：xmlname 文件名称，rootsite 指定选取的父节点，indexsite 新增内容主节点，rootsitesn 要依次新增的子节点名列表（用“|”分割），texts 赋值内容列表（以 “/$/”分割）
'********************************************************************/
sub pubnewxml(xmlname,rootsite,rootsitesn,texts,indexsite)
dim fso
dim brstr:brstr=chr(13)&chr(10)&chr(9) '规范 xml 样式
if xmlname<>"" then
xmlname=server.mappath(xmlname) '获取xml文件的路径这里根据虚拟目录不同而不同
set fso = server.createobject("scripting.filesystemobject")
if fso.fileexists(xmlname) then '如果文件存在，则继续 ...
dim strsourcefile,objxml,objrootsite,texti,textss,rootsitesns,rootsitesni,xmlnode
strsourcefile = xmlname
set objxml =server.createobject("microsoft.xmldom") '创建一个xml对像
objxml.load(strsourcefile) '把xml文件读入内存
set objrootsite = objxml.documentelement.selectsinglenode(rootsite)
'根据得到的数据循环个节点名、值建立xml片段
xmlnode=brstr&"<"&indexsite&">"
textss=split(texts&"/$/","/$/")
texti=0
rootsitesns=split(rootsitesn&"|","|")
for rootsitesni=0 to ubound(rootsitesns)-1
xmlnode=xmlnode&brstr&"<"&rootsitesns(rootsitesni)&">"&textss(texti)&"</"&rootsitesns(rootsitesni)&">"
texti=texti+1
next
xmlnode=xmlnode&brstr&"</"&indexsite&">"&brstr
dim objxml2,rootnewnode
set objxml2=server.createobject("microsoft.xmldom") '建立一个新xml对像
objxml2.loadxml(xmlnode) '把xml版片段读入内存中
set rootnewnode=objxml2.documentelement '获得objxml2的根节点
objrootsite.appendchild(rootnewnode) '把xml片段插入
objxml.save(strsourcefile)
set objxml =nothing
'' 释放 fso
set fso = nothing
end if
end if
end sub
'//********************************************************************
' pubcsize(tsize) kb、mb、gb 单位转换函数
'********************************************************************//
function pubcsize(tsize)
if tsize>=1073741824 then
pubcsize=round(int((tsize/1073741824)*1000)/1000,2) & " gb"
elseif tsize>=1048576 then
pubcsize=round(int((tsize/1048576)*1000)/1000,2) & " mb"
elseif tsize>=1024 then
pubcsize=round(int((tsize/1024)*1000)/1000,2) & " kb"
else
pubcsize=round(tsize,2) & "b"
end if
end function
'//********************************************************************
' pubifzhengshu(shu) 判断是否为正整数 ， 参数：shu 要判断的数字
'********************************************************************//
function pubifzhengshu(shu)
pubifzhengshu="yes"
dim shus,shui
shus=split(shu,"")
for shui=0 to ubound(shus)
if isnumeric(shus(shui))=false then
pubifzhengshu="no"
exit function
end if
next
end function
'/********************************************************************
' pubpagegs() 格式化分页， rssum 总数，nummer 每页数目，page 当前页码
'********************************************************************/
sub pubpagegs()
if rssum mod nummer > 0 then
thepages=rssum\nummer+1
else
thepages=rssum\nummer
end if
page=trim(request("page"))
if not(isnumeric(page)) then page=1
if int(page)>int(thepages) or int(page)<1 then
viewpage=1
else
viewpage=int(page)
end if
end sub
'//********************************************************************
' pubpage1(maxpage,thepages,viewpage,pageurl,pp,font_color) 通用分页函数 (1)
' maxpage,thepages,viewpage,pageurl 链接地址前缀,pp,font_color 显示字体色
'********************************************************************//
function pubpage1(maxpage,thepages,viewpage,pageurl,pp,font_color)
dim pn,pi,page_num,ppp,pl,pr:pi=1
ppp=pp\2
if pp mod 2 = 0 then ppp=ppp-1
pl=viewpage-ppp
pr=pl+pp-1
if pl<1 then
pr=pr-pl+1:pl=1
if pr>thepages then pr=thepages
end if
if pr>int(thepages) then
pl=pl+thepages-pr:pr=thepages
if pl<1 then pl=1
end if
if pl>1 then
pubpage1=pubpage1&" <a href='"& pageurl &"' title='第一页'>[|<]</a> " & _
" <a href='"& pageurl &"page="&pl-1&"' title='上一页'>[<]</a> "
end if
for pi=pl to pr
if cint(viewpage)=cint(pi) then
pubpage1=pubpage1&" <font color=" & font_color & ">[" & pi & "]</font> "
else
pubpage1=pubpage1&" <a href='"& pageurl &"page="& pi &"' title='第 " & pi & " 页'>[" & pi & "]</a> "
end if
next
if pr<thepages then
pubpage1=pubpage1&" <a href='"& pageurl &"page="&pi&"' title='后一页'>[>]</a> " & _
" <a href='"& pageurl &"page="& thepages &"' title='最后一页'>[>|]</a> "
end if
end function
'//********************************************************************
' pubpage2(viewpage,thepages,pageurl) 通用分页函数 (2)
' maxpage,thepages,viewpage,pageurl 链接地址前缀
'********************************************************************//
function pubpage2(viewpage,thepages,pageurl)
dim re_color,pf0,pf1,pf2,pf3,pf4,pf5
re_color="#c0c0c0"
pf0="已是第一页"
pf1="第一页"
pf2="上一页"
pf3="下一页"
pf4="最后一页"
pf5="已是最后一页"
pubpage2=vbcrlf & "<table border=0 cellspacing=0 cellpadding=0><tr><form action='"&pageurl&"' method=post><td>"
if cint(viewpage)=1 then
pubpage2=pubpage2 & vbcrlf & "<font color="&re_color&">"&pf0&"</font> "
else
pubpage2=pubpage2 & vbcrlf & "<a href='"&pageurl&"page=1' alt='"&pf1&"'>"&pf1&"</a>┋<a href='"&pageurl&"page="&cint(viewpage)-1&"' alt='"&pf2&"'>"&pf2&"</a> "
end if
if cint(viewpage)=cint(thepages) then
pubpage2=pubpage2 & vbcrlf & "<font color="&re_color&" alt='"&pf5&"'>"&pf5&"</font>"
else
pubpage2=pubpage2 & vbcrlf & "<a href='"&pageurl&"page="&cint(viewpage)+1&"' alt='"&pf3&"'>"&pf3&"</a>┋<a href='"&pageurl&"page="&cint(thepages)&"' alt='"&pf4&"'>"&pf4&"</a>"
end if
if cint(thepages)<>1 then
pubpage2=pubpage2 & vbcrlf & " <input type=text name=page value='"&viewpage&"' size=2> <input type=submit value='go'>"
end if
pubpage2=pubpage2 & vbcrlf & "</td></form></tr></table>"
end function
'//********************************************************************************
' pubobject_install(strclassstring) 组件判断函数 值为 true 时 说明服务器支持该组件
' 参数：strclassstring 组件标示
'**********************************************************************************//
function pubobject_install(strclassstring)
on error resume next
pubobject_install=false
dim xtestobj
err=0
set xtestobj=server.createobject(strclassstring)
if err=0 then pubobject_install=true
set xtestobj=nothing
err=0
end function
%>