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

ASP编程

2016-12-03

复制代码代码如下:

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

广告系统 replace replace函数

安科网

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

ASP编程

ASP编程

相关推荐

魅族16s 使用ADB禁用系统APP+关闭系统应用广告详细教程

基于SpringCloud 微服务架构下广告系统设计与实现完整教程

引入信息化系统解决广告企业管理痛点

[Spring cloud 一步步实现广告系统] 8. 检索系统配置&依赖

[Spring cloud 一步步实现广告系统] 5. 投放系统配置+启动+实体类

Win10系统怎么关闭内置的广告/提示和应用推荐?

Win7系统360浏览器怎样拦截广告 Win7 360浏览器拦截广告的方法

Win10系统怎么拦截优酷广告？Win10拦截优酷广告的方法

TiDB 在 Mobikok 广告系统中的应用和实践

一种移动APP统计平台的架构方案（适用于千万级用户的应用）

百度联盟系统使广告位自动适应广告物料的尺寸

百度切换凤巢系统营收影响10%的原因

腾讯提出并行贝叶斯在线深度学习框架PBODL：预测广告系统的点击率

Chrome OS真正目的让用户看更多广告?

大规模机器学习系统中的No Free Lunch

广告和推荐系统部署机器学习模型的两种架构

dedecms系统的广告设置代码基础版本

c# .net 生成图片验证码的代码

用户接连收到赌博色情网站信息垃圾广告“攻陷”苹果系统

ASP编程

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

相关推荐

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