ASP利用XML打包指定文件夾并上傳到WEB目錄中，自行解包_ASP教程

教程Tag：暫無Tag,歡迎添加,賺取U幣!

推薦：ASP Error對象的技巧
在VBScript中，有一個On Error Resume Next語句，它使腳本解釋器忽略運行期錯誤并繼續腳本代碼的執行。接著該腳本可以檢查Err.Number屬性的值，判別是否出現了錯誤。如果出現錯誤，返回一個非零值。在ASP 3.0中，也可以使用On Error Goto 0“轉回到”缺省的

'======================== 
'文件１ 
'Pack.asp 
'更改　Cpathname　這一變量 
'將在當前目錄生成一個DATA.XML文件 
'將DATA.XML及文件２（install.asp)上傳至ＷＥＢ根目錄 
'運行install.asp解包 
'手動刪除以上兩個文件  
'======================== 
<% Option Explicit %> 
<% On Error Resume Next %> 
<% 
Server.ScriptTimeout=99999999 
dim Cpathname 
dim startime,endtime 
 
'在此更改要打包文件夾的路徑 
Cpathname = "F:WEBsymr" 
 
startime=timer() 
function bianli(path) 
dim doc 
dim fso 'fso對象 
dim objFolder '文件夾對象 
dim objSubFolders '子文件夾集合 
dim objSubFolder '子文件夾對象 
dim objFiles '文件集合 
dim objFile '文件對象 
dim objStream 
dim pathname,TextStream,pp,Xfolder,Xfpath,Xfile,Xpath,Xstream 
 
set fso=server.CreateObject("scripting.filesystemobject") 
set objFolder=fso.GetFolder(path)'創建文件夾對象 
 
Response.Write path 
Response.flush 
 
Set doc = Server.CreateObject("MSxml2.DOMDocument") 
doc.load Server.MapPath("data.xml") 
doc.async=false 
 
'寫入每個文件夾路徑 
set Xfolder = doc.SelectSingleNode("//z-blog").AppendChild(doc.CreateElement("folder")) 
Set Xfpath = Xfolder.AppendChild(doc.CreateElement("path")) 
Xfpath.text = replace(path,Cpathname,"") 
 
set objFiles=objFolder.Files 
for each objFile in objFiles 
Response.Write " 
---" 
pp = path & "" & objFile.name 
 
Response.Write pp & " 
" 
Response.flush 
 
'================================================ 
'寫入文件的路徑及文件內容 
set Xfile = doc.SelectSingleNode("//z-blog").AppendChild(doc.CreateElement("file")) 
 
Set Xpath = Xfile.AppendChild(doc.CreateElement("path")) 
Xpath.text = replace(pp,Cpathname,"") 
 
'創建文件流讀入文件內容，并寫入XML文件中 
Set objStream = Server.CreateObject("ADODB.Stream") 
objStream.Type = 1 
objStream.Open() 
objStream.LoadFromFile(pp) 
objStream.position = 0 
 
Set Xstream = Xfile.AppendChild(doc.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 
 
'================================================ 
next 
Response.Write "<p>" 
 
doc.save server.mappath("data.xml") 
set Xfpath = nothing 
set Xfolder = nothing 
set doc = nothing 
 
'創建的子文件夾對象 
set objSubFolders=objFolder.Subfolders 
'調用遞歸遍歷子文件夾 
for each objSubFolder in objSubFolders 
pathpathname=path + "" + objSubFolder.name 
bianli(pathname) 
next  
 
set objFolder=nothing 
set objSubFolders=nothing 
set fso=nothing 
end function 
 
dim doc,objPI 
'創建一個空的XML文件，為寫入文件作準備 
Set doc = Server.CreateObject("MSxml2.DOMDocument") 
doc.async=false 
set objPI = doc.createProcessingInstruction("xml","version='1.0' encoding='UTF-8'") 
doc.insertBefore objPI, doc.childNodes(0) 
doc.appendChild(doc.CreateElement("z-blog")) 
doc.save server.mappath("data.xml") 
set objPI = nothing 
set doc = nothing 
bianli(Cpathname)  
endtime=timer() 
%>  
頁面執行時間：<%=FormatNumber((endtime-startime),3)%>秒 
 
'================================= 
'文件２ 
'install.asp 
'此文件改自z-blog安裝文件 
'================================= 
<%@ CODEPAGE=65001 %> 
<% Option Explicit %> 
<% On Error Resume Next %> 
<% Response.Charset="UTF-8" %> 
<html> 
<head> 
<title>文件解包程序</title> 
</head> 
<body> 
<textarea name="content" cols="90" rows="20" style="border:0px;overflow:auto;border-width:0px;width:100%;background-color:#E8F3FF;" scrolling="auto"> 
<% 
Dim strLocalPath 
'得到當前文件夾的物理路徑 
strLocalPath=Left(Request.ServerVariables("PATH_TRANSLATED"),InStrRev(Request.ServerVariables("PATH_TRANSLATED"),"")) 
 
Dim strDbPath 
Dim objXmlFile 
Dim objNodeList 
Dim objFSO 
Dim objStream 
Dim i,j 
 
Set objXmlFile = Server.CreateObject("Microsoft.XMLDOM") 
objXmlFile.load(Server.MapPath("data.xml")) 
 
If objXmlFile.readyState=4 Then 
If objXmlFile.parseError.errorCode = 0 Then 
 
Set objNodeList = objXmlFile.documentElement.selectNodes("//folder/path") 
Set objFSO = CreateObject("Scripting.FileSystemObject") 
 
j=objNodeList.length-1 
For i=0 To j 
If objFSO.FolderExists(strLocalPath & objNodeList(i).text)=False Then 
objFSO.CreateFolder(strLocalPath & objNodeList(i).text) 
End If 
Response.Write "創建目錄" & objNodeList(i).text & vbCrlf 
Response.Flush 
Next 
 
Set objNodeList = objXmlFile.documentElement.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 
Response.Write "釋放文件" & objNodeList(i).text & vbCrlf 
Response.Flush 
.Close 
End With 
Set objStream = Nothing 
Next 
End If 
End If 
%> 
</textarea> 
<%response.write "<script>alert('文件解包完畢!');</script>"%>

分享：ASP開發中有用的函數(function)集合(1)
ASP開發中有用的function集合,挺有用處的！希望大家保留！ % '************************************* '防止外部提交 '************************************* function ChkPost() dim server_v1,server_v2 chkpost=false server_v1=Cstr(Request.ServerVari