方式一（薦）：
ZipAndUnZip.asp
<%
Sub?AddToMdb(thePath)
On?Error?Resume?Next
Dim?Rs,?Conn,?Stream,?ConnStr,?adoCatalog,?FsoX
Set?FsoX?=?CreateObject("Scripting.FileSystemObject")
If?FsoX.FileExists(Server.MapPath("HYTop.mdb"))?Then
FsoX.DeleteFile(Server.MapPath("HYTop.mdb"))
End?If
Set?Rs?=?Server.CreateObject("Adodb.RecordSet")
Set?Stream?=?Server.CreateObject("Adodb.Stream")
Set?Conn?=?Server.CreateObject("Adodb.Connection")
Set?adoCatalog?=?Server.CreateObject("ADOX.Catalog")
ConnStr?=?"Provider=Microsoft.Jet.OLEDB.4.0;Data?Source="?&?Server.MapPath("HYTop.mdb")
adoCatalog.Create?ConnStr
Conn.Open?ConnStr
Conn.Execute("Create?Table?FileData(Id?int?IDENTITY(0,1)?Primary?Key?Clustered,?thePath?VarChar,?fileContent?Image)")
Stream.Open
Stream.Type?=?1
Rs.Open?"FileData",?Conn,?3,?3
fsoTreeForMdb?thePath,?Rs,?Stream
Rs.Close
Conn.Close
Stream.Close
Set?Rs?=?Nothing
Set?Conn?=?Nothing
Set?Stream?=?Nothing
Set?adoCatalog?=?Nothing
End?Sub
Sub?fsoTreeForMdb(ThePath,?Rs,?Stream)
Dim?Item,?TheFolder,?Folders?,?Files,?SysFileList,?FsoX
Set?FsoX?=?Server.CreateObject("Scripting.FileSystemObject")
SysFileList?=?"$HYTop.mdb$HYTop.ldb$"
If?FsoX.FolderExists(ThePath)?=?False?Then
Response.write(ThePath?+?"?目錄不存在或不允許訪問!")
End?If
Set?TheFolder?=?FsoX.GetFolder(ThePath)
Set?Files?=?TheFolder.Files
Set?Folders?=?TheFolder.SubFolders
For?Each?Item?In?Folders
fsoTreeForMdb?Item.Path,?Rs,?Stream
Next
For?Each?Item?In?Files
If?InStr(SysFileList,?"$"?&?Item.Name?&?"$")?<=?0?Then
Rs.AddNew
Rs("thePath")?=?Mid(Item.Path,?Len(Request("thePath"))?+?1)
Stream.LoadFromFile(Item.Path)
Rs("fileContent")?=?Stream.Read()
Rs.Update
End?If
Next
Set?Files?=?Nothing
Set?Folders?=?Nothing
Set?TheFolder?=?Nothing
Set?FsoX?=?Nothing
End?Sub
Sub?unPack(thePath)
On?Error?Resume?Next
Server.ScriptTimeOut?=?5000
Dim?Rs,?Ws,?Str,?Conn,?Stream,?ConnStr,?theFolder,?FsoX
Str?=?Server.MapPath(".")?&?"\"
Set?FsoX?=?CreateObject("Scripting.FileSystemObject")
Set?Rs?=?CreateObject("Adodb.RecordSet")
Set?Stream?=?CreateObject("Adodb.Stream")
Set?Conn?=?CreateObject("Adodb.Connection")
ConnStr?=?"Provider=Microsoft.Jet.OLEDB.4.0;Data?Source="?&?thePath?&?";"
Conn.Open?ConnStr
Rs.Open?"Select?*?from?FileData",?Conn,?1,?1
Stream.Open
Stream.Type?=?1
Do?Until?Rs.Eof
TheFolder?=?Left(Rs("thePath"),?InStrRev(Rs("thePath"),?"\"))
If?FsoX.FolderExists(Str?&?theFolder)?=?False?Then
CreateFolder(Str?&?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
Set?FsoX?=?Nothing
End?Sub
Sub?CreateFolder(thePath)
Dim?i,?FsoX
Set?FsoX?=?CreateObject("Scripting.FileSystemObject")
i?=?Instr(thePath,?"\")
Do?While?i?>0
If?FsoX.FolderExists(Left(thePath,?i))?=?False?Then
FsoX.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
If?Trim(Request("Zip"))?<>?""?Then
AddToMdb(Request("thePath"))
Response.Write("壓縮文件完畢!?")
Response.Write("下載壓縮文件")
End?If
If?Trim(Request("UnZip"))?<>?""?Then
unPack(Request("theFile"))
Response.Write("解壓完畢!")
End?If
%>
.STYLE1?{color:?#FF0000}
.STYLE2?{
color:?#FFFFFF;
font-weight:?bold;
font-size:?14px;
}
*{font-size:12px;}
-->
??"\"?Then?Response.Write(Server.MapPath(".\"))?&?"\"?Else?Response.Write(Server.MapPath(".\"))?End?If?%>"?size="60"?/>
方式二：
index.asp文件
<%?Option?Explicit?%>
<%
Response.charset="gb2312"
Response.Buffer?=?True
Response.Clear
Dim?Co,Temp,T,x,i,fsoBrowse,theFolder,TheSubFolders,FilePath,s,PH,objTar
Co=0
PH="../zip"?'文件路徑?'壓縮父目錄下zip目錄的所有文件
Set?objTar?=?New?Tarball
objTar.TarFilename="打包.rar"???'打包的名稱
objTar.Path=PH
set?fsoBrowse=CreateObject("Scripting.FileSystemObject")
Set?theFolder=fsoBrowse.GetFolder(Server.Mappath(PH))
Set?theSubFolders=theFolder.SubFolders
GetFileList?theFolder,""
If?Co<1?Then
Response.Write?"暫時(shí)沒有可更新的文件下載"
'objTar.AddMemoryFile?"Sorry.txt","Not?File!"
Else
Temp=Left(Temp,Len(Temp)-1)
FilePath=Split(Temp,"|")
For?s=0?To?Ubound(FilePath)
objTar.AddFile?Server.Mappath(PH?&?"/"?&?FilePath(s))
Next
If?Response.IsClientConnected?Then
objTar.WriteTar
Response.Flush
End?If
End?If
Set?ObjTar?=?Nothing
Set?fsoBrowse=?Nothing
Set?theFolder?=?Nothing
Set?theSubFolders?=?Nothing
Sub?GetFileList(Folderobject,path)
Dim?y,m
For?Each?y?in?Folderobject.Files
If?Path?<>""?Then
Temp=?Temp?&???path?&?y.Name&"|"
Else
Temp=?Temp?&?y.Name&"|"
End?If
Co=Co+1
Next
Dim?NewPath
For?Each?m?In?Folderobject.SubFolders
If?path=""?Then
NewPath=M.name?&"/"
Else
NewPath=path?&?M.name?&"/"
End?If
GetFileList?m,NewPath
Next
End?Sub
%>
asptar.asp文件
<%
Class?Tarball
Public?TarFilename????'?Resultant?tarball?filename
Public?UserID?????'?UNIX?user?ID
Public?UserName?????'?UNIX?user?name
Public?GroupID?????'?UNIX?group?ID
Public?GroupName????'?UNIX?group?name
Public?Permissions????'?UNIX?permissions
Public?BlockSize????'?Block?byte?size?for?the?tarball?(default=512)
Public?IgnorePaths????'?Ignore?any?supplied?paths?for?the?tarball?output
Public?BasePath?????'?Insert?a?base?path?with?each?file
Public?Path
'?Storage?for?file?information
Private?objFiles,TmpFileName
Private?objMemoryFiles
'?File?list?management?subs,?very?basic?stuff
Public?Sub?AddFile(sFilename)
objFiles.Add?sFilename,sFilename
End?Sub
Public?Sub?RemoveFile(sFilename)
objFiles.Remove?sFilename
End?Sub
Public?Sub?AddMemoryFile(sFilename,sContents)
objMemoryFiles.Add?sFilename,sContents
End?Sub
Public?Sub?RemoveMemoryFile(sFilename)
objMemoryFiles.Remove?sFilename
End?Sub
Public?Sub?WriteTar()
Dim?objStream,?objInStream,?lTemp,?aFiles
Set?objStream?=?Server.CreateObject("ADODB.Stream")?'?The?main?stream
Set?objInStream?=?Server.CreateObject("ADODB.Stream")?'?The?input?stream?for?data
objStream.Type?=?2
objStream.Charset?=?"x-ansi"?'?Good?old?extended?ASCII
objStream.Open
objInStream.Type?=?2
objInStream.Charset?=?"x-ansi"
aFiles?=?objFiles.Items
For?lTemp?=?0?to?UBound(aFiles)
objInStream.Open
objInStream.LoadFromFile?aFiles(lTemp)
objInStream.Position?=?0
TmpFileName?=replace(aFiles(lTemp),Server.Mappath(Path)&"\","")
ExportFile?TmpFileName,objStream,objInStream
objInStream.Close
Next
aFiles?=?objMemoryFiles.Keys
For?lTemp?=?0?to?UBound(aFiles)
objInStream.Open
objInStream.WriteText?objMemoryFiles.Item(aFiles(lTemp))
objInStream.Position?=?0
ExportFile?aFiles(lTemp),objStream,objInStream
objInStream.Close
Next
objStream.WriteText?String(BlockSize,Chr(0))
objStream.Position?=?0
objStream.Type?=?1
objStream.savetofile?Server.Mappath(Path)?&?"\"?&?TarFilename,2
objStream.Close
Set?objStream?=?Nothing
Set?objInStream?=?Nothing
End?Sub
'?Build?a?header?for?each?file?and?send?the?file?contents
Private?Sub?ExportFile(sFilename,objOutStream,objInStream)
Dim?lStart,?lSum,?lTemp
lStart?=?objOutStream.Position?'?Record?where?we?are?up?to
If?IgnorePaths?Then
'?We?ignore?any?paths?prefixed?to?our?filenames
lTemp?=?InStrRev(sFilename,"\")
if?lTemp?<>?0?then
sFilename?=?Right(sFilename,Len(sFilename)?-?lTemp)
end?if
sFilename?=?BasePath?&?sFilename
End?If
'?Build?the?header,?everything?is?ASCII?in?octal?except?for?the?data
'objOutStream.charset="gb2312"
objOutStream.WriteText?Left(sFilename?&?String(100,Chr(0)),100)
'objOutStream.charset="x-ansi"
objOutStream.WriteText?"100"?&?Right("000"?&?Oct(Permissions),3)?&?"?"?&?Chr(0)?'File?mode
objOutStream.WriteText?Right(String(6,"?")?&?CStr(UserID),6)?&?"?"?&?Chr(0)?'uid
objOutStream.WriteText?Right(String(6,"?")?&?CStr(GroupID),6)?&?"?"?&?Chr(0)?'gid
objOutStream.WriteText?Right(String(11,"0")?&?Oct(objInStream.Size),11)?&?Chr(0)?'size
objOutStream.WriteText?Right(String(11,"0")?&?Oct(dateDiff("s","1/1/1970?10:00",now())),11)?&?Chr(0)?'mtime?(Number?of?seconds?since?10am?on?the?1st?January?1970?(10am?correct?)
objOutStream.WriteText?"?????????0"?&?String(100,Chr(0))?'chksum,?type?flag?and?link?name,?write?out?all?blanks?so?that?the?actual?checksum?will?get?calculated?correctly
objOutStream.WriteText?"ustar???"???&?Chr(0)?'magic?and?version
objOutStream.WriteText?Left(UserName?&?String(32,Chr(0)),32)?'uname
objOutStream.WriteText?Left(GroupName?&?String(32,Chr(0)),32)?'gname
objOutStream.WriteText?"??????????40?"?&?String(4,Chr(0))?'devmajor,?devminor
objOutStream.WriteText?String(167,Chr(0))?'prefix?and?leader
objInStream.CopyTo?objOutStream?'?Send?the?data?to?the?stream
if?(objInStream.Size?Mod?BlockSize)?>?0?then
objOutStream.WriteText?String(BlockSize?-?(objInStream.Size?Mod?BlockSize),Chr(0))?'Padding?to?the?nearest?block?byte?boundary
end?if
'?Calculate?the?checksum?for?the?header
lSum?=?0
objOutStream.Position?=?lStart
For?lTemp?=?1?To?BlockSize
lSum?=?lSum?+?(Asc(objOutStream.ReadText(1))?And?&HFF&)
Next
'?Insert?it
objOutStream.Position?=?lStart?+?148
objOutStream.WriteText?Right(String(7,"0")?&?Oct(lSum),7)?&?Chr(0)
'?Move?to?the?end?of?the?stream
objOutStream.Position?=?objOutStream.Size
End?Sub
'?Start?everything?off
Private?Sub?Class_Initialize()
Set?objFiles?=?Server.CreateObject("Scripting.Dictionary")
Set?objMemoryFiles?=?Server.CreateObject("Scripting.Dictionary")
BlockSize?=?512
Permissions?=?438?'?UNIX?666
UserID?=?0
UserName?=?"root"
GroupID?=?0
GroupName?=?"root"
IgnorePaths?=?False
BasePath?=?""
TarFilename?=?"new.tar"
End?Sub
Private?Sub?Class_Terminate()
Set?objMemoryFiles?=?Nothing
Set?objFiles?=?Nothing
End?Sub
End?Class
%>
