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

代码如下:

<% 
'///******************************************************************
'  常用公共函数库 文件名: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

%>

(0)

相关推荐

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

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

  • 网管必读,网管系统建设的思维转变

    过去几年中,企业IT部门主管肩负的责任发生了显著的变化:一方面公司网络的规模和复杂性成倍增长,越来越多的新业务被移植到网络环境中来运行;另一方面公司内各业务部门以及外部客户也越来越依赖于网络来完成日常的业务处理和通信,任何网络或服务中断甚至性能下降都会对企业业务造成严重影响.同时为适应市场经济的严酷竞争,控制IT投资和运营成本也成为了IT部门主管需要考虑的课题. 为确保企业业务的正常运行,国内几乎所有大中型企业的领导都已经认识到建设网络管理系统的重要性,并且多数企业已经根据各自当前的管理需求投资

  • Linux系统中C语言编程创建函数fork()执行解析

    最近在看进程间的通信,看到了fork()函数,虽然以前用过,这次经过思考加深了理解.现总结如下: 1.函数本身 (1)头文件 #include<unistd.h> #include<sys/types.h> (2)函数原型 pid_t fork( void); (pid_t 是一个宏定义,其实质是int 被定义在#include<sys/types.h>中) 返回值: 若成功调用一次则返回两个值,子进程返回0,父进程返回子进程ID:否则,出错返回-1 (3)函数说明 一

  • linux系统上支持php的 iconv()函数的方法

    1.下载libiconv函数库http://ftp.gnu.org/pub/gnu/libiconv/libiconv-1.9.2.tar.gz: 2.解压缩tar -zxvf libiconv-1.9.2.tar.gz; 3.安装libiconv 复制代码 代码如下: #configure --prefix=/usr/local/iconv #make #make install 4.重新编译php 增加编译参数--with-iconv=/usr/local/iconv windows下 最近

  • Coldfusion MX广告轮换系统制作教程

    wait 蓝色理想CF里面没有提供象ASP里那样的广告组件,但是这并不能说明就不能做出功能强大的广告系统,这里我放上一个简单的广告轮换系统,也是我CCF论坛里面用的.功能,有显示次数和点击次数.在这基础上扩展比较容易,可以分类显示,下面的代码只是显示 大广告条.只是想抛砖引玉,大家举一反三,就能做出功能更加强大的广告系统出来. <!--- 判断是否有地址传递 ---> <CFIF NOT IsDefined("URL.ADID")> <!--- 默认为显示

  • 过滤淘宝网弹出窗口

    你是不是已经对淘宝网忍无可忍了-- 你只要在MyIE或者Maxthon里面的"弹出窗口过滤"和"网页内容过滤"里面同时添加 *unionsky* 的过滤条目就可以完全阻止恶心的淘宝广告了,因为他的广告总代理就是 www.unionsky.cn 大伙如果还感觉不爽就可以去嘿咻掉他! IE用户的免疫方法: 1)用IE的可以搜索系统盘的Hosts文件,用记事本打开后在适当位置添加以下语句 127.0.0.1 www.unionsky.cn#掏宝网广告代理 127.0.0.

  • 一个文件搞定系统所有问题 推荐

    在使用电脑的过程中我们会遇到很多的问题,烦人的广告窗口不停的弹出:不停的在多套网络配置中切换:时常忘掉备份网络中的关键数据:加密的文件夹由于误操作无法打开.你想过没有以上这些问题都可以通过一个小文件解决?你甚至可以借助它解决几乎所有在使用电脑时遇到的问题.它就是功能强大的bat文件. 一.查漏补缺--给系统功能添把火 我们的操作系统虽然功能强大,但是在某方面的应用上依旧存在欠缺,如:没有定时关机软件.而用bat文件可以解决很多这类问题. 1.关机与重启 我们先做个让电脑在每天指定时间关机的bat

  • 用js的document.write输出的广告无阻塞加载的方法

    一.广告代码分析 很多第三方的广告系统都是使用document.write来加载广告,如下面的一个javascript的广告链接. 复制代码 代码如下: <script type="text/javascript" src="http://gg.5173.com/adpolestar/5173/;ap=2EBE5681_1BA3_4663_FA3F_E73D2B83FBDC;ct=js;pu=5173;/?"></script> 这个java

  • ASP个人网站与动网整合非官方方法

    虽然动网已提供有详细的"动网论坛系统Api接口开发人员指南",但像我这样的菜鸟一时半会可是参详不透的,汗.不甘心,在对其登录.验证等函数进行一番研究再加以测试后最终竟也小有所成,菜鸟也有菜鸟的办法: 本次测试的论坛版本为Version 7.1.0 Sp1,未对其他版本做进行测试 一.网站文件结构 wwwroot    ┝ index.asp    ┝ CheckUserLogin.asp    ┕ bbs/ 二.整合原理 对于同步更新实现不困难,整合主要问题就是难在同步登录,所以我们的

  • ASP类型网站结合动网论坛会员的方法第1/3页

    个人网站如有会员注册模块+动网论坛的话,那网站要与动网论坛系统整合,实现不同Web系统之间的用户信息同步更新.登录等操作就不是件容易的事了,虽然动网已提供有详细的"动网论坛系统Api接口开发人员指南",但像我这样的菜鸟一时半会可是参详不透的,汗.不甘心,在对其登录.验证等函数进行一番研究再加以测试后最终竟也小有所成,菜鸟也有菜鸟的办法,哈哈. 一.网站文件结构 wwwroot   ┝ index.asp   ┝ CheckUserLogin.asp   ┕ bbs/ 二.整合原理 对于

随机推荐