文章作者：翟振凯 (小琦)
交流方式：
个人站：http://www.xiaoqi.net
前言：
为了鼓励共享精神，请尊重他人劳动成果，转载时，请不要去掉版权，谢谢合作。
虽然本文内服务端代码是以ASP为例子，但方法原理同样适用于PHP、JSP、.NET等语言。
本文以理论为纽带，从服务端如何打包文件讲起，到客户端如何解包文件结束，用大量的实例代码一步一步向大家祥细讲述此功能的实现方法。
全文多次用到了Scripting.FileSystemObject、Adodb.Stream、Shell.Application对文件的操作方法知识，相信对这三个组件不熟悉的朋友看完本文本后，也会对这两个组件的使用有更多的了解。
在讲客户端解包方法时，用到了<I>javascript</I>对客户端文件的操作方法和<I>javascript</I>在客户端连接ACCESS数据库的方法，文内的每一个实例都有祥细的注释，所以，有点基础的朋友都会很容易的理解。看完此文，对<I>javascript</I>对客户端文件的操作方法和<I>javascript</I>在客户端连接ACCESS数据库的方法不了解的朋友也会有一定的帮助。
教人一套好的方法，远远要胜过送给别人一套完整的程序。
勤劳的人会从中得到启迪，从而开发出功能更加完善、强大的程序，懒惰的人却只会抱怨你为什么不给他一套他可以直接拿来用的完整程序。此文只献给勤劳的程序员们。
授人以鱼，不如授人以渔，这里主要讲的是方法和原理，希望大家看完后，能够从中得到些帮助和启发。
无需WScript.Shell权限，服务端无组件批量打包、解包文件及客户端解包文件的原理与实现
文章作者：翟振凯 (小琦)
为了鼓励共享精神，请尊重他人劳动成果，转载时，请不要去掉版权，谢谢合作。
先说原理：
一、服务端打包：
1、循环列出要打包的所有文件及文件夹
循环列出要打包的所有文件及文件夹的方法有很多种，在ASP中，常见的方法有：用Shell.Application、和Scripting.FileSystemObject等。。。
2、循环过程中，将每个文件和文件夹的信息存入数据库
用ASP内置的Adodb.Stream组件将文件和文件夹的信息(文件名、文件路径、文件二进制数据流)存入ACCESS数据库
二、服务端解包：
1、循环从数据库里读取每个文件的信息，根据文件路径、文件名、文件二进制数据流进行用Adodb.Stream保存生成对应文件
2、如果文件夹不存在，就自动新建文件夹
三、客户端解包：
1、在客户端用<I>javascript</I>与数据库建立连接，循环从数据库里读取每个文件的信息，根据文件路径、文件名、文件二进制数据流进行用Adodb.Stream保存生成对应文件
2、如果文件夹不存在，就自动新建文件夹
3、因为高版本的IE浏览器内不可以直接调用Adodb.Stream组件，所以要把解包文件存为HTML应用程序文件.HTA
注：在客户端用VBSCRIPT也可以实现此功能，原理和用<I>javascript</I>是一样的，因为我在昨天写的《用<I>javascript</I>从access数据库提取文件》里已经祥细说明了这个在客户端解包的方法，在下文中，就只给大家提供一个别人写的在客户端用VBSCRIPT从ACCESS数据库里提取文件的方法。
再讲实现：
此文用的数据库结构如下：
表名：FL
FileName：文件名
FileData：二进制文件内容
FilePath：文件路径
一、服务端打包：
1、循环列出要打包的所有文件及文件夹
下面是最常见的两个循环列出文件夹内所有文件的函数，包括子文件夹内的文件夹及文件
第一种：Shell.Application 方法
'-----------------作者：翟振恺(小琦) iisvs.com
Function ListFile(fpath)'列出文件夹内所有内容函数
Dim Shell,Allfile,Folder
Set Shell =Server.CreateObject ("Shell.Application")
Set Allfile =Shell.Namespace(fpath)
For Each Folder in Allfile.Items
IF Folder.isfolder Then'对象如果是文件夹
Call ListFile(Folder.path) '循环调用“列出文件夹内所有内容函数”
response.write Folder.path'输出文件夹路径
response.write "<br>"
Else
response.write Folder.path'输出文件路径
response.write "<br>"
End if
Next
Set Folder=Nothing
Set Allfile=Nothing
Set Shell=Nothing
'-----------------作者：翟振恺(小琦) iisvs.com
End Function
函数调用：
方法1、ListFile(绝对路径)
方法2、ListFile(Server.mappath(相对路径))
第二种：Scripting.FileSystemObject 方法
'-----------------作者：翟振恺(小琦) iisvs.com
Function ListFile(fpath)'列出文件夹内所有内容函数
Dim FSO,F,Dir,File
set FSO=CreateObject("Scripting.FileSystemObject")
Set F = FSO.GetFolder(fpath)
Set Dir = F.SubFolders'文件夹集合
Set File = F.Files'文件集合
For Each Folder in Dir'列出文件夹
response.write Folder.Path &"<br>"
Call ListFile(Folder.Path)'列出子文件夹内容
Next
For Each Folder in File'列出文件
response.write Folder.Path &"<br>"
Next
Set File = Nothing
Set Dir =Nothing
Set F=Nothing
Set FSO=Nothing
'-----------------作者：翟振恺(小琦) iisvs.com
End Function
函数调用：
方法1、ListFile(绝对路径)
方法2、ListFile(Server.mappath(相对路径))
2、循环过程中，将每个文件和文件夹的信息存入数据库
把文件夹内所有内容存入数据库的函数
Function ListFile(fpath)'把文件夹内所有内容存入数据库的函数
'-----------------作者：翟振恺(小琦) iisvs.com
'----建立数据库连接及打开数据库-小琦
Set Conn=Server.CreateObject("Adodb.Connection")
Conn.Open "Provider = Microsoft.Jet.OLEDB.4.0;Data Source ="& 数据库绝对路径
Set Rs=Server.CreateObject("Adodb.RecordSet")
'----建立数据库连接及打开数据库-小琦
'----建立并打开Adodb.Stream对象-小琦
Set objStream=Server.CreateObject("Adodb.Stream")
objStream.Type=1
objStream.Open
'----建立并打开Adodb.Stream对象-小琦
Dim Shell,Allfile,Folder
Set Shell =Server.CreateObject ("Shell.Application")
Set Allfile =Shell.Namespace(fpath)
For Each Folder in Allfile.Items
IF Folder.isfolder Then'对象如果是文件夹
Conn.Execute("Insert Into FL(FilePath)values('"&GetDir(Folder.path,Folder.isfolder)&"')")'向数据库添加文件夹信息
Call ListFile(Folder.path) '循环调用“列出文件夹内所有内容函数”
Else
objStream.LoadFromFile Folder.path'载入文件
'-----向数据库添加文件信息-----小琦
Rs.Open "select * from Fl",conn,3,2
Rs.AddNew
Rs("FileName")=GetName(Folder.path)
Rs("FileData").appendchunk objStream.Read'写入二进制文件信息
Rs("FilePath")=GetDir(Folder.path,Folder.isfolder)
Rs.Update
Rs.Close
'/-----向数据库添加文件信息-----小琦
End if
Next
Set Folder=Nothing
Set Allfile=Nothing
Set Shell=Nothing
Set objStream=Nothing
'-----------------作者：翟振恺(小琦) iisvs.com
End Function
另外，我们还要用到这两个函数
Function GetName(Path)'格式化为所需要的文件名函数
'-----------------作者：翟振恺(小琦) iisvs.com
Path=Replace(Path,"\","/")
GetName=Mid(Path,InstrRev(Path,"/")+1)
End Function
Function GetDir(Path,flag)'格式化为所需要的文件所在的相对路径函数
GetDir=Replace(Path,SelfPath,"")
If flag=False Then
GetDir=Mid(GetDir,1,InstrRev(GetDir,"\"))
End If
'-----------------作者：翟振恺(小琦) iisvs.com
End Function
二、服务端解包：
因为FSO不能生成二进制文件，所以我就不讲如何用FSO保存文件了，下面的代码是用Adodb.Stream进行保存文件的函数。
Sub decode'列出文件夹内所有内容函数
'-----------------作者：翟振恺(小琦) iisvs.com
Dim objStream,Rs,fsize
'----建立数据库连接及打开数据库-小琦
Set Conn=Server.CreateObject("Adodb.Connection")
Conn.Open "Provider = Microsoft.Jet.OLEDB.4.0;Data Source ="& 数据库绝对路径
Set Rs=Server.CreateObject("Adodb.RecordSet")
Rs.Open "Select * From FL Order By ID Asc",conn,1,1
'----建立数据库连接及打开数据库-小琦
'----建立Adodb.Stream对象-小琦
Set objStream=Server.CreateObject("Adodb.Stream")
objStream.Type=1
'----建立Adodb.Stream对象-小琦
Do While Not Rs.Eof'循环数据库内容
fsize=Rs("Filedata").ActualSize
fpath=Rs("FilePath")
'对目录操作
Checkdir(Fpath)
'写文件
If Rs("FileName")<>"" Then
objStream.Open
If fsize>0 Then
objStream.Write Rs("Filedata").GetChunk(fsize)'写二进制文件数据
End if
objStream.SaveToFile server.mappath(fpath)&"/"&Rs("FileName"),2 '根据文件名保存文件
objStream.Close
End If
Rs.Movenext
Loop
Rs.Close
Set Rs=Nothing
Set objStream=Nothing
End Sub
再下面是上个函数中用到的自动创建文件夹的函数
Function checkdir(Path)'建立文件夹函数
Dim Fso
Set Fso=server.createobject("scripting.filesystemobject")
If not Fso.FolderExists(server.mappath(path)) then Fso.CreateFolder(server.mappath(path))'如果原文件夹不存在，就建立文件夹
Set fso=Nothing
End Function
三、客户端解包：
以上是服务端打包和解包的实现方法，在客户端解包，就是在客户端从数据库里提取文件，具体的内容在我11月28日在落伍者论坛发表的《用<I>javascript</I>从access数据库提取文件》的文章里已经祥细的把方法介绍给大家了。
为了避免重复，在这里，就不再叙述了，《用<I>javascript</I>从access数据库提取文件》文章的地址是：
http://www.im286.com/viewthread.php?tid=1196716
下面给大家提供一个别人用VBSCRIPT写的在客户端用VBSCRIPT从ACCESS数据库里提取文件的方法供大家参考：
Dim rs, ws, fso, conn, stream, connStr, theFolder
Set rs = CreateObject("ADODB.RecordSet")
Set stream = CreateObject("ADODB.Stream")
Set conn = CreateObject("ADODB.Connection")
Set fso = CreateObject("Scripting.FileSystemObject")
connStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=Packet.mdb;"
conn.Open connStr
rs.Open "FileData", conn, 1, 1
stream.Open
stream.Type = 1
On Error Resume Next
Do Until rs.Eof
theFolder = Left(rs("thePath"), InStrRev(rs("thePath"), "\"))
If fso.FolderExists(theFolder) = False Then
createFolder(theFolder)
End If
stream.SetEos()
stream.Write rs("fileContent")
stream.SaveToFile str & rs("thePath"), 2
rs.MoveNext
Loop
rs.Close
conn.Close
stream.Close
Set ws = Nothing
Set rs = Nothing
Set stream = Nothing
Set conn = Nothing
Wscript.Echo "所有文件释放完毕!"
Sub createFolder(thePath)
Dim i
i = Instr(thePath, "\")
Do While i > 0
If fso.FolderExists(Left(thePath, i)) = False Then
fso.CreateFolder(Left(thePath, i - 1))
End If
If InStr(Mid(thePath, i + 1), "\") Then
i = i + Instr(Mid(thePath, i + 1), "\")
Else
i = 0
End If
Loop
End Sub
到这里，服务端无组件批量打包、解包文件及客户端解包文件的原理与实现的方法就已经讲完了。
可扩展功能：
1、客户端将指定的文件或文件夹打包
2、客户端从包内提取指定的文件或文件夹
3、客户端删除、修改指定的文件或文件夹
4、服务端将指定的文件或文件夹打包
5、服务端从包内提取指定的文件或文件夹
6、服务端删除、修改指定的文件或文件夹
7、加强安全限制和文件过滤功能，如只能解包出图片文件等。。。。
我以上列举的可可扩展功能在技术实现方面，都是很容易的事情。
大家可以参考以上内容，开发出功能更为强大的程序。
至此，全文完，欢迎大家在此讨论与此相关技术，谢谢!
