南强小屋 Design By 杰米
复制代码 代码如下:<%
'///******************************************************************
' 常用公共函数库 文件名：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
%>
标签：
忠网广告,系统,用到的几个函数
南强小屋 Design By 杰米
广告合作：本站广告合作请联系QQ：858582 申请时备注：广告合作（否则不回）
免责声明：本站文章均来自网站采集或用户投稿，网站不提供任何软件下载或自行开发的软件！ 如有用户或公司发现本站内容信息存在侵权行为，请邮件告知！ 858582#qq.com
免责声明：本站文章均来自网站采集或用户投稿，网站不提供任何软件下载或自行开发的软件！ 如有用户或公司发现本站内容信息存在侵权行为，请邮件告知！ 858582#qq.com
南强小屋 Design By 杰米
暂无忠网广告 系统 用到的几个函数的评论...
稳了！魔兽国服回归的3条重磅消息！官宣时间再确认！
昨天有一位朋友在大神群里分享，自己亚服账号被封号之后居然弹出了国服的封号信息对话框。
这里面让他访问的是一个国服的战网网址，com.cn和后面的zh都非常明白地表明这就是国服战网。
而他在复制这个网址并且进行登录之后，确实是网易的网址，也就是我们熟悉的停服之后国服发布的暴雪游戏产品运营到期开放退款的说明。这是一件比较奇怪的事情，因为以前都没有出现这样的情况，现在突然提示跳转到国服战网的网址，是不是说明了简体中文客户端已经开始进行更新了呢？