ASP无组件批量打包、解包文件及客户端解包文件的原理与实现

先说原理：

一、服务端打包：
1、循环列出要打包的所有文件及文件夹
循环列出要打包的所有文件及文件夹的方法有很多种，在ASP中，常见的方法有：用Shell.Application、和Scripting.FileSystemObject等。。。
2、循环过程中，将每个文件和文件夹的信息存入数据库
用ASP内置的Adodb.Stream组件将文件和文件夹的信息(文件名、文件路径、文件二进制数据流)存入ACCESS数据库
二、服务端解包：
1、循环从数据库里读取每个文件的信息，根据文件路径、文件名、文件二进制数据流进行用Adodb.Stream保存生成对应文件
2、如果文件夹不存在，就自动新建文件夹
三、客户端解包：
1、在客户端用Javascript与数据库建立连接，循环从数据库里读取每个文件的信息，根据文件路径、文件名、文件二进制数据流进行用Adodb.Stream保存生成对应文件
2、如果文件夹不存在，就自动新建文件夹
3、因为高版本的IE浏览器内不可以直接调用Adodb.Stream组件，所以要把解包文件存为HTML应用程序文件.HTA

注：在客户端用VBSCRIPT也可以实现此功能，原理和用javascript是一样的，因为我在昨天写的《用javascript从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
'-----------------作者：翟振恺(小琦) iisvs.com
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日在落伍者论坛发表的《用javascript从access数据库提取文件》的文章里已经祥细的把方法介绍给大家了。
为了避免重复，在这里，就不再叙述了，《用javascript从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、加强安全限制和文件过滤功能，如只能解包出图片文件等。。。。

我以上列举的可可扩展功能在技术实现方面，都是很容易的事情。
大家可以参考以上内容，开发出功能更为强大的程序。