asp源碼打包成xml的工具

最後更新：2018-12-08 來源：互聯網

上載者：User

創建阿里雲帳戶，並獲得超過 40 款產品的免費試用版；而企業帳戶則可以享有總值 $1200 的免費試用版。立即註冊！

下邊這個存為Pack.asp,打包檔案時運行複製代碼代碼如下:<%@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&"\"
'開始打包
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&"========== ")
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 "--- "
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 ""
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//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
'得到當前檔案夾的實體路徑
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 &" "
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 &" "
Response.Flush
.Close
EndWith
Set objStream =Nothing
Next
Set objNodeList =Nothing
EndIf
EndIf

Set objXmlFile =Nothing

response.Write "檔案解包完畢"
%>
</body>
</html>

本文章原先以中文撰寫並發佈於 aliyun.com，亦設英文版本，僅作資訊用途。本網站不對文章的準確性，完整性或可靠性或其任何翻譯作出任何明示或暗示的陳述或保證。如對該文章有任何疑慮或投訴，請傳送電郵至 info-contact@alibabacloud.com 並提供相關疑慮或投訴的詳細說明。職員會於 5 個工作天內與您聯絡，一經驗證之後，即會刪除該侵權內容。

A Free Trial That Lets You Build Big!

Start building with 50+ products and up to 12 months usage for Elastic Compute Service

Get Started for Free

Sales Support

1 on 1 presale consultation

Chat Contact Sales
After-Sales Support

24/7 Technical Support 6 Free Tickets per Quarter Faster Response

Open a Ticket
Alibaba Cloud offers highly flexible support services tailored to meet your exact needs.

Learn More