Imports ComponentAce.Compression.ZipForge Imports ComponentAce.Compression.Archiver Imports System.Windows.Forms Imports System.IO Public Class zip Private Shared WithEvents Zip As ZipForge Private Shared pbProgreso As ProgressBar Public Shared Sub ExtraeDeZip(ByVal FicheroZip As Byte(), ByVal FicheroAExtraer As String, ByVal FicheroDestino As String) ' ---------------------------------------------------------------------------------------------------- ' Descripción Sub: Extrae de un archivo zip un único archivo en la ruta indicada. ' Fecha. Creacion: ? ' Creada por: manmog ' Ultima Modificacion: 14/05/2008 ' ' Modificaciones: ' =============== ' 14/05/2008 DANMUN Adaptación de C1Zip a ZipForge.Net. ' 23/11/2011 manmog Adaptación de C1Zip a ZipForge.Net. ' ---------------------------------------------------------------------------------------------------- Dim sDirTmp As String = ObtieneDirectorioAleatorio() Dim ms As New IO.MemoryStream(FicheroZip) Dim zf As New ZipForge zf.OpenArchive(ms, False) zf.BaseDir = sDirTmp 'Voy a descomprimir en Temp y luego lo muevo al lugar que corresponda. zf.ExtractFiles(FicheroAExtraer) If System.IO.Directory.Exists(FicheroDestino) = True Then 'Si existe "FicheroDestino" como directorio tengo que extraer el fichero dentro de ese directorio. FicheroDestino = FicheroDestino & "\" & System.IO.Path.GetFileName(FicheroAExtraer) End If If My.Computer.FileSystem.FileExists(FicheroDestino) = True Then 'Si ya existía un fichero con ese nombre, se borra. Es como si lo sobreescribiera. My.Computer.FileSystem.DeleteFile(FicheroDestino) End If My.Computer.FileSystem.MoveFile(sDirTmp & "\" & System.IO.Path.GetFileName(FicheroAExtraer), FicheroDestino) zf.CloseArchive() End Sub Public Shared Function ExtraeDeZip(ByVal FicheroZip As Stream, ByVal FicheroAExtraer As String) As Byte() ' ---------------------------------------------------------------------------------------------------- ' Descripción Sub: Extrae de un archivo zip un único archivo en la ruta indicada. ' Fecha. Creacion: ? ' Creada por: manmog ' Ultima Modificacion: 14/05/2008 ' ' Modificaciones: ' =============== ' 14/05/2008 DANMUN Adaptación de C1Zip a ZipForge.Net. ' 23/11/2011 manmog Adaptación de C1Zip a ZipForge.Net. ' ---------------------------------------------------------------------------------------------------- Dim sDirTmp As String = ObtieneDirectorioAleatorio() Dim zf As New ZipForge ' zf.Zip64Mode = ComponentAce.Compression.Archiver.Zip64Mode.Disabled zf.OpenArchive(FicheroZip, False) zf.BaseDir = sDirTmp 'Voy a descomprimir en Temp y luego lo muevo al lugar que corresponda. Dim b As Byte() = Nothing zf.ExtractFiles(FicheroAExtraer) zf.ExtractToBuffer(FicheroAExtraer, b) zf.CloseArchive() Return b End Function Public Shared Function ExtraeDeZip(ByVal FicheroZip As Byte(), ByVal FicheroAExtraer As String) As Byte() ' ---------------------------------------------------------------------------------------------------- ' Descripción Sub: Extrae de un archivo zip un único archivo en la ruta indicada. ' Fecha. Creacion: ? ' Creada por: manmog ' Ultima Modificacion: 14/05/2008 ' ' Modificaciones: ' =============== ' 14/05/2008 DANMUN Adaptación de C1Zip a ZipForge.Net. ' 23/11/2011 manmog Adaptación de C1Zip a ZipForge.Net. ' ---------------------------------------------------------------------------------------------------- Dim sDirTmp As String = ObtieneDirectorioAleatorio() Dim ms As New IO.MemoryStream(FicheroZip) Dim zf As New ZipForge zf.OpenArchive(ms, False) zf.BaseDir = sDirTmp 'Voy a descomprimir en Temp y luego lo muevo al lugar que corresponda. Dim b As Byte() = Nothing zf.ExtractToBuffer(FicheroAExtraer, b) zf.CloseArchive() Return b End Function Public Shared Sub ExtraeDeZip(ByVal FicheroZip As String, ByVal FicheroAExtraer As String, ByVal FicheroDestino As String) ' ---------------------------------------------------------------------------------------------------- ' Descripción Sub: Extrae de un archivo zip un único archivo en la ruta indicada. ' Fecha. Creacion: ? ' Creada por: manmog ' Ultima Modificacion: 14/05/2008 ' ' Modificaciones: ' =============== ' 14/05/2008 DANMUN Adaptación de C1Zip a ZipForge.Net. ' 23/11/2011 manmog Adaptación de C1Zip a ZipForge.Net. ' ---------------------------------------------------------------------------------------------------- Dim sDirTmp As String = ObtieneDirectorioAleatorio() Dim zf As New ZipForge zf.FileName = FicheroZip zf.OpenArchive() zf.BaseDir = sDirTmp 'Voy a descomprimir en Temp y luego lo muevo al lugar que corresponda. zf.ExtractFiles(FicheroAExtraer) If System.IO.Directory.Exists(FicheroDestino) = True Then 'Si existe "FicheroDestino" como directorio tengo que extraer el fichero dentro de ese directorio. FicheroDestino = FicheroDestino & "\" & System.IO.Path.GetFileName(FicheroAExtraer) End If If My.Computer.FileSystem.FileExists(FicheroDestino) = True Then 'Si ya existía un fichero con ese nombre, se borra. Es como si lo sobreescribiera. My.Computer.FileSystem.DeleteFile(FicheroDestino) End If My.Computer.FileSystem.MoveFile(sDirTmp & "\" & System.IO.Path.GetFileName(FicheroAExtraer), FicheroDestino) zf.CloseArchive() End Sub Public Shared Sub ExtraeDeZip(ByVal FicheroZip As String, ByVal FicheroAExtraer As String, ByVal FicheroDestino As String, ByVal Progreso As ProgressBar) ' ---------------------------------------------------------------------------------------------------- ' Descripción Sub: Extrae de un archivo zip un único archivo en la ruta indicada. ' Fecha. Creacion: ? ' Creada por: manmog ' Ultima Modificacion: 14/05/2008 ' ' Modificaciones: ' =============== ' 14/05/2008 DANMUN Adaptación de C1Zip a ZipForge.Net. ' 23/11/2011 manmog Adaptación de C1Zip a ZipForge.Net. ' ---------------------------------------------------------------------------------------------------- pbProgreso = Progreso Dim sDirTmp As String = ObtieneDirectorioAleatorio() Zip = New ZipForge Zip.FileName = FicheroZip Zip.OpenArchive() Zip.BaseDir = sDirTmp 'Voy a descomprimir en Temp y luego lo muevo al lugar que corresponda. Zip.ExtractFiles(FicheroAExtraer) If System.IO.Directory.Exists(FicheroDestino) = True Then 'Si existe "FicheroDestino" como directorio tengo que extraer el fichero dentro de ese directorio. FicheroDestino = FicheroDestino & "\" & System.IO.Path.GetFileName(FicheroAExtraer) End If If My.Computer.FileSystem.FileExists(FicheroDestino) = True Then 'Si ya existía un fichero con ese nombre, se borra. Es como si lo sobreescribiera. My.Computer.FileSystem.DeleteFile(FicheroDestino) End If My.Computer.FileSystem.MoveFile(sDirTmp & "\" & System.IO.Path.GetFileName(FicheroAExtraer), FicheroDestino) Zip.CloseArchive() Zip.Dispose() End Sub Public Shared Sub ExtraeDeZip(ByVal FicheroZip As String, ByVal FicheroAExtraer As String, ByVal FicheroDestino As String, Optional ByVal DelegadoProgreso As ZipForge.OnOverallProgressDelegate = Nothing) ' ---------------------------------------------------------------------------------------------------- ' Descripción Sub: Extrae de un archivo zip un único archivo en la ruta indicada. ' Fecha. Creacion: ? ' Creada por: manmog ' Ultima Modificacion: 14/05/2008 ' ' Modificaciones: ' =============== ' 14/05/2008 DANMUN Adaptación de C1Zip a ZipForge.Net. ' 23/11/2011 manmog Adaptación de C1Zip a ZipForge.Net. ' ---------------------------------------------------------------------------------------------------- Dim sDirTmp As String = ObtieneDirectorioAleatorio() Zip = New ZipForge If Not DelegadoProgreso Is Nothing Then AddHandler Zip.OnOverallProgress, DelegadoProgreso End If Zip.FileName = FicheroZip Zip.OpenArchive() Zip.BaseDir = sDirTmp 'Voy a descomprimir en Temp y luego lo muevo al lugar que corresponda. Zip.ExtractFiles(FicheroAExtraer) If System.IO.Directory.Exists(FicheroDestino) = True Then 'Si existe "FicheroDestino" como directorio tengo que extraer el fichero dentro de ese directorio. FicheroDestino = FicheroDestino & "\" & System.IO.Path.GetFileName(FicheroAExtraer) End If If My.Computer.FileSystem.FileExists(FicheroDestino) = True Then 'Si ya existía un fichero con ese nombre, se borra. Es como si lo sobreescribiera. My.Computer.FileSystem.DeleteFile(FicheroDestino) End If My.Computer.FileSystem.MoveFile(sDirTmp & "\" & System.IO.Path.GetFileName(FicheroAExtraer), FicheroDestino) Zip.CloseArchive() Zip.Dispose() End Sub Public Shared Sub AñadeAZip(ByVal FicheroZip As String, ByVal FicheroAAñadir As String, ByVal NombreFicheroDestino As String, ByVal Progreso As ProgressBar) ' ---------------------------------------------------------------------------------------------------- ' Descripción Sub: Añade a un archivo zip un único archivo ' Fecha. Creacion: ? ' Creada por: manmog ' Ultima Modificacion: 14/05/2008 ' ' Modificaciones: ' =============== ' 14/05/2008 DANMUN Adaptación de C1Zip a ZipForge.Net. ' ---------------------------------------------------------------------------------------------------- pbProgreso = Progreso Zip = New ZipForge Zip.FileName = FicheroZip If Not IO.File.Exists(FicheroZip) Then Zip.OpenArchive(System.IO.FileMode.Create) Else Zip.OpenArchive() End If Zip.DeleteFiles(NombreFicheroDestino) Dim ai As New ComponentAce.Compression.Archiver.ArchiveItem(FicheroAAñadir) ai.FileName = NombreFicheroDestino Zip.BaseDir = IO.Path.GetDirectoryName(FicheroAAñadir) Zip.AddItem(ai) Zip.CloseArchive() Zip.Dispose() End Sub ''' ''' Recibe varios byte array en un diccionario, los comprime en un archivo y lo devuelve. ''' ''' Un diccionario cuya clave es el nombre del archivo y el valor un array de bytes. ''' ''' Public Shared Function ComprimirArchivos(ByVal archivos As Dictionary(Of String, Byte())) As Byte() ' ---------------------------------------------------------------------------------------------------- ' Creada por: danmun ' Fecha de creación: 31/01/2014 ' ' ---------------------------------------------------------------------------------------------------- Dim rutaArchivo As String = IO.Path.GetTempFileName Dim zip As New ZipForge() zip.Zip64Mode = ComponentAce.Compression.Archiver.Zip64Mode.Disabled zip.FileName = rutaArchivo zip.OpenArchive(IO.FileMode.Create) For Each archivo In archivos zip.AddFromBuffer(archivo.Key, archivo.Value, archivo.Value.Length) Next zip.CloseArchive() zip.Dispose() Dim resultado As Byte() = IO.File.ReadAllBytes(rutaArchivo) Try IO.File.Delete(rutaArchivo) Catch ex As Exception ' Por precaución lo pongo en un try y no hago nada en ese try, ' es decir, que si no se borra, ahí lo dejo, de momento. ' Cuando lo pruebe realizaré modificaciones. End Try Return resultado End Function ''' ''' Recibe varios Stream en un diccionario, los comprime en un archivo y lo devuelve. ''' ''' Un diccionario cuya clave es el nombre del archivo y el valor un array de bytes. ''' ''' Public Shared Function ComprimirArchivos(ByVal archivos As Dictionary(Of String, IO.Stream)) As Byte() ' ---------------------------------------------------------------------------------------------------- ' Creada por: danmun ' Fecha de creación: 31/01/2014 ' ' ---------------------------------------------------------------------------------------------------- Dim rutaArchivo As String = IO.Path.GetTempFileName Dim zip As New ZipForge() zip.Zip64Mode = ComponentAce.Compression.Archiver.Zip64Mode.Disabled zip.FileName = rutaArchivo zip.OpenArchive(IO.FileMode.Create) For Each archivo In archivos zip.AddFromStream(archivo.Key, archivo.Value, archivo.Value.Length) Next zip.CloseArchive() zip.Dispose() Dim resultado As Byte() = IO.File.ReadAllBytes(rutaArchivo) Try IO.File.Delete(rutaArchivo) Catch ex As Exception ' Por precaución lo pongo en un try y no hago nada en ese try, ' es decir, que si no se borra, ahí lo dejo, de momento. ' Cuando lo pruebe realizaré modificaciones. End Try Return resultado End Function Public Shared Sub AñadeAZip(ByVal FicheroZip As String, ByVal FicheroAAñadir As String, ByVal NombreFicheroDestino As String, Optional ByVal DelegadoProgreso As ZipForge.OnOverallProgressDelegate = Nothing) ' ---------------------------------------------------------------------------------------------------- ' Descripción Sub: Añade a un archivo zip un único archivo ' Fecha. Creacion: ? ' Creada por: manmog ' Ultima Modificacion: 14/05/2008 ' ' Modificaciones: ' =============== ' 25/07/2014 MANMOG En caso de que no exista el fichero zip se crea ' 06/05/2012 MANMOG En caso de que no exista el fichero zip se lanza una excepción ' 06/05/2012 MANMOG Se añade más información en caso de excepción ' 14/05/2008 DANMUN Adaptación de C1Zip a ZipForge.Net. ' ---------------------------------------------------------------------------------------------------- Try ' If Not IO.File.Exists(FicheroZip) Then Throw New Exception("No existe el fichero " & FicheroZip) Dim zf As New ZipForge If Not DelegadoProgreso Is Nothing Then AddHandler zf.OnOverallProgress, DelegadoProgreso End If zf.FileName = FicheroZip If Not IO.File.Exists(FicheroZip) Then zf.OpenArchive(System.IO.FileMode.Create) Else zf.OpenArchive() End If zf.DeleteFiles(NombreFicheroDestino) Dim ai As New ComponentAce.Compression.Archiver.ArchiveItem(FicheroAAñadir) ai.FileName = NombreFicheroDestino zf.BaseDir = IO.Path.GetDirectoryName(FicheroAAñadir) zf.AddItem(ai) zf.CloseArchive() zf.Dispose() Catch ex As Exception Throw New Exception("Error Añadiendo fichero a zip. FicheroZIP: " & FicheroZip & " Fichero a Añadir: " & FicheroAAñadir & " Fichero Destino: " & NombreFicheroDestino & vbCrLf & ex.Message, ex) End Try End Sub Private Shared Sub Zip_OnOverallProgress(ByVal sender As Object, ByVal progress As Double, ByVal timeElapsed As System.TimeSpan, ByVal timeLeft As System.TimeSpan, ByVal operation As ProcessOperation, ByVal progressPhase As ProgressPhase, ByRef cancel As Boolean) Handles Zip.OnOverallProgress ' ---------------------------------------------------------------------------------------------------- ' Descripción Sub: Actualiza la barra de progreso de descompresión de un archivo zip. ' Fecha. Creacion: ? ' Creada por: manmog ' Ultima Modificacion: 14/05/2008 ' ' Modificaciones: ' =============== ' 14/05/2008 DANMUN Adaptación de C1Zip a ZipForge.Net. (COMPROBADO) ' ---------------------------------------------------------------------------------------------------- Try If Not IsNothing(pbProgreso) Then pbProgreso.Maximum = 100 pbProgreso.Value = progress System.Windows.Forms.Application.DoEvents() End If Catch EX As Exception End Try End Sub Public Shared Sub ComprimeDirectorio(ByVal Directorio As String, ByVal FicheroZIP As String, ByVal ZIP64 As Boolean) Dim zFichero As New ComponentAce.Compression.ZipForge.ZipForge zFichero.FileName = FicheroZIP If ZIP64 Then zFichero.Zip64Mode = ComponentAce.Compression.Archiver.Zip64Mode.Always Else zFichero.Zip64Mode = ComponentAce.Compression.Archiver.Zip64Mode.Disabled End If zFichero.OpenArchive(IO.FileMode.Create) zFichero.BaseDir = Directorio Dim iNumeroArchivosTotal As Integer Dim sFichero As String, sFicheros() As String = Nothing ObtieneFicherosRecursivo(Directorio, sFicheros) iNumeroArchivosTotal = sFicheros.Length Dim i As Long = 0 For Each sFichero In sFicheros i += 1 If sFichero <> FicheroZIP Then zFichero.AddFiles(sFichero) Next zFichero.CloseArchive() End Sub Shared Sub ExtraeTodoDeZip(FicheroZIP As String, RutaDestino As String, Optional EliminaDirectorioDestino As Boolean = False) Dim Zip As New ComponentAce.Compression.ZipForge.ZipForge If EliminaDirectorioDestino Then If IO.Directory.Exists(RutaDestino) Then IO.Directory.Delete(RutaDestino, True) End If If Not IO.Directory.Exists(RutaDestino) Then IO.Directory.CreateDirectory(RutaDestino) Zip.FileName = FicheroZIP Zip.OpenArchive() Zip.BaseDir = RutaDestino Zip.ExtractFiles("*") Zip.CloseArchive() End Sub Shared Sub ExtraeTodoDeZip(FicheroZIP As IO.MemoryStream, RutaDestino As String, Optional EliminaDirectorioDestino As Boolean = False) Dim Zip As New ComponentAce.Compression.ZipForge.ZipForge() If EliminaDirectorioDestino Then If IO.Directory.Exists(RutaDestino) Then IO.Directory.Delete(RutaDestino, True) End If If Not IO.Directory.Exists(RutaDestino) Then IO.Directory.CreateDirectory(RutaDestino) Zip.OpenArchive(FicheroZIP, False) Zip.BaseDir = RutaDestino Zip.ExtractFiles("*") Zip.CloseArchive() End Sub Public Shared Function ObtieneDirectorioAleatorio() As String Dim sDir As String = System.IO.Path.GetTempPath & System.IO.Path.GetRandomFileName Do While IO.Directory.Exists(sDir) sDir = System.IO.Path.GetTempPath & "\" & System.IO.Path.GetRandomFileName Loop IO.Directory.CreateDirectory(sDir) Return sDir End Function Public Shared Sub ObtieneFicherosRecursivo(ByVal Ruta As String, ByRef Ficheros() As String) Dim sFicheros() As String = IO.Directory.GetFiles(Ruta) Dim iNumeroFicheros As Integer If Not IsNothing(Ficheros) Then iNumeroFicheros = Ficheros.Length ReDim Preserve Ficheros(sFicheros.Length - 1 + iNumeroFicheros) sFicheros.CopyTo(Ficheros, iNumeroFicheros) Dim sDirectorio, sDirectorios() As String sDirectorios = IO.Directory.GetDirectories(Ruta) For Each sDirectorio In sDirectorios ObtieneFicherosRecursivo(sDirectorio, Ficheros) Next End Sub End Class