<%
Class Ex_ZipCls
Dim Fso,XmlObj,StreamObj
Private Sub Class_Initialize
	Set Fso=Server.CreateObject("scripting.FileSystemobject") 
	Set StreamObj=Server.CreateObject("adodb.stream")
	StreamObj.Type=1
	StreamObj.Open()
	Set XmlObj=Server.CreateObject("Microsoft.XMLDOM")
End Sub 
Private Sub Class_Terminate
	Set Fso=Nothing 
	Set StreamObj=Nothing 
	Set XmlObj=Nothing 
End Sub 
'********************
'作用:获得文件夹中子文件夹的名字
'参数：filepath---要读取的文件地址 
'返回值: 一个以|为分割的字符串 例如Final/Ex_Cls|Final/Ex_Cls/00|Final/Ex_Cls/00/44|Final/Ex_Cls/00/44/3|Final/Inc|Final/Inc/5|
'*********************
Private Function GetAllSubFolders(FPath) 
	Dim Path,PathName
	Path=Server.MapPath(FPath)
	If Fso.FolderExists(Path) Then
		Dim myfolder,item,Str,Temp
		Set  myfolder=Fso.GetFolder(Path)
		For each item in myfolder.SubFolders
			str=str&FPath&"/"&item.name&"|"
			PathName=FPath&"/"&item.name
			str=str&GetAllSubFolders(PathName)
		Next
		If Trim(str)="" Then 
			GetAllSubFolders=""
		Else 
			GetAllSubFolders=Str
		End If 
	Else
		GetAllSubFolders="文件夹不存在"
	End If 
End Function 
'********************
'作用:获得文件夹中子文件的名字
'参数：filepath---要读取的文件地址
'返回值: 一个以|为分割的字符串
'*********************
Private Function GetSubFiles(FPath) 
	Dim Path
	Path=Server.MapPath(FPath)
	If Fso.FolderExists(Path) Then
		Dim myfolder,item,Str
		Set  myfolder=Fso.GetFolder(Path)
		For each item in myfolder.files
			str=str&FPath&"/"&item.name&"|"
		Next
		GetSubFiles=Str
	Else
		GetSubFiles="文件夹不存在"
	End If 
End Function 
'*********************
'功能：读取文件
'参数: FPath--文件地址
'返回:返回文件的二进制数据
'*********************
Private Function ReadFile(FPath)
	With StreamObj
		.LoadFromFile(Server.MapPath(FPath))
		.Position=0
		ReadFile=.Read()
	End With
End Function 
'************************
'功能：如果路径不存在就生成路径
'参数:fileurl---相对路径
'************************
private Sub CreateRoute(fileurl)
	On Error Resume Next 
	Dim ArrFile,strFile,i,Path
	path=Server.Mappath(fileurl)
	path=Replace(path,"/","\")
	ArrFile=Split(path,"\")
	strFile=ArrFile(0)
	For I=1 To UBound(ArrFile)
		strFile=strFile&"\"&ArrFile(i)
		If Fso.FolderExists(strFile)=False Then
			Fso.CreateFolder(strFile)
			If Err.number<>0 And InStr(Err.description,"已存在")=0 Then 
				Response.Write "<script>文件夹生成时错误\n易心博客程序是以易心空间为基础而开发，建议在易心空间上运行以使用全部功能.</script>"
				Exit Sub 
			End If 
		End If 
	Next 
End Sub 
'*********************
'功能：生成Zip的xml文件
'参数: XmlPath--xml文件地址  Str--要压缩的文件或者文件夹路径字符串 例如Final/Ex_Cls|Final/Ex_Cls/00|Final/Ex_Cls/00/44|Final/Ex_Cls/00/44/3|Final/Inc|Final/Inc/5|
'*********************
Public Sub ZipStr(Str,XmlPath)
	Dim Path,XmlVersion,Temp,I,XmlNode,AttNode,PXmlNode,Root
	Path=Server.MapPath(XmlPath)
	If Not Fso.FileExists(Path) Then 
		With XmlObj
		set XmlVersion=.createprocessinginstruction("xml"," version='1.0' encoding='gb2312'")
		.appendChild(XmlVersion)
		set Root=.createElement("root")
		.appendChild(Root)
		.Save Path
		End With
	End If 
	XmlObj.Load(Path)
	Set PXmlNode=XmlObj.SelectSingleNode("//root")
	Temp=Split(Str,"|")
	For I=0 To UBound(Temp)-1
		If InStr(Temp(I),".")<>0 Then 
			If Fso.FileExists(Server.MapPath(Temp(I))) And InStr(LCase(Temp(I)),".db")=0 Then 
				Set XmlNode=XmlObj.CreateElement("file")
				Set AttNode=XmlObj.CreateNode("attribute","path","")
				AttNode.Text=Replace(Temp(I),"UpdateFiles/","")'根据程序自定义修改
				XmlNode.setAttributeNode AttNode
				XmlNode.DataType="bin.base64"
				XmlNode.nodeTypedValue=ReadFile(Temp(I))
				PXmlNode.appendChild(XmlNode)
			End If 
		Else
			Set XmlNode=XmlObj.CreateElement("folder")
			Set AttNode=XmlObj.CreateNode("attribute","path","")
			AttNode.Text=Replace(Temp(I),"UpdateFiles/","")'根据程序自定义修改
			XmlNode.setAttributeNode AttNode
			PXmlNode.appendChild(XmlNode)
		End If 
	Next 
	XmlObj.Save Path
End Sub 
'*********************
'功能：生成指定文件夹中文件夹路径的Zip的xml文件
'参数: FPath--文件夹相对于程序的相对路径 XmlPath--xml文件地址
'*********************
Public Sub ZipFolders(FPath,XmlPath)
	ZipStr FPath&"|"&GetAllSubFolders(FPath),XmlPath
End Sub 
'*********************
'功能：生成指定文件夹中所有文件的Zip的xml文件
'参数: FPath--文件夹相对于程序的相对路径 
'*********************
Public Sub ZipFiles(FPath,XmlPath)
	ZipStr GetSubFiles(FPath),XmlPath
End Sub
'*********************
'功能：生成指定文件夹中所有文件夹和文件的Zip的xml文件
'参数: FPath--文件夹相对于程序的相对路径 
'*********************
Public Sub Zip(FPath,XmlPath)
	Dim Temp,I
	ZipStr GetAllSubFolders(FPath),XmlPath
	Temp=FPath&"|"&GetAllSubFolders(Fpath)
	Temp=Split(Temp,"|")
	For I=0 To UBound(Temp)-1
		ZipStr GetSubFiles(Temp(I)),XmlPath
	Next 
End Sub
'************************
'功能：根据xml文档生成文件
'参数:XmlPath---相对路径
'************************
Public Sub UZip(XmlPath)
	Dim XmlVersion,Nodes,Node,Path,SObj
	With XmlObj
		.Load(Server.Mappath(XmlPath))
		Set Nodes=.SelectNodes("//folder")
		For Each Node In Nodes
			Path=Node.getAttributeNode("path").NodeValue
			If Not Fso.FolderExists(Server.Mappath(Path)) Then 
				CreateRoute Path
				Response.Write("文件夹"&Path&"生成成功<br>")
				Response.Flush()
			End If 
		Next 
		Set Nodes=.SelectNodes("//file")
		For Each Node In Nodes
			Path=Node.getAttributeNode("path").NodeValue
			If Not Fso.FolderExists(Server.Mappath(Path)) Then 
				Set SObj=Server.CreateObject("adodb.stream")
				SObj.Type = 1
				SObj.Mode = 3
				SObj.Open
				Response.Write("正在解压"&Path&"<br>")
				Response.Flush()
				SObj.write Node.NodeTypedValue
				SObj.SaveToFile Server.MapPath(Path),2
				SObj.Close
				Set SObj=Nothing 
				Response.Write("文件"&Path&"生成成功<br>")
				Response.Flush()
			End If 
		Next 
	End With
End Sub 
End Class 
Server.ScriptTimeOut=1000
Response.Write("正在解压文件...")
Response.Flush()
Dim ExZip
Set ExZip=new Ex_ZipCls
ExZip.UZip "Data.ExZip"
Response.Write("文件解压成功")
'Response.Write("<script>if(confirm('文件解压成功,是否进行安装？'))location='index.asp';</script>")
Response.Flush()
Dim Fso
'Set Fso=Server.CreateObject("Scripting.filesystemobject")
'Fso.DeleteFile(Server.Mappath("Data.ExZip"))
'Fso.DeleteFile(Server.Mappath("Default.Asp"))
%>