忠網(wǎng)廣告 系統(tǒng) 用到的幾個函數(shù)

% 
'///******************************************************************
'  常用公共函數(shù)庫 文件名：PubFunction.asp 
'******************************************************************/// 

  Const Go_back="a href='javascript:history.back(1)'>[返回上頁]/a>"
  Const Closer="a href='javascript:self.close()'>『關(guān)閉窗口』/a>"

  
'//********************************************************************
'  PubFgdy(Test,Tag,Bh)  根據(jù)分隔符和標(biāo)號調(diào)用指定字符串的指定值函數(shù)，參數(shù)：Test 被分隔的字符串，Tag 分隔符，Bh 標(biā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;")        '單引號
  NewTest=replace(NewTest,chr(34),"quot;")        '雙引號
  NewTest=replace(NewTest,chr(32),"nbsp;")        '空格
  NewTest=replace(NewTest,chr(9),"nbsp;　nbsp;")'table
  NewTest=replace(NewTest,chr(10),"br>")        '回車
  NewTest=replace(NewTest,chr(13),"br>")
  PubCodehtml=NewTest
  end function


'//********************************************************************
'  PubCtime() 組合系統(tǒng)時間為正常字符串 含 年、月、日、時、分、秒 如：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ù)刪除文件的相對路徑
'********************************************************************//

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ù)刪除目錄的相對路徑
'********************************************************************//

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ù)拷貝文件的相對路徑，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 目錄名稱
'********************************************************************//

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 文件名稱，Rootsite 指定選取的父節(jié)點，Rootsitesn 要依次更新的子節(jié)點號(整數(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)建一個XML對像

  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 文件名稱，Rootsite 指定選取的父節(jié)點，Indexsite 新增內(nèi)容主節(jié)點，Rootsitesn 要依次新增的子節(jié)點名列表（用“|”分割），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)建一個XML對像

  objXML.load(strSourceFile)  '把XML文件讀入內(nèi)存 

  Set objRootsite = objXML.documentElement.selectSingleNode(rootsite) 

          '根據(jù)得到的數(shù)據(jù)循環(huán)個節(jié)點名、值建立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")    '建立一個新XML對像

      objXML2.loadXML(XMLnode)     '把XML版片段讀入內(nèi)存中 

      set rootNewNode=objXML2.documentElement    '獲得objXML2的根節(jié)點 

      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() 格式化分頁， rssum 總數(shù)，nummer 每頁數(shù)目，page 當(dāng)前頁碼
'********************************************************************/

  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) 通用分頁函數(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='第一頁'>[|]/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 prthepages 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) 通用分頁函數(shù) (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>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 時 說明服務(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

%>