復(fù)制代碼代碼如下:
<%@LANGUAGE="VBSCRIPT" CODEPAGE="65001"%>
<%OptionExplicit%>
<%OnErrorResumeNext%>
<% Response.Charset="UTF-8"%>
<% Server.ScriptTimeout=99999999%>
<!DOCTYPEhtmlPUBLIC"-//W3C//DTDXHTML1.0Transitional//EN""http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<htmlxmlns="http://www.w3.org/1999/xhtml">
<head>
<metahttp-equiv="Content-Type"content="text/html; charset=utf-8"/>
<title>文件打包程序</title>
</head>
<body>
<%
Dim ZipPathDir, ZipPathFile
Dim startime, endtime
'在此更改要打包文件夾的路徑
ZipPathDir ="F:/www.yongfa365.com"'
ZipPathFile ="update.xml"
If Right(ZipPathDir,1)<>"/"Then ZipPathDir = ZipPathDir&"/"
'開(kāi)始打包
CreateXml(ZipPathFile)
'遍歷目錄內(nèi)的所有文件以及文件夾
Sub LoadData(DirPath)
Dim XmlDoc
Dim fso 'fso對(duì)象
Dim objFolder '文件夾對(duì)象
Dim objSubFolders '子文件夾集合
Dim objSubFolder '子文件夾對(duì)象
Dim objFiles '文件集合
Dim objFile '文件對(duì)象
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)'創(chuàng)建文件夾對(duì)象
Response.Write DirPath
Response.flush
Set XmlDoc = Server.CreateObject("Microsoft.XMLDOM")
XmlDoc.load Server.MapPath(ZipPathFile)
XmlDoc.async =False
'寫(xiě)入每個(gè)文件夾路徑
Set Xfolder = XmlDoc.SelectSingleNode("//root").AppendChild(XmlDoc.CreateElement("folder"))
Set Xfpath = Xfolder.AppendChild(XmlDoc.CreateElement("path"))
Xfpath.text = Replace(DirPath, ZipPathDir,"")
Set objFiles = objFolder.Files
ForEach 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
'================================================
'寫(xiě)入文件的路徑及文件內(nèi)容
Set Xfile = XmlDoc.SelectSingleNode("//root").AppendChild(XmlDoc.CreateElement("file"))
Set Xpath = Xfile.AppendChild(XmlDoc.CreateElement("path"))
Xpath.text = Replace(PathNameStr, ZipPathDir,"")
'創(chuàng)建文件流讀入文件內(nèi)容，并寫(xiě)入XML文件中
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"
'文件內(nèi)容采用二制方式存放
Xstream.dataType ="bin.base64"
Xstream.nodeTypedValue = objStream.Read()
Set objStream =Nothing
Set Xpath =Nothing
Set Xstream =Nothing
Set Xfile =Nothing
'================================================
EndIf
Next
Response.Write "<p>"
XmlDoc.Save(Server.Mappath(ZipPathFile))
Set Xfpath =Nothing
Set Xfolder =Nothing
Set XmlDoc =Nothing
'創(chuàng)建的子文件夾對(duì)象
Set objSubFolders = objFolder.SubFolders
'調(diào)用遞歸遍歷子文件夾
ForEach objSubFolder in objSubFolders
pathname = DirPath & objSubFolder.Name &"/"
LoadData(pathname)
Next
Set objFolder =Nothing
Set objSubFolders =Nothing
Set fso =Nothing
EndSub
'創(chuàng)建一個(gè)空的XML文件，為寫(xiě)入文件作準(zhǔn)備
Sub CreateXml(FilePath)
'程序開(kāi)始執(zhí)行時(shí)間
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("root"))
XmlDoc.Save(Server.MapPath(FilePath))
Set Root =Nothing
Set XmlDoc =Nothing
LoadData(ZipPathDir)
'程序結(jié)束時(shí)間
endtime = Timer()
response.Write("頁(yè)面執(zhí)行時(shí)間："& FormatNumber((endtime - startime),3)&"秒")
EndSub
%>
</body>
</html>
下邊這個(gè)存為Install.asp,安裝XML打包文件時(shí)運(yùn)行
復(fù)制代碼代碼如下:
<%@LANGUAGE="VBSCRIPT" CODEPAGE="65001"%>
<%OptionExplicit%>
<%OnErrorResumeNext%>
<% Response.Charset="UTF-8"%>
<% Server.ScriptTimeout=99999999%>
<!DOCTYPEhtmlPUBLIC"-//W3C//DTDXHTML1.0Transitional//EN""http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<htmlxmlns="http://www.w3.org/1999/xhtml">
<head>
<metahttp-equiv="Content-Type"content="text/html; charset=utf-8"/>
<title>文件解包程序</title>
</head>
<body>
<%
Dim strLocalPath
'得到當(dāng)前文件夾的物理路徑
strLocalPath = Left(Request.ServerVariables("PATH_TRANSLATED"), InStrRev(Request.ServerVariables("PATH_TRANSLATED"),"/"))
Dim objXmlFile
Dim objNodeList
Dim objFSO
Dim objStream
Dim i, j
Set objXmlFile = Server.CreateObject("Microsoft.XMLDOM")
objXmlFile.load(Server.MapPath("update.xml"))
If objXmlFile.readyState =4Then
If objXmlFile.parseError.errorCode =0Then
Set objNodeList = objXmlFile.documentElement.selectNodes("//folder/path")
Set objFSO = CreateObject("Scripting.FileSystemObject")
j = objNodeList.Length -1
For i =0To j
If objFSO.FolderExists(strLocalPath & objNodeList(i).text)=FalseThen
objFSO.CreateFolder(strLocalPath & objNodeList(i).text)
EndIf
Response.Write "創(chuàng)建目錄"& objNodeList(i).text &"<br/>"
Response.Flush
Next
Set objFSO =Nothing
Set objNodeList =Nothing
Set objNodeList = objXmlFile.documentElement.selectNodes("//file/path")
j = objNodeList.Length -1
For i =0To j
Set objStream = CreateObject("ADODB.Stream")
With objStream
.Type=1
.Open
.Write objNodeList(i).nextSibling.nodeTypedvalue
.SaveToFile strLocalPath & objNodeList(i).text,2
Response.Write "釋放文件"& objNodeList(i).text &"<br/>"
Response.Flush
.Close
EndWith
Set objStream =Nothing
Next
Set objNodeList =Nothing
EndIf
EndIf
Set objXmlFile =Nothing
response.Write "文件解包完畢"
%>
</body>
</html>
