您现在的位置是：网站首页> 编程资料编程资料

忠网广告 系统 用到的几个函数_应用技巧_

2023-05-25 259人已围观

简介 忠网广告 系统 用到的几个函数_应用技巧_

复制代码 代码如下:
<% 
'///******************************************************************
'  常用公共函数库 文件名：PubFunction.asp 
'******************************************************************/// 

  Const Go_back="[返回上页]"
  Const Closer="『关闭窗口』"

  
'//********************************************************************
'  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  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),"
")        '回车
  NewTest=replace(NewTest,chr(13),"
")
  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)&""
          texti=texti+1
          Next

       XMLnode=XMLnode&brstr&""&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
-六神源码网