충 망 광고 시스템 에 사용 되 는 몇 가지 함수

'///****************************************************************** 
'     :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,"<","&lt;")
  NewTest=replace(NewTest,">","&gt;")
  NewTest=replace(NewTest,chr(39),"&#39;")        '
  NewTest=replace(NewTest,chr(34),"&quot;")        '
  NewTest=replace(NewTest,chr(32),"&nbsp;")        '
  NewTest=replace(NewTest,chr(9),"&nbsp; &nbsp;")'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
ummer+1
    else
      thepages=rssum
ummer
    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>&nbsp;"
  else
    PubPage2=PubPage2 & VbCrLf & "<a href='"&pageurl&"page=1' alt='"&pf1&"'>"&pf1&"</a>┋<a href='"&pageurl&"page="&cint(viewpage)-1&"' alt='"&pf2&"'>"&pf2&"</a>&nbsp;"
  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 & "&nbsp;<input type=text name=page value='"&viewpage&"' size=2>&nbsp;<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

%>

좋은 웹페이지 즐겨찾기