柳永法xml asp源碼打包工具，打包成單獨的xml文件，可以在伺服器上直接安裝下邊這個存為Pack.asp,打包文件時運行
複製代碼代碼如下:
<%@LANGUAGE=VBSCRIPT CODEPAGE=65001%>
<%OptionExplicit%>
<%OnErrorResumeNext%>
<% Response.Charset=UTF-8%>
<% Server.ScriptTimeout=99999999%>
<!DOCTYPEhtmlPUBLIC-//W3C//DTDXHTML1.0Transitional//ENhttp://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd>
<htmlxmlns=http://www.w3.org/1999/xhtml>
<head>
<metahttp-equiv=Content-Typecontent=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&/
'開始打包
CreateXml(ZipPathFile)
'遍歷目錄內的所有檔案以及資料夾
Sub LoadData(DirPath)
Dim XmlDoc
Dim fso 'fso對象
Dim objFolder '資料夾對象
Dim objSubFolders '子資料夾集合
Dim objSubFolder '子資料夾對象
Dim objFiles '檔案集合
Dim objFile '檔案對象
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)'建立資料夾對象
Response.Write DirPath
Response.flush
Set XmlDoc = Server.CreateObject(Microsoft.XMLDOM)
XmlDoc.load Server.MapPath(ZipPathFile)
XmlDoc.async =False
'寫入每個資料夾路徑
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
'==================================================
'寫入檔案的路徑及檔案內容
Set Xfile = XmlDoc.SelectSingleNode(//root).AppendChild(XmlDoc.CreateElement(file))
Set Xpath = Xfile.AppendChild(XmlDoc.CreateElement(path))
Xpath.text = Replace(PathNameStr, ZipPathDir,)
'建立文件流讀入文件內容，並寫入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
'文件內容採二制方式存放
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
'已建立的子資料夾對象
Set objSubFolders = objFolder.SubFolders
'呼叫遞歸遍歷子資料夾
ForEach objSubFolder in objSubFolders
pathname = DirPath & objSubFolder.Name &/
LoadData(pathname)
Next
Set objFolder =Nothing
Set objSubFolders =Nothing
Set fso =Nothing
EndSub
'建立一個空的XML文件，為寫入文件作準備
Sub CreateXml(FilePath)
'程式開始執行時間
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)
'程序結束時間
endtime = Timer()
response.Write(頁面執行時間：& FormatNumber((endtime - startime),3)&秒)
EndSub
%>
</body>
</html>
下邊這個存為Install.asp,安裝XML打包檔時執行
複製代碼代碼如下:
<%@LANGUAGE=VBSCRIPT CODEPAGE=65001%>
<%OptionExplicit%>
<%OnErrorResumeNext%>
<% Response.Charset=UTF-8%>
<% Server.ScriptTimeout=99999999%>
<!DOCTYPEhtmlPUBLIC-//W3C//DTDXHTML1.0Transitional//ENhttp://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd>
<htmlxmlns=http://www.w3.org/1999/xhtml>
<head>
<metahttp-equiv=Content-Typecontent=text/html; charset=utf-8/>
<title>檔案解包程式</title>
</head>
<body>
<%
Dim strLocalPath
'得到目前資料夾的物理路徑
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 建立目錄& 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>