Compressão de arquivos

[dataset 0]

Olá pessoal...

 

Eu to usando um sistema de compressão de arquivos, porém ele não compacta as sub-pastas, somente os arquivos.

Por acaso alguém tem um modelo ou exemplo para compactar arquivos e pastas/sub-pastas sem usar componentes ?

 

Agradecido.

[dataset 0]

Ainda estou na busca de uma solução para compacatar os arquivos e pastas/subpastas... se alguém puder me ajudar ficarei agradecido.

 

Valeu.

[jrcardozo 4]

sem usar componentes acho mais dificil, não encontrei nada nativo até hoje. Na web tem componentes, mas como citaste que era sim então não adianta

[dataset 0]

Bom .... aí vai o código que compacta sem componentes, a desvantagem, é que esse codigo não compacta as subpastas. Ja tentei implementar mas não deu certo. Fica o desafio para quem quizer... Depois dele pronto... é uma mão na roda.

 

OBS: Esse é o código original.

 

<%@ Language=VBScript %>
<!--#include file="asptar.asp"-->
<%

Set FSO = Server.CreateObject("Scripting.FileSystemObject")
Set PASTA = FSO.GetFolder(server.mapPath("../pasta/"))
Set Arquivos = Pasta.Files


Dim objTar

Set objTar = New Tarball

FOR EACH arquivo IN arquivos 
	objTar.AddFile arquivo
NEXT

objTar.WriteTar
%>

 

O include 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
	
	' Storage for file information
	Private objFiles
	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
			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
%>

Valeu...