不用WinRar仅有asp将网络空间上的文件打包下载

发布时间：2023-05-26 13:46:29 所属栏目：Asp教程来源：

导读：非常不错的asp代码，此方法，不建议压缩，大文件，一般的小文件压几个还很好用的

<%@ Language=VBScript %>

<% Option Explicit %>



<%

Response.Buffer = Tru

非常不错的asp代码，此方法，不建议压缩，大文件，一般的小文件压几个还很好用的

<%@ Language=VBScript %>

<% Option Explicit %>



<%

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

%>

（编辑：聊城站长网）

【声明】本站内容均来自网络，其相关言论仅代表作者个人观点，不代表本站立场。若无意侵犯到您的权利，请及时与联系站长删除相关内容!