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

复制代码 代码如下:<% 

'///******************************************************************

'  常用公共函数库 文件名：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

%>

时间： 2024-09-21 03:28:43

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

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

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

广告系统总结之权限管理设计与结构设计

免费广告系统多种多样,他们背后的共同点有哪些?哪些系统设计合理? 在总结了广告系统设计中<互联网精准广告定向技术>之后,作者又继续深入研究了广告系统设计中的权限管理设计以及结构设计,并从广告端与网站端两方面,进行了详细的阐述. 广告系统的权限管理设计 广告系统设计中,除了广告定向技术的运用以及广告投放流程的设计外,最复杂的就是权限管理的设计.不同于其他行业,广告公司或者媒体公司日常业务比较复杂,从职能来讲,包括销售.客户服务.客户执行.创意设计.策略策划.媒介计划.媒介执行.合同管理.财务审核

推荐九款开源免费的网店系统

中介交易 SEO诊断 淘宝客 云主机 技术大厅 你是否苦于没有技术而无法实现自己的网店梦?你是否为现在的网店功能单一而烦恼不已?你是否还在自己开发网店程序而深陷其中? 其实,这些疑问都不是那么难解决掉.看过下面这篇文章后,你会发现网店搭建会这么的轻松有趣.如果你懂网页设计,会听说CMS这个名词吧!CMS,即网站内容管理系统,它是一种先进的建站形式.即使你不精通编程,不精通设计,也同样可以设计出自己精美的作品来. 建网店,同样也可以通过这种方式来实现,你要根据自己的实际需求选择相应的建店系统.下面

盛大自建广告系统，上线时间未定

据盛大内部人士透露,盛大将推出一个自有的http://www.aliyun.com/zixun/aggregation/11938.html">广告系统:AA(Application Advertisement)广告平台,这将是盛大在整合旗下广告资源的又一尝试. 据透露,AA系统已在盛大文学业务中进行先期试点.原创者们除了可以通过阅读收费这一单一的收入来源获利之外还可以通过广告分成等方式获利. 陈天桥有意染指广告业由来已久.盛大旗下网游(盛大游戏).文学(盛大文学).视频及影视剧(酷6等)

V5SHOP网店系统：百年光棍节回馈1000万元大礼

今日的上海威博已成为国内市场占有率最高.用户体验最好的第三方电子商务服务商.威博低调了10年的"陈年老酿"依赖的不是广告,而是实力,是服务,是客户的口口相传! 作为国内最专业的电商软件与运营效果服务商-上海威博网络技术有限公司受邀参与,并被指定为"中国中小企业电子商务应用普及工程" 中国唯一承办单位. 客户案例: 客户感言: 经过2个月的合作,从前期的磨合到最近的正式上线,我们对V5shop传说中的超强性能.超快速度.高性价比以及顶尖设计有了更深刻的认识,更为当初在

V5SHOP网店系统浅析：网络口碑营销的崛起

什么是网络口碑营销 网络口碑营销,又为Internet Word of Mouth Marketing,简称为IWOM.网络口碑营销是口碑营销与网络营销的有机结合.网络口碑营销(IWOM),是口碑营销与网络营销的有机结合.口碑营销实际上早已有之,地方特产.老字号厂家商铺及企业的品牌战略等,其中都包含有口碑营销的因素.网络营销则是互联网兴起以后才有的一种网上商务活动,它逐步由门户广告营销.搜索广告营销发展到网络口碑营销. 企业需要创新,企业营销更应当创新.自改革开放以来,中国企业营销引进了西方的企

大淘宝为C2C平台、B2C网店系统商提供机遇

当年的小淘宝如今正在变的越来越大,"大淘宝"战略让淘宝越来越向B2C+聚拢:淘宝商城.电器商城.与湖南卫视合作.与联想移动合作.与ShopEx和万网合作-- 大淘宝战略的实践,让马云心目中的电子商务生态圈日益型构,在市场份额上,淘宝已经占到了国内B2C+C2C市场的80%市场份额. 2010年,是国内B2C企业集体觉醒和发力的一年,也是传统大品牌厂商纷纷触网,开始尝试B2C运营的一年. 随着众多传统大品牌企业纷纷入驻淘宝商城,而那些长期在淘宝上生存成长的草根网商群体则日益遭遇和感受到传

网店系统给企业带来的效益和如何带来效益

简单点来讲网店系统可以给企业带来:社会效应,经济效应.同时能开拓新的营销门路. 网店系统电子商务服务业明显促进了物流业.金融信贷业. IT 行业等商业服务业的发展.电子商务正成为中国现代服务业发展的一大热点. 全球最大的信息技术分析公司 IDC 日前发布了一份报告,演讲显示:53.8% 中小企业在电子商务方面每投入1元钱,就会带来163元的回报.与激进线下销售相比,电子商务约可以降低 47% 渠道本钱.该报告作者.IDC 高级分析师黄涌涛在做长久的深入研究后作出如上发现. V5SHOP网店系统建

V5shop网店系统分享：电子商务的七大关键词

十年磨一剑,电子商务行业从10年前"哥做的不是电子商务,而是寂寞",发展到今天"地球人都知道"的行业.特别是2010年,中国电子商务行业从发展速度.规模.模式.技术.资本.平台等多方面,都呈现出行业由量变到质变的发展飞跃,业界也由此将2010年称为电子商务"发展元年". 2010年,中国电子商务到底给我们留下了什么?2011年,电子商务又将走向何方?在此V5SHOP网店系统官方网站(www.v5shop.com.cn)与各位一起总结分享. 全面竞