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

复制代码 代码如下:

<% 
'///******************************************************************
'  常用公共函数库 文件名：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="π&"' 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

%>

时间： 2024-09-21 01:28:28

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

忠网广告 系统 用到的几个函数

复制代码 代码如下:<%  '///****************************************************************** '  常用公共函数库 文件名:PubFunction.asp  '******************************************************************/// Const Go_back="<a href='javascript:history.back(1)'>[

V5SHOP网店系统：提高引擎排名必要的10个技巧

&http://www.aliyun.com/zixun/aggregation/37954.html">nbsp;   如何做好自己网站关键词的排名,是每个SEO人都非常关注的问题. 今天,做为V5SHOP网店系统搭建人之一,跟大家交流下我这几年来在V5SHOP公司构建网店系统及为电子商务外包客户提供服务过程中的一点心得,跟大家分享下其中的技巧和注意事项!对提高你网站排名绝对有好处! 一:网站关键词的处理:包括关键词的位置,密度,描述,及处理方法 1,网页标题中一定要出现关键词,

动网防恶意广告比较有效的办法附asp代码_应用技巧

1.   进入后台,风格界面模板总管理,page_login,template.html(13)  <TR> <TD class=tablebody1><B>密码问题</B>:<BR>忘记密码的提示问题</TD> 在此两句上面添加如下代码  <TR> <TD class=tablebody1> <div style="color:red"><b>反论坛群发必填项:&l

问题收集帖动网论坛完整程序包下载地址(包含所有补丁)_应用技巧

问题收集帖动网论坛完整程序包下载地址(包含所有补丁) Dvbbs7.1.0_Ac.exe 动网论坛完整程序包下载地址(包含所有补丁) Dvbbs7.1.0_Ac.exe动网论坛[05.23]更新补丁下载地址 Q20060430.exe(含重要更新) 为什么我用了5.1的更新后,不能播放多媒体文件,变成乱码了?进入论坛后台--基本设置--系统设置脚本扩展过滤设置里含对"object"或"EMBED"的过滤,此过滤现在可以去掉了,因为新的机制已经对它做了过滤,将这里改为

asp智能脏话过滤系统v1.0第1/2页_应用技巧

<% '********************************************************** '*智能脏话过滤系统v1.0       *    * '*转载请保留版权信息,多谢                        *   拉   * '*调用方法:sayy=ND_say_what(sayy),sayy为内容输入 *   图   * '*程序作者:阮丁远,(网名:柏拉图的程序) 版权所有   *   的   * '*qq:657697290       

告别ADO.NET实现应用系统无缝切换的烦恼(总结篇)_实用技巧

可能只是那么想也是那么设计的,要支持多数据库,要能支持多数据库,万一要是以后数据库变了怎么办?万一要是...怎么办?这些顾虑很多时候是不必要的,反而绕了弯子.大都是做项目应用系统而非产品,即使要用不同的数据库了,基本上是吧上一个项目全COPY过来,修修改改OK了.产品可能就不一样了,那才可能要支持真正的多数据库,才可能会面对真正的数据库访问类库的多数据库的实际检验.ADO.NET2.0下增强了数据库访问的功能,也就是工厂式类库,提到工厂式数据库访问,网上可就多了,ADO.NET2.0增强的工厂式

修改系统DLL文件实现禁用的方法_应用技巧

大家一直在找修该DLL的教材  我知道很多初级的电脑新手和一些网吧非常需要这个教材,最近在网上收集整理出来和大家分享.  首先引导下系统 主要的些dll 基本上只要修改它们就可以实现很高的安全性 首先请没改过DLL的朋友请下载个 EXESCOPE6.3 - 6.4工具 (在下面下载) 1.Browselc.dll IE所需要调用的库文件DLL 结构雏形就是它了 2.Shdoclc.dll 系统窗口 及设置对话框 等等........ 比如 删除文件 重命名. 3.Shell32.dll 和上面是

ASP.NET.4.5.1+MVC5.0设置系统角色与权限（二）_实用技巧

系统角色篇 数据结构 用户管理 Controller代码 复制代码 代码如下: public class SystemUserController : Controller     {         //public void Log()         //{         //    string meg = "";         //    int user = int.Parse(CookieHelper.GetValue("SysUserID"));

系统登陆就注销的解决方法_应用技巧

★原因分析:有两种可能:  (1)由于注册表的userinit.exe被误删:  (2)由于system32下的userinit.exe被病毒删除,或者被卡巴连带病毒一起删除.  修复方法:用深山红叶等winPE.  ★详细解决方法如下:  1.如果是注册表被修改,可用下列方法:  (1)将要电脑的BIOS的first boot选项设置为光盘启动:  (2)用"深山红叶"等光盘进入winPE光盘操作系统操作系统:  (3)开始-强力系统修复ERD2003-设置当前系统目录(必须设置该步