asp广告系统_用到的几个函数
来源：
中文源码网 浏览：159 次 日期：2024-05-08 12:25:15
【下载文档: asp广告系统_用到的几个函数.txt 】
忠网广告 系统 用到的几个函数
复制代码 代码如下:<% '///****************************************************************** ' 常用公共函数库 文件名：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
",">") 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 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&" [|<] " & _ " [<] " end if for pi=pl to pr if cint(viewpage)=cint(pi) then PubPage1=PubPage1&" [" & pi & "] " else PubPage1=PubPage1&" [" & pi & "] " end if next if pr[>] " & _ " [>|] " 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 & "" 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 %>
