Functions used by the zhongnet advertising system

Copy codeThe Code is as follows: <%
'///************************************ ******************************
'Common public function library file name: PubFunction. asp
'*************************************** ***************************///

Const Go_back = "<a href = 'javascript: history. back (1) '> [back to the previous page] </a>"
Const Closer = "<a href = 'javascript: self. close () '>" close Window "</a>"

'//************************************* *******************************
'Pubfgdy (Test, Tag, Bh) calls the specified value function of the specified String Based on the separator and label. Parameter: String separated by Test, Tag separator, and Bh label
'*************************************** *****************************//

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) code standard function, parameter: original content of OldTest, new content of 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) Shields HTML code functions. Parameter: original content of OldTest and new content of 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), "'")' single quotes
NewTest = replace (NewTest, chr (34), "") 'Double quotation marks
NewTest = replace (NewTest, chr (32), "") 'space
NewTest = replace (NewTest, chr (9), "") 'table
NewTest = replace (NewTest, chr (10), "<br>") 'press ENTER
NewTest = replace (NewTest, chr (13), "<br> ")
PubCodehtml = NewTest
End function

'//************************************* *******************************
'Pubctime () system combination time is a normal string containing year, month, day, hour, minute, and second, for example: 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, "Morning ","")
GcChars = replace (GcChars, "Afternoon ","")
GcChars = int (GcChars) + int (10-1 + 1) * Rnd + 1)
PubCtime = GcChars
End function

'//************************************* *******************************
'Pubfolderifcz (Foldername) determines whether a directory exists. The fso parameter is required: 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) determines whether the file exists. The fso parameter is required: 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) to delete a file. The fso parameter is required: The relative path of the file pre-deleted by Filename.
'*************************************** *****************************//

Function PubDeleteFile (Filename) 'delete an object
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) to delete a directory. The fso parameter is required: relative path of the pre-deleted directory of Foldername.
'*************************************** *****************************//

Function PubDeleteFolder (Foldername) 'deletes a directory
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) is used to copy a file. The fso parameter is required: The relative path of the file to be precopied by Filename, and the target name to be copied by 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) to create a directory, the fso parameter is required: Foldername directory name
'*************************************** *****************************//

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) modifies an xml piece of data. Parameter: xmlName file name, Rootsite specifies the selected parent node, and Rootsitesn indicates the child node number (integer) to be updated in sequence) list (separated by "|"), texts value assignment content list (separated by "/$)
'*************************************** *****************************/

Sub PubEditXml (xmlName, Rootsite, Rootsitesn, texts)
Dim fso
If xmlName <> "" then

XmlName = Server. MapPath (xmlName) 'gets the path of the XML file. The path varies depending on the virtual directory.
Set fso = server. CreateObject ("Scripting. FileSystemObject ")
If fso. FileExists (xmlName) then' if the file exists, continue...

Dim strSourceFile, objXML, objRootsite, texti, textss, Rootsitesns, Rootsitesni
StrSourceFile = xmlName

Set objXML = Server. CreateObject ("Microsoft. XMLDOM") 'creates an XML Object

ObjXML. load (strSourceFile) 'reads XML files into memory

Set objRootsite = objXML.doc umentElement. 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

''Release fso
Set fso = nothing
End if
End if

End sub

'/************************************** ******************************
'Pubnewxml (xmlName, Rootsite, Rootsitesn, texts, Indexsite) adds a piece of xml data. Parameter: xmlName file name, Rootsite specifies the selected parent node, and Indexsite adds the content master node, the list of child node names (separated by "|") to be added in sequence for Rootsitesn, and the list of texts assignment content (separated by "/$)
'*************************************** *****************************/

Sub PubNewXml (xmlName, Rootsite, Rootsitesn, texts, Indexsite)
Dim fso
Dim brstr: brstr = chr (13) & chr (10) & chr (9) 'standardizes XML styles
If xmlName <> "" then

XmlName = Server. MapPath (xmlName) 'gets the path of the XML file. The path varies depending on the virtual directory.
Set fso = server. CreateObject ("Scripting. FileSystemObject ")
If fso. FileExists (xmlName) then' if the file exists, continue...

Dim strSourceFile, objXML, objRootsite, texti, textss, Rootsitesns, Rootsitesni, XMLnode
StrSourceFile = xmlName

Set objXML = Server. CreateObject ("Microsoft. XMLDOM") 'creates an XML Object

ObjXML. load (strSourceFile) 'reads XML files into memory

Set objRootsite = objXML.doc umentElement. selectSingleNode (rootsite)

'Create an XML Segment Based on the node names and values of the obtained data loop.
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") 'creates a new XML Object

ObjXML2.loadXML (XMLnode) 'reads XML fragments into the memory

Set rootnewnode1_objxml2.doc umentElement 'to get the root node of objXML2

ObjRootsite. appendChild (rootNewNode) 'inserts XML fragments

ObjXML. save (strSourceFile)

Set objXML = nothing

''Release fso
Set fso = nothing
End if
End if

End sub

'//************************************* *******************************
'Pubcsize (tSize) KB, MB, and GB conversion functions
'*************************************** *****************************//

Function PubcSize (tSize)

If tSize> = 1073741824 then
PubcSize = Round (int (tSize/1073741824) * 1000)/) & "GB"
Elseif tSize> = 1048576 then
PubcSize = Round (int (tSize/1048576) * 1000)/) & "MB"
Elseif tSize> = 1024 then
PubcSize = Round (int (tSize/1024) * 1000)/) & "KB"
Else
PubcSize = Round (tSize, 2) & "B"
End if

End function

'//************************************* *******************************
'Pubifzhengshu (shu) determines whether it is a positive integer. Parameter: number to be judged by 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 () formatted paging, total number of rssum, number of nummer pages per page, current page number
'*************************************** *****************************/

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) Generic paging function (1)
'Maxpage, thepages, viewpage, pageurl URL prefix, pp, font_color display 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 = 'page 1'> [| <] </a> "&_
"<A href = '" & pageurl & "page =" & pl-1 & "'title = 'preput'> [<] </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 =' Next page '> [>] </a> "& _
"<A href = '" & pageurl & "page =" & thepages & "'title = 'last page'> [>|] </a>"
End if
End function

'//************************************* *******************************
'Pubpage2 (viewpage, thepages, pageurl) Generic paging function (2)
'Maxpage, thepages, viewpage, pageurl URL prefix
'*************************************** *****************************//

Function PubPage2 (viewpage, thepages, pageurl)
Dim re_color, pf0, pf1, pf2, pf3, pf4, pf5
Re_color = "# c0c0c0"
Pf0 = "already the first page"
Pf1 = "Page 1"
Pf2 = "Previous Page"
Pf3 = "next page"
Pf4 = "last page"
Pf5 = "the last page"
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> comment <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> forward <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

'//************************************* **************************************** ***
When the 'pubobject_install (strclassstring) component determines that the function value is true, the server supports this component.
'Parameter: strclassstring component identifier
'*************************************** **************************************** ***//

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

%>