- <%@ Language=VBScript %>
- <% Option Explicit %>
- <!--#include file="asptar.asp"-->
- <%
- Response.Buffer = True
- Response.Clear
- Dim Co,Temp,T,x,i,fsoBrowse,theFolder,TheSubFolders,FilePath,s,PH,objTar
- Co=0
- PH="./UpFile" '文件路径 '压缩Upfile下的所有文件
- Set objTar = New Tarball
- objTar.TarFilename="LvBBS_UpdateFile.rar" '打包的名称
- objTar.Path=PH
- set fsoBrowse=CreateObject("Scripting.FileSystemObject")
- Set theFolder=fsoBrowse.GetFolder(Server.Mappath(PH))
- Set theSubFolders=theFolder.SubFolders
- For Each T in theFolder.Files
- Temp= Temp & T.Name & "|"
- Co=Co+1
- Next
- For Each x In theSubFolders
- For Each i In X.Files
- Temp= Temp & X.Name&"/"&i.Name&"|"
- Co=Co+1
- Next
- Next
- If Co<1 Then
- Response.Write "暂时没有可更新的文件下载"
- '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
- %>
- asptar.asp
- <%
- ' UNIX Tarball creator
- ' ====================
- ' Author: Chris Read
- ' Version: 1.0.1
- ' ====================
- '
- ' This class provides the ability to archive multiple files together into a single
- ' distributable file called a tarball (The TAR actually stands for Tape ARchive).
- ' These are common UNIX files which contain uncompressed data.
- '
- ' So what is this useful for? Well, it allows you to effectively combine multiple
- ' files into a single file for downloading. The TAR files are readable and extractable
- ' by a wide variety of tools, including the very widely distributed WinZip.
- '
- ' This script can include two types of data in each archive, file data read from a disk,
- ' and also things direct from memory, like from a string. The archives support files in
- ' a binary structure, so you can store executable files if you need to, or just store
- ' text.
- '
- ' This class was developed to assist me with a few projects and has grown with every
- ' implementation. Currently I use this class to tarball XML data for archival purposes
- ' which allows me to grab 100's of dynamically created XML files in a single download.
- '
- ' There are a small number of properties and methods, which are outlined in the
- ' accompanying documentation.
- '
- 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
- ' Send the tarball to the browser
- 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"
- ' Go through all files stored on disk first
- aFiles = objFiles.Items
- For lTemp = 0 to UBound(aFiles)
- objInStream.Open
- objInStream.LoadFromFile aFiles(lTemp)
- objInStream.Position = 0
- 'ExportFile aFiles(lTemp),objStream,objInStream
- TmpFileName =replace(aFiles(lTemp),Server.Mappath(Path)&"\","")
- ExportFile TmpFileName,objStream,objInStream
- objInStream.Close
- Next
- ' Now add stuff from memory
- 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))
- ' Rewind the stream
- ' Remember to change the type back to binary, otherwise the write will truncate
- ' past the first zero byte character.
- objStream.Position = 0
- objStream.Type = 1
- ' Set all the browser stuff
- Response.AddHeader "Content-Disposition","filename=" & TarFilename
- Response.ContentType = "application/x-tar"
- Response.BinaryWrite objStream.Read
- ' Close it and go home
- 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.WriteText Left(sFilename & String(100,Chr(0)),100)
- 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
- %>
不用WinRar只有asp将网络空间上的文件打包下载
2019-09-23 10:08asp教程网 ASP教程
非常不错的asp代码,此方法,不建议压缩,大文件,一般的小文件压几个还很好用的
延伸 · 阅读
- 2021-03-05js实现的类似于asp数据字典的数据类型代码实例
- 2021-01-10asp字符串连接符&、多个字符串相加、字符串拼
- 2020-12-26曾经压缩一哥突然出新版,WinRAR 6.0 有何妙用
- 2020-12-18asp和php哪个是主流?用ASP和PHP做网站哪个好?
- 2020-12-15JAVA 根据Url把多文件打包成ZIP下载实例
- 2020-11-17OA办公系统网站源码(ASP开发)
精彩推荐
- ASP教程
动网论坛验证码改进 加法验证码(ASPJpeg版)
很多站长都为论坛里太多的垃圾广告抓狂,本程序就是为了对付论坛垃圾广告群发器的。 将验证码改为加法运算,比如验证码显示“25+64等于?”,那么输...
- ASP教程
FSO遍历目录实现全站插马的代码
FSO遍历目录实现全站插马的代码...
- ASP教程
asp代码实现检测组件是否安装的函数
asp代码实现检测组件是否安装的函数...
- ASP教程
asp知识整理笔记4(问答模式)
继前几篇篇《asp知识整理笔记1》和《asp知识整理笔记2》,《asp知识整理笔记3》新鲜出炉: 23、问题:在ASP文件中读取HTML的表单字段有几种方法? 答:R...
- ASP教程
Discuz!NT 论坛整合ASP程序论坛教程
Discuz!NT 论坛整合ASP程序论坛 实现代码。...
- ASP教程
asp生成静态HTML(动态读取)
这样的代码多用于我们没有实现设计生成静态的功能,但又想临时将一些动态页面生成静态的,直接获取动态内容并保存为静态的...
- ASP教程
javascript asp教程第五课--合二为一
两条防线,一个函数: 试问你如何能保证客户端和服务器端具有相同的功能?表单域的验证闪现在我们眼前。别人把你的html复制到另外一个脚本,然后改...
- ASP教程
asp 判断上传文件中是否存在危险代码
asp 判断上传文件中是否存在危险代码...