復(fù)制代碼 代碼如下:
%
'///******************************************************************
' 常用公共函數(shù)庫(kù) 文件名:PubFunction.asp
'******************************************************************///
Const Go_back="a href='javascript:history.back(1)'>[返回上頁(yè)]/a>"
Const Closer="a href='javascript:self.close()'>『關(guān)閉窗口』/a>"
'//********************************************************************
' PubFgdy(Test,Tag,Bh) 根據(jù)分隔符和標(biāo)號(hào)調(diào)用指定字符串的指定值函數(shù),參數(shù):Test 被分隔的字符串,Tag 分隔符,Bh 標(biāo)號(hào)
'********************************************************************//
Function PubFgdy(Test,Tag,Bh)
PubFgdy=""
if Test>"" and isnumeric(Bh)=true Then
Dim Tests
Tests=split(TestTag,Tag)
if BhUbound(Tests) then
PubFgdy=Tests(Bh)
end if
else
PubFgdy=""
exit function
end if
end function
'//********************************************************************
' PubCodeGF(OldTest) 代碼規(guī)范函數(shù), 參數(shù):OldTest 原始內(nèi)容, NewTest 新內(nèi)容
'********************************************************************//
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代碼函數(shù), 參數(shù):OldTest 原始內(nèi)容, NewTest 新內(nèi)容
'********************************************************************//
function PubCodehtml(OldTest)
dim NewTest:NewTest=OldTest
if isnull(NewTest) or NewTest="" then PubCodehtml="":exit function
NewTest=replace(NewTest,"","lt;")
NewTest=replace(NewTest,">","gt;")
NewTest=replace(NewTest,chr(39),"#39;") '單引號(hào)
NewTest=replace(NewTest,chr(34),"quot;") '雙引號(hào)
NewTest=replace(NewTest,chr(32),"nbsp;") '空格
NewTest=replace(NewTest,chr(9),"nbsp; nbsp;")'table
NewTest=replace(NewTest,chr(10),"br>") '回車(chē)
NewTest=replace(NewTest,chr(13),"br>")
PubCodehtml=NewTest
end function
'//********************************************************************
' PubCtime() 組合系統(tǒng)時(shí)間為正常字符串 含 年、月、日、時(shí)、分、秒 如: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支持 參數(shù):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支持 參數(shù):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支持 參數(shù):Filename 預(yù)刪除文件的相對(duì)路徑
'********************************************************************//
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支持 參數(shù):Foldername 預(yù)刪除目錄的相對(duì)路徑
'********************************************************************//
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支持 參數(shù):Filename 預(yù)拷貝文件的相對(duì)路徑,F(xiàn)ilenewname 拷貝目標(biāo)名
'********************************************************************//
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支持 參數(shù):Foldername 目錄名稱(chēng)
'********************************************************************//
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一條數(shù)據(jù),參數(shù):xmlName 文件名稱(chēng),Rootsite 指定選取的父節(jié)點(diǎn),Rootsitesn 要依次更新的子節(jié)點(diǎn)號(hào)(整數(shù))列表(用“|”分割),texts 賦值內(nèi)容列表(以 “/$/”分割)
'********************************************************************/
Sub PubEditXml(xmlName,Rootsite,Rootsitesn,texts)
Dim fso
if xmlName>"" then
xmlName=Server.MapPath(xmlName) '獲取XML文件的路徑這里根據(jù)虛擬目錄不同而不同
Set fso = server.CreateObject("Scripting.FileSystemObject")
if fso.FileExists(xmlName) then '如果文件存在,則繼續(xù) ...
Dim strSourceFile,objXML,objRootsite,texti,textss,Rootsitesns,Rootsitesni
strSourceFile = xmlName
Set objXML =Server.CreateObject("Microsoft.XMLDOM") '創(chuàng)建一個(gè)XML對(duì)像
objXML.load(strSourceFile) '把XML文件讀入內(nèi)存
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一條數(shù)據(jù),參數(shù):xmlName 文件名稱(chēng),Rootsite 指定選取的父節(jié)點(diǎn),Indexsite 新增內(nèi)容主節(jié)點(diǎn),Rootsitesn 要依次新增的子節(jié)點(diǎn)名列表(用“|”分割),texts 賦值內(nèi)容列表(以 “/$/”分割)
'********************************************************************/
Sub PubNewXml(xmlName,Rootsite,Rootsitesn,texts,Indexsite)
Dim fso
Dim brstr:brstr=chr(13)chr(10)chr(9) '規(guī)范 XML 樣式
if xmlName>"" then
xmlName=Server.MapPath(xmlName) '獲取XML文件的路徑這里根據(jù)虛擬目錄不同而不同
Set fso = server.CreateObject("Scripting.FileSystemObject")
if fso.FileExists(xmlName) then '如果文件存在,則繼續(xù) ...
Dim strSourceFile,objXML,objRootsite,texti,textss,Rootsitesns,Rootsitesni,XMLnode
strSourceFile = xmlName
Set objXML =Server.CreateObject("Microsoft.XMLDOM") '創(chuàng)建一個(gè)XML對(duì)像
objXML.load(strSourceFile) '把XML文件讀入內(nèi)存
Set objRootsite = objXML.documentElement.selectSingleNode(rootsite)
'根據(jù)得到的數(shù)據(jù)循環(huán)個(gè)節(jié)點(diǎn)名、值建立XML片段
XMLnode=brstr""Indexsite">"
textss=split(texts"/$/","/$/")
texti=0
Rootsitesns=split(Rootsitesn"|","|")
For Rootsitesni=0 to ubound(Rootsitesns)-1
XMLnode=XMLnodebrstr""Rootsitesns(Rootsitesni)">"textss(texti)"/"Rootsitesns(Rootsitesni)">"
texti=texti+1
Next
XMLnode=XMLnodebrstr"/"Indexsite">"brstr
Dim objXML2,rootNewNode
set objXML2=Server.CreateObject("Microsoft.XMLDOM") '建立一個(gè)新XML對(duì)像
objXML2.loadXML(XMLnode) '把XML版片段讀入內(nèi)存中
set rootNewNode=objXML2.documentElement '獲得objXML2的根節(jié)點(diǎn)
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 單位轉(zhuǎn)換函數(shù)
'********************************************************************//
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) 判斷是否為正整數(shù) , 參數(shù):shu 要判斷的數(shù)字
'********************************************************************//
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() 格式化分頁(yè), rssum 總數(shù),nummer 每頁(yè)數(shù)目,page 當(dāng)前頁(yè)碼
'********************************************************************/
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) 通用分頁(yè)函數(shù) (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 pl1 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 pl1 then pl=1
end if
if pl>1 then
PubPage1=PubPage1" a href='" pageurl "' title='第一頁(yè)'>[|]/a> " _
" a href='" pageurl "page="pl-1"' title='上一頁(yè)'>[]/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 " 頁(yè)'>[" pi "]/a> "
end if
next
if prthepages then
PubPage1=PubPage1" a href='" pageurl "page="pi"' title='后一頁(yè)'>[>]/a> " _
" a href='" pageurl "page=" thepages "' title='最后一頁(yè)'>[>|]/a> "
end if
end function
'//********************************************************************
' PubPage2(viewpage,thepages,pageurl) 通用分頁(yè)函數(shù) (2)
' maxpage,thepages,viewpage,pageurl 鏈接地址前綴
'********************************************************************//
Function PubPage2(viewpage,thepages,pageurl)
dim re_color,pf0,pf1,pf2,pf3,pf4,pf5
re_color="#c0c0c0"
pf0="已是第一頁(yè)"
pf1="第一頁(yè)"
pf2="上一頁(yè)"
pf3="下一頁(yè)"
pf4="最后一頁(yè)"
pf5="已是最后一頁(yè)"
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>nbsp;"
else
PubPage2=PubPage2 VbCrLf "a href='"pageurl"page=1' alt='"pf1"'>"pf1"/a>┋a href='"pageurl"page="cint(viewpage)-1"' alt='"pf2"'>"pf2"/a>nbsp;"
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 "nbsp;input type=text name=page value='"viewpage"' size=2>nbsp;input type=submit value='GO'>"
end if
PubPage2=PubPage2 VbCrLf "/td>/form>/tr>/table>"
end Function
'//********************************************************************************
' Pubobject_install(strclassstring) 組件判斷函數(shù) 值為 true 時(shí) 說(shuō)明服務(wù)器支持該組件
' 參數(shù):strclassstring 組件標(biāo)示
'**********************************************************************************//
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
%>