用asp实现把文件打包成Xml文件包,带解包的ASP工具附下载

时间:2021-07-29 02:34:44

把文件打包成Xml文件包,带解包的ASP工具! 

把网站源码全部打包到Xml文件里面,生成 updata.xml 文件,把xml文件上传到空间里面 
然后通过 install.asp文件将文件全部释放出来。 
就和z-blog的 自动安装包一样的功能呵呵。 
代码是落伍的一位兄弟写的,不过代码好像有错误,这个是我参考他的 修改过了,可以正常运行!~~ 
此代码可以应用到 asp程序的 自动升级服务上面。具体怎么来实现,欢迎探讨!~~ 
就在下面回帖探讨!~~~ 
不用设定打包目录版,需要设定打包目录版 这两个版本的区别: 
不用设定打包目录版,直接放到你需要打包的目录 执行就可以了。 
需要设定打包目录版,必须指定需要打包的路径(在程序里修改),不指定,不能进行打包。 
不用设定目录-打包文件

复制代码代码如下:


<%@LANGUAGE="VBSCRIPT" CODEPAGE="65001"%> 
<% Option Explicit %> 
<% On Error Resume Next %> 
<% Response.Charset="UTF-8" %> 
<% Server.ScriptTimeout=99999999 %> 
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"> 
<html xmlns="http://www.w3.org/1999/xhtml"> 
<head> 
<meta http-equiv="Content-Type" content="text/html; charset=utf-8" /> 
<title>文件打包程序</title> 
</head> 

<body> 
<% 


    Dim ZipPathDir,ZipPathFile,ZipFileExt 
    Dim startime,endtime 
    '在此更改要打包文件夹的路径 
    ZipPathDir = Left(Request.ServerVariables("PATH_TRANSLATED"),InStrRev(Request.ServerVariables("PATH_TRANSLATED"),"\"))' 
    '生成的xml文件 
    ZipPathFile = "update.xml" 
    '不进行打包的文件扩展名 
    ZipFileExt = "db;bak" 
    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 
                for each objFile in objFiles 
                    if lcase(DirPath & objFile.name) <> lcase(Request.ServerVariables("PATH_TRANSLATED")) and lcase(DirPath & objFile.name) <> lcase(DirPath & ZipPathFile) then 
                        if ext(objFile.name) 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 
                          '================================================ 
                        end if 
                    end if 
                next 
        Response.Write "<p>" 
        XmlDoc.Save(Server.Mappath(ZipPathFile)) 
        set Xfpath = nothing 
        set Xfolder = nothing 
        set XmlDoc = nothing 

        '创建的子文件夹对象 
        set objSubFolders=objFolder.Subfolders 
            '调用递归遍历子文件夹 
            for each objSubFolder in objSubFolders 
                pathname = DirPath & objSubFolder.name & "\" 
                LoadData(pathname) 
            next 
        set objFolder=nothing 
        set objSubFolders=nothing 
        set fso=nothing 

    end sub 

     

    '创建一个空的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) & "秒") 
    end sub 

    '判断文件类型是否合法 
    function ext(filename) 
        ext = true 
        dim temp_ext,e 
        temp_ext = Split(ZipFileExt,";") 
        for e=0 to ubound(temp_ext) 
            if mid(filename,InstrRev(filename,".")+1)=temp_ext(e) then ext=false 
        next 
    end function 
%> 
</body> 
</html>


解压asp文件

复制代码代码如下:


<%@LANGUAGE="VBSCRIPT" CODEPAGE="65001"%> 
<% Option Explicit %> 
<% On Error Resume Next %> 
<% Response.Charset="UTF-8" %> 
<% Server.ScriptTimeout=99999999 %> 
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"> 
<html xmlns="http://www.w3.org/1999/xhtml"> 
<head> 
<meta http-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=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 & "<br/>" 
                        Response.Flush 
                    Next 
                Set objFSO = nothing 
                Set objNodeList = nothing 
                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 & "<br/>" 
                                Response.Flush 
                                .Close 
                            End With 
                        Set objStream = Nothing 
                    Next 
                Set objNodeList = nothing 
            End If 
        End If 

    Set objXmlFile = Nothing 

response.write "文件解包完毕" 
%> 
</body> 
</html>