ASP packaged into Xml (corrected)

ASP packaged into Xml

Pack. asp

<%
Dim ZipPathDir, ZipPathFile
Dim startime, endtime
Dim FilePath, DirPath
'Change the path of the folder to be packaged here
ZipPathDir = "I:/backup file/MySite/pzwx.cn/html/html"
'This is the XML file name to be packaged
ZipPathFile = "Player. xml"
If right (ZipPathDir, 1) <> "/" then ZipPathDir = ZipPathDir &"/"
'Start Packaging
Call CreateXml (ZipPathFile)
'Traverse all files and folders in the directory
Sub LoadData (DirPath)
Dim XmlDoc
Dim fso 'fso object
Dim objFolder 'Folder object
Dim objSubFolders
Dim objSubFolder 'subfolders
Dim objFiles
Dim objFile 'file object
Dim objStream
Dim pathname, TextStream, pp, Xfolder, Xfpath, Xfile, Xpath, Xstream
Dim PathNameStr
Response. Write ("============" & DirPath & "===========< br> ")
Set fso = server. CreateObject ("scripting. filesystemobject ")
Set objFolder = fso. GetFolder (DirPath) 'create a folder object

Response. Write DirPath
Response. flush

Set XmlDoc = Server. CreateObject ("Microsoft. XMLDOM ")
XmlDoc. load Server. MapPath (ZipPathFile)
XmlDoc. async = false

'Write each folder path
Set Xfolder = XmlDoc. SelectSingleNode ("// data"). AppendChild (XmlDoc. CreateElement ("folder "))
Set Xfpath = Xfolder. AppendChild (XmlDoc. CreateElement ("path "))
Xfpath. text = replace (DirPath, ZipPathDir ,"")
Set objFiles = objFolder. Files
For each objFile in objFiles
If lcase (DirPath & objFile. name) <> lcase (Request. ServerVariables ("PATH_TRANSLATED") then
Response. Write "--- <br/>"
PathNameStr = DirPath & "& objFile. name
Response. Write PathNameStr &""
Response. flush
'================================================ ==========
'File writing path and file content
Set Xfile = XmlDoc. SelectSingleNode ("// data"). AppendChild (XmlDoc. CreateElement ("file "))
Set Xpath = Xfile. AppendChild (XmlDoc. CreateElement ("path "))
Xpath. text = replace (PathNameStr, ZipPathDir ,"")
'Create a file stream to read the file content and write it into the XML file
Set objStream = Server. CreateObject ("ADODB. Stream ")
ObjStream. Type = 1
ObjStream. Open ()
ObjStream. LoadFromFile (PathNameStr)
ObjStream. position = 0

Set Xstream = Xfile. AppendChild (XmlDoc. CreateElement ("stream "))
Xstream. SetAttribute "xmlns: dt", "urn: schemas-microsoft-com: datatypes"
'File content is stored in binary format
Xstream. dataType = "bin. base64"
Xstream. nodeTypedValue = objStream. Read ()

Set objStream = nothing
Set Xpath = nothing
Set Xstream = nothing
Set Xfile = nothing
'================================================ ==========
End if
Next
Response. Write "<p>"
Xmldoc. Save (server. mappath (zippathfile ))
Set xfpath = nothing
Set xfolder = nothing
Set xmldoc = nothing

'Created subfolder object
Set objsubfolders = objfolder. subfolders
'Call recursive traversal of subfolders
For each objsubfolder in objsubfolders
Pathname = dirpath & objsubfolder. Name &"/"
Loaddata (pathname)
Next
Set objfolder = nothing
Set objsubfolders = nothing
Set FSO = nothing

End sub

'Create an empty XML file to prepare for file writing.
Sub CreateXml (FilePath)
'Execution start time of the program
Startime = timer ()
Dim XmlDoc, Root
Set XmlDoc = Server. CreateObject ("Microsoft. XMLDOM ")
XmlDoc. async = False
Set Root = XmlDoc. createProcessingInstruction ("xml", "version = '1. 0' encoding = 'utf-8 '")
XmlDoc. appendChild (Root)
XmlDoc. appendChild (XmlDoc. CreateElement ("data "))
XmlDoc. Save (Server. MapPath (FilePath ))
Set Root = Nothing
Set XmlDoc = Nothing
Call LoadData (ZipPathDir)
'Program End Time
Endtime = timer ()
Response. Write ("Page execution time:" & FormatNumber (endtime-startime), 3) & "seconds ")
End sub

%>

Install. asp

<%
Dim Path
Path = Left (Request. ServerVariables ("PATH_INFO"), limit Rev (Request. ServerVariables ("PATH_INFO "),"/"))
Dim strInstallPath, varInstallPath
StrInstallPath = Path
VarInstallPath = strInstallPath

Response. Write "<ul>"
Response. Write "<li> installing system... </li>"
Response. Flush ()

Call Release ("Player. xml", strInstallPath)
If Right (varInstallPath, 1) <> "/" Then varInstallPath = varInstallPath &"/"
Response. Write "<li> generating Html page... </li>"
Response. Flush ()

Response. Write "<SCRIPT type =" "text/JavaScript" "src =" & varinstallpath & "Save. asp" "> </SCRIPT>"
Response. Write "<li> Installation successful. :) </LI>"
Response. Flush ()
Response. Write "</ul>"

'Release ***** www.pzwx.cn ******
Sub release (strfilexml, strlocalpath)
Dim objxmlfile
Dim objnodelist
Dim objfso
Dim objstream
Dim I, j
Strlocalpath = server. mappath (strlocalpath)
If right (strlocalpath, 1) <> "/" then strlocalpath = strlocalpath &"/"
Set objxmlfile = Createobject ("Microsoft. xmldom ")
Objxmlfile. Load (server. mappath (strfilexml ))
If objxmlfile. readystate = 4 then
If objXmlFile. parseError. errorCode = 0 Then
Set objNodeList = objXmlFile.doc umentElement. selectNodes ("// folder/path ")
Set objFSO = CreateObject ("Scripting. FileSystemObject ")
J = objNodeList. Length-1
For I = 0 To J
If Not objFSO. FolderExists (strLocalPath & objNodeList (I). Text) Then
ObjFSO. CreateFolder (strLocalPath & objNodeList (I). Text)
Response. Write "<li> create a directory:" & strLocalPath & objNodeList (I). Text & "</li>"
Response. Flush ()
End If
Next
Set objFSO = nothing
Set objNodeList = Nothing
Set objNodeList = objXmlFile.doc umentElement. selectNodes ("// file/path ")
J = objNodeList. Length-1
For I = 0 To J
Set objStream = CreateObject ("ADODB. Stream ")
With objStream
. Type = 1
. Open
. Write objNodeList (I). nextSibling. nodeTypedvalue
. SaveToFile strLocalPath & objNodeList (I). Text, 2
. Close ()
End
Set objStream = Nothing
Response. Write "<li> create a file:" & strLocalPath & objNodeList (I). Text & "</li>"
Response. Flush ()
Next
Set objNodeList = nothing
End If
End If
Set objXmlFile = Nothing
End Sub
%>

It has been tested and can be used normally. Now you do not need to upload files one by one. You can upload files in a package!