ASP利用XML打包指定文件夹 并上传到WEB目录中，自行解包_ASP教程

推荐：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