您的位置：首页 > 编程语言 > ASP

ASP利用ＸＭＬ打包指定文件夹并上传到ＷＥＢ目录中，自行解包

2007-09-12 16:16 537 查看

'========================

'文件１

'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

'================================================

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

pathname=path + "" + objSubFolder.name

bianli(pathname)

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>

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

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

End If

</textarea>

<%response.write "<script>alert('文件解包完毕!');</script>"%>

内容来自用户分享和网络整理，不保证内容的准确性，如有侵权内容，可联系管理员处理

标签： asp path timer encoding xml each

相关文章推荐

新的分享

章节导航

ASP利用ＸＭＬ打包指定文件夹 并上传到ＷＥＢ目录中，自行解包

ASP利用ＸＭＬ打包指定文件夹并上传到ＷＥＢ目录中，自行解包