Zipar

hostrl · Novembro 14, 2008

Pessoal alguém sabe se é possivel Zipar Determiado Arquivo e tambêm Descompectar ele, via ASP?

vlw ah todos!

xanburzum · Novembro 14, 2008

você pode usar componentes para fazer isso, existem varios entre eles o Zip Component ,Polar ZIP ,Chilkat Zip Component ,Xceed Zip Compression ,Waspzip você tambem pode usar Zip ou GZip

ou usar essa classe:

<%
Class clsZip
	Private mbin_Zip
	Private mobj_Files()
	Private mlng_Files
	
	Sub ZipLoad(pstrFileName)
		Dim lobjFSO
		Dim llngTristateFalse
		Dim llngForReading
		Dim lobjFile
		
		llngTristateFalse = 0
		llngForReading = 1

		mbin_Zip = ""
		
		If pstrFileName = "" Then Exit Sub

		If InStr(1, pstrFileName, ":\") = 0 Then
			pstrFileName = Server.MapPath(pstrFileName)
		End If
		Set lobjFSO = Server.CreateObject("Scripting.FileSystemObject")

		If lobjFSO.FileExists(pstrFileName) Then

			Set lobjFile = lobjFSO.OpenTextFile(pstrFileName, llngForReading, False, llngTristateFalse)

			While Not lobjFile.AtEndOfStream
				mbin_Zip = mbin_Zip & ChrB(Asc(lobjFile.Read(1)))
			Wend
			lobjFile.Close
			Set lobjFile = Nothing
				
		End If
			
		Set lobjFSO = Nothing
			
		Call ParseZips()

	End Sub
	
	Public Property Let ZipData(ByRef pbinBinaryData)
		mbin_Zip = pbinBinaryData
		Call ParseZips()
	End Property
	Public Property Get FileCount()
		FileCount = mlng_Files
	End Property
	Public Property Get GetFile(ByRef plngIndex)
		Set GetFile = mobj_Files(plngIndex-1)
	End Property
'============================================================================
===============	
	Private Sub ParseZips()
		Dim llngOffSet
		mlng_Files = 0
		llngOffSet = 0
		
		If LenB(mbin_Zip) = 0 Then Exit Sub
		
		Do
			
			llngOffset = InStrB(llngOffset + 1, mbin_zip, ChrB(&h50) & ChrB(&h4B) & ChrB(&h03) & ChrB(&h04))
			If llngOffset = 0 Then Exit Do
			llngOffset = llngOffset - 1
			
			ReDim Preserve mobj_Files(mlng_Files)
		
			Set mobj_Files(mlng_Files) = New clsZipFile
			With mobj_Files(mlng_Files)
				.Signature = _
					GetString(llngOffset + 1, 2) & " " & _
					CInt(GetHex(llngOffset + 3, 1)) & "." & _
					GetHex(llngOffset + 4, 1)

				.ExtractVersion			= FormatNumber(GetNumber(llngOffset + 5, 2) * .1, 1, True)
				.GeneralPurposeFlags	= GetNumber(llngOffset + 7, 2)
				.CompressionMethod		= GetNumber(llngOffset + 9, 2)
				.LastModifiedTime		= GetNumber(llngOffset + 11, 2)
				.LastModifiedDate		= GetNumber(llngOffset + 13, 2)
				.CRC32					= GetNumber(llngOffset + 15, 4)
				.CompressedSize			= GetNumber(llngOffset + 19, 4)
				.UncompressedSize		= GetNumber(llngOffset + 23, 4)
				.FileNameLength			= GetNumber(llngOffset + 27, 2)
				.ExtraFieldLength		= GetNumber(llngOffset + 29, 2)
				.FileName				= GetString(llngOffset + 31, .FileNameLength)
				.ExtraField				= GetString(llngOffset + 31 + .FileNameLength, .ExtraFieldLength)
				.StartByte				= llngOffSet + 1
				.EndByte				= llngOffSET + .FileNameLength + .ExtraFieldLength + .CompressedSize + 30
'				.BinaryData				= MidB(pbin_Zip, llngOffSET + .FileNameLength + .ExtraFieldLength + 30, .CompressedSize)
'				.LocalFileHeader		= GetString(llngOffset + 1, .FileNameLength + .ExtraFieldLength + 30)
				llngOffSet = .EndByte
				.IsOverall = (.Name = "" And .Path = "")
				.IsFolder = (.Name = "" And Not .Path = "")
			End With
			mlng_Files = mlng_Files + 1

		Loop While mobj_Files(mlng_Files - 1).EndByte < LenB(mbin_zip)
		
	End Sub
	
	Private Function GetHex(plngStart, plngLength)
		Dim llngIndex
		Dim lstrHex
		For llngIndex = 0 To plngLength - 1
			lstrHex = lstrHex & Right("0" & Hex(AscB(MidB(mbin_zip, plngStart + llngIndex, 1))), 2)
		Next
		GetHex = lstrHex
	End Function
	Private Function GetString(plngStart, plngLength)
	
		Dim llngIndex
		Dim lstrString
		If LenB(mbin_zip) < (plngStart + (plngLength - 1)) Then Exit Function
		For llngIndex = 0 To plngLength - 1
			If AscB(MidB(mbin_zip, plngStart + llngIndex, 1)) = 0 Then
				'GetString = lstrString
				'Exit Function
				lstrString = lstrString & " "
			Else
				lstrString = lstrString & Chr(AscB(MidB(mbin_zip, plngStart + llngIndex, 1)))
			End If
		Next
		GetString = lstrString
	End Function
	Private Function GetNumber(plngStart, plngLength)
		If plngStart < 0 Then Exit Function
		Dim llngIndex
		Dim lstrHex
		For llngIndex = 0 To plngLength - 1
			lstrHex = Right("0" & Hex(AscB(MidB(mbin_zip, plngStart + llngIndex, 1))), 2) & lstrHex
		Next
		GetNumber = CDbl("&h" & lstrHex)
	End Function
	Function GetDate(plngStart)
		Dim llngDate
		llngDate = GetNumber(plngStart, 2)
		GetDate = DateSerial(1980 + (llngDate And &HFE00) \ &H200, (llngDate And &H1E0) \ &H20, llngDate And &H1F)
	End Function
	Function GetTime(plngStart)
		Dim llngDate
		llngDate = GetNumber(plngStart, 2)
		GetTime = TimeSerial((llngDate And &HF800) \ &H800, (llngDate And &H7E0) \ &H20, (llngDate And &H1F) * 2)
	End Function
'	TimeVal = Asc(Right$(OFS.FileTime, 1)) * 256& +_
'Asc(Left$(OFS.FileTime, 1))
'  S = (TimeVal And &H1F) * 2			  ' seg
'  N = (TimeVal And &H7E0) \ &H20		  ' Min
'  H = (TimeVal And &HF800) \ &H800		' Hs
''
'' Parse Date value
''
'  DateVal = Asc(Right$(OFS.FileDate, 1)) * 256& +
'Asc(Left$(OFS.FileDate, 1))
'  D = (DateVal& And &H1F)			 ' dia
'  M = (DateVal& And &H1E0) \ &H20	 ' mes
'  Y = (DateVal& And &HFE00) \ &H200   ' ano'
'
'  GetFileCreateDateTime = DateSerial(1980 + Y, M, D) + TimeSerial(H,_
'N, S)
'
'	End Function

End Class
Class clsZipFile
	Public Signature				' 4
	Public ExtractVersion			' 2
	Public GeneralPurposeFlags		' 2
	Public CompressionMethod		' 2
	Public LastModifiedTime			' 2
	Public LastModifiedDate			' 2
	Public CRC32					' 4
	Public CompressedSize			' 4
	Public UncompressedSize			' 4
	Public FileNameLength			' 2
	Public ExtraFieldLength			' 2
	Public FileName					' ver o nome do arquivo 
	Public ExtraField				' ver campo extra comprimento
	Public StartByte				' 4
	Public EndByte					' 4
	Public BinaryData				'  CompressedSize
	Public LocalFileHeader
	
	Public IsFolder
	Public IsOverall
	
	Public Property Get Name
		Dim lstrPath
		lstrPath = Replace(FileName, "/", "\")
		If InStr(1, lstrPath, "\") = "0" Then
			Name = lstrPath
			Exit Property
		End If
		Name = Mid(lstrPath, InStrRev(lstrPath, "\") + 1)
	End Property
	Public Property Get Path
		Dim lstrPath
		lstrPath = Replace(FileName, "/", "\")
		If InStr(1, lstrPath, "\") = "0" Then
			Path = ""
			Exit Property
		End If
		Path = Mid(lstrPath, 1, InStrRev(lstrPath, "\"))
	End Property
	Public Property Get Packed
		Packed = CompressedSize
	End Property
	Public Property Get Ratio
		If UncompressedSize = 0 Then Exit Property
		If CompressedSize >= UncompressedSize Then
			Ratio = "0%"
		Else
			Ratio = FormatNumber(((1 - (CompressedSize / UncompressedSize)) * 100), 0, True, False, True) & "%"
		End If
	End Property
	Public Property Get Modified()
		Modified = CDate(GetDate(LastModifiedDate) & " " & GetTime(LastModifiedTime))
	End Property
	Private Function GetDate(plngDate)
		GetDate = DateSerial(1980 + (plngDate And &HFE00) \ &H200, _
			(plngDate And &H1E0) \ &H20, plngDate And &H1F)
	End Function
	Private Function GetTime(plngDate)
		GetTime = TimeSerial((plngDate And &HF800) \ &H800, _
			(plngDate And &H7E0) \ &H20, _
			(plngDate And &H1F) * 2)
	End Function
	Public Property Get Size()
		Size = UncompressedSize
	End Property
	Public Property Get BitMask()
		Dim llngNumber
		Dim lstrBits
		llngNumber = GeneralPurposeFlags
		Do
			If llngNumber Mod 2 = 1 Then lstrBits = "1" & lstrBits Else lstrBits = "0" & lstrBits
			llngNumber = llngNumber \ 2
		Loop Until llngNumber = 0
		lstrBits = Right("0000000000000000" & lstrBits, 16)
		For llngNumber = 0 To 3
			lstrReturn = lstrReturn & Mid(lstrBits, (llngNumber * 4) + 1, 4) & "."
		Next
		BitMask = Left(lstrReturn, 19)
	End Property
	Property Get CompressionMethodString()
		Select Case CompressionMethod
			Case 0
				CompressionMethodString = "O arquivo está armazenado (sem compressão)"
			Case 1
				CompressionMethodString = "O arquivo é Shrunk"
			Case 2
				CompressionMethodString = "O arquivo é reduzido com compressão fator 1"
			Case 3
				CompressionMethodString = "O arquivo é reduzido com compressão fator 2"
			Case 4
				CompressionMethodString = "O arquivo é reduzido com compressão fator 3"
			Case 5
				CompressionMethodString = "TO arquivo é reduzido com compressão fator 4"
			Case 6
				CompressionMethodString = "O arquivo implodiu"
			Case 7
				CompressionMethodString = "Reservado para Tokenizing compressão algoritmo"
			Case 8
				CompressionMethodString = "O arquivo é deflacionado"
			Case 9
				CompressionMethodString = "Reservado para o aumento da deflação"
			Case 10
				CompressionMethodString = "PKWARE Data de compressão biblioteca Imploding"
			Case Else
				CompressionMethodString = "Tipo de compressão pUnhandled: " & CompressionMethod
		End Select
	End Property
End Class
%>

exemplo:

<!--#INCLUDE FILE="clsZip.asp"-->
<%
FileName = Request.QueryString("File")
If FileName = "" Then FileName = "Bottom Tabs.zip"
%>
<FORM id=form1 name=form1>
	Zip File: <INPUT name="File" value="<%=Server.HTMLEncode(FileName)%>">
	<INPUT type="Submit" value="View" id=Submit1 name=Submit1>
</FORM>
<%
Dim FileName
Dim zip


set zip = new clszip
zip.ZipLoad(filename)
Dim nn
Set ZipFile = New clsZipFile
Response.Write "<TABLE width=""100%"">"
Response.Write "<TR bgcolor=""#cccccc"">"
Response.Write "<TD>Nome</TD>"
Response.Write "<TD>Modificado</TD>"
Response.Write "<TD>Tamanho</TD>"
Response.Write "<TD>Ratio</TD>"
Response.Write "<TD>Packed</TD>"
Response.Write "<TD>Path</TD>"
Response.Write "</TR>"
For nn = 1 To zip.FileCount
	Set ZipFile = zip.GetFile(nn)
	With ZipFile
		If Not (.IsFolder Or .IsOverall) Then
			Response.Write "<TR>"
			Response.Write "<TD>" & .Name & "</TD>"
			Response.Write "<TD>" & .Modified & "</TD>"
			Response.Write "<TD>" & .Size & "</TD>"
			Response.Write "<TD>" & .Ratio & "</TD>"
			Response.Write "<TD>" & .Packed & "</TD>"
			Response.Write "<TD>" & .Path & "</TD>"
			Response.Write "</TR>"
		End If
	End With
Next
Response.Write "</TABLE>"
set zip = nothing
%>

xanburzum · Novembro 15, 2008

Usando o Xceed Zip

<%@ Language=VBScript %>

<%
' Xceed Zip.
' Chama-se pela página da web frmSelect.htm arquivo.
' Download do componente  : 
' http://www.xceedsoft.com/download/ZipCompL/index.htm
' Download da aplicatção :
' http://www.xceedsoft.com/cs/result.asp?id=111

Dim xZip   ' Irá representar uma instância do objeto Xceed Zip
Dim ResultCode  ' Resultado do método de Zip 
Dim sFilesChosen ' string HTML 
Dim sRandom   'string Número aleatório 
Dim sFilename  ' arq. de auto-extração zip para criar no servidor
Dim sDownloadURL ' O URL onde o navegador irá fazer o download do arquivo zip 

Dim Introtext  ' introdução do diálogo do texto para self-extracting zip 


' Mudar estas constantes abaixo para sua própria, e fazer 
'com que os arquivos File1.txt, File2.txt e File3.txt sejam colocados 
'na pasta PATH_FOR_SOURCE_FILES . O xcdsfx32.bin 
' o arquivo binário Auto-extrator  também devem ser colocadas nesta pasta.

Const PATH_FOR_SOURCE_FILES = "D:\InetPub\testwebsite\Send\"
Const PATH_FOR_ZIP_FILE = "D:\InetPub\testwebsite\Send\Zipfiles\"
Const DOWNLOAD_URL = "http://servername/Send/Zipfiles/"

'Instanciar o objeto Xceed Zip 

Set xZip = Server.CreateObject("XceedSoftware.XceedZip.4")

'Se você estiver usando a versão de avaliação gratuita Xceed Zip, você 
'Precisa executar o Xceed Zip versão avaliação do programa setup 
'no servidor, caso contrário, ele irá dizer que não é licenciada. 

"Se é um utilizador registado, descomentar a linha a seguir 
'E substituir o texto entre aspas com a sua chave de licença.
 
' xZip.License("Sua chave de licença vai aqui")
 

 
sFilename = PATH_FOR_ZIP_FILE & Request.ServerVariables("REMOTE_HOST") & ".exe"
  
xZip.ZipFilename = sFilename

' Agora Xceed Zip permite definir as opções para personalizar o arquivo Zip auto-extraíveis
 
sFilesChosen = ""  
 
if uCase(Request("chkFile1")) = "ON" then
 sFilesChosen = "File1.txt<BR>"
 xZip.AddFilesToProcess (PATH_FOR_SOURCE_FILES & "File1.txt")
end if
 
if uCase(Request("chkFile2")) = "ON" then
 sFilesChosen = sFilesChosen & "File2.txt<BR>"
 xZip.AddFilesToProcess (PATH_FOR_SOURCE_FILES & "File2.txt")
end if

if uCase(Request("chkFile3")) = "ON" then
 sFilesChosen = sFilesChosen & "File3.txt<BR>"
 xZip.AddFilesToProcess (PATH_FOR_SOURCE_FILES & "File3.txt")
end if
 
xZip.UseTempFile = False   'Não há necessidade de um arquivo temporário para esta aplicação

xZip.PreservePaths = False   'Não guarde os caminhos onde estão os arquivos fontes de

xZip.SfxBinaryModule = PATH_FOR_SOURCE_FILES & "xcdsfx32.bin"

Introtext = " Esta self-extracting contém arquivo zip selecionado"
Introtext = Introtext + "para fazer o download. Os arquivos são protegidas por senha, assim você"
Introtext = Introtext + "terá de introduzir uma senha. Clique em 'OK' para continuar.."

xZip.SfxMessages(xsmIntro) = Introtext

xZip.SfxStrings(xssTitle) = "Custom zip file for " + Trim(Request("txtIntro")) ' Use o nome inscrito na página da web
xZip.SfxDefaultUnzipToFolder = Trim(Request("txtUnzipFolder")) 

xZip.EncryptionPassword = Trim(Request("txtPassword")) 'A password entrou na página da web

'Agora, execute o comando para criar a auto-extracção zip

ResultCode = xZip.Zip  
 
If ResultCode = 0 then
 sDownloadPath =  DOWNLOAD_URL & Request.ServerVariables("REMOTE_HOST") & ".exe"
 Response.ContentType = "application/x-gzip"
 Response.Redirect (sDownloadPath)
else

%>

<HTML>
<HEAD>
<TITLE>
'criação erro.
</TITLE>
</HEAD>

<BODY>
<STRONG>
Você selecionou para fazer o download dos seguintes arquivos:
<P>
</STRONG>
<BR>
<%
 Response.Write(sFilesChosen)
%>
Mas o seguinte erro de Xceed Zip foi devolvido: <P>
<%  
 Response.Write(xZip.GetErrorDescription(xvtError ,ResultCode))
%></P> 

</BODY>
</HTML>
<%
end if 

set xZip = Nothing
%>

</BODY>

</HTML>

Entrar

Arquivado

Zipar

Recommended Posts

hostrl 0

Compartilhar este post

Link para o post

Compartilhar em outros sites

xanburzum 169

Compartilhar este post

Link para o post

Compartilhar em outros sites

xanburzum 169

Compartilhar este post

Link para o post

Compartilhar em outros sites

Conexão mysql com outro domínio

[Resolvido] JavaScript - Exibir logo dentro da Tabela html

Javascript - Calcular Valores Monetário em Tempo Real

Este projeto é apoiado pelas empresas

Fóruns

Tempo Real

Informação importante