Descomprimir ficheros ZIP
Necesito descomprimir archivos zip en visual basic 6 para manipular esos archivos
Muchas gracias por ayudarme
Muchas gracias por ayudarme
Este codigo lo utilizo yo y funciona. estudialo bien.
Esta parte va en el proyecto-
Sub Descomprimir_archivo()
Text1.Text = path_zip "La ruta donde esta el archivo comprimido
Text2.Text = path_uzip "ruta donde van a quedar los archivos
UnZip Text1, Text2
End Sub
y debes agregar este modulo
Dim resultado As Long
Dim intContadorFicheros As Integer
Dim FuncionesUnZip As UNZIPUSERFUNCTION
Dim OpcionesUnZip As UNZIPOPTIONS
Dim NombresFicherosZip As ZIPnames, NombresFicheros2Zip As ZIPnames
NombresFicherosZip.s(0) = vbNullChar
NombresFicheros2Zip.s(0) = vbNullChar
FuncionesUnZip.UNZIPMessage = 0&
FuncionesUnZip.UNZIPPassword = 0&
FuncionesUnZip.UNZIPPrntFunction = DevolverDireccionMemoria1(AddressOf UNFuncionParaProcesarMensajes)
FuncionesUnZip.UNZIPReplaceFunction = DevolverDireccionMemoria1(AddressOf UNFuncionReplaceOptions)
FuncionesUnZip.UNZIPService = 0&
FuncionesUnZip.UNZIPSndFunction = 0&
OpcionesUnZip.C_flag = 1
OpcionesUnZip.fQuiet = 2
OpcionesUnZip.noflag = 1
OpcionesUnZip.Zip = Zip
OpcionesUnZip.extractdir = extractdir
resultado = Wiz_SingleEntryUnzip(0, NombresFicherosZip, 0, NombresFicheros2Zip, OpcionesUnZip, FuncionesUnZip)
Exit Sub
err_Unzip:
MsgBox "Unzip: " + Err.Description, vbExclamation
Err.Clear
End Sub
Private Function UNFuncionParaProcesarMensajes(ByRef fname As CBChar, ByVal X As Long) As Long
On Error GoTo err_UNFuncionParaProcesarMensajes
UNFuncionParaProcesarMensajes = 0
Exit Function
err_UNFuncionParaProcesarMensajes:
MsgBox "UNFuncionParaProcesarMensajes: " + Err.Description, vbExclamation
Err.Clear
End Function
Private Function UNFuncionReplaceOptions(ByRef p As CBChar, ByVal L As Long, ByRef m As CBChar, ByRef Name As CBChar) As Integer
On Error GoTo err_UNFuncionReplaceOptions
UNFuncionParaProcesarPassword = 0
Exit Function
err_UNFuncionReplaceOptions:
MsgBox "UNFuncionParaProcesarPassword: " + Err.Description, vbExclamation
Err.Clear
End Function
Public Function DevolverDireccionMemoria1(Direccion As Long) As Long
On Error GoTo err_DevolverDireccionMemoria1
DevolverDireccionMemoria1 = Direccion
Exit Function
err_DevolverDireccionMemoria1:
MsgBox "DevolverDireccionMemoria1: " + Err.Description, vbExclamation
Err.Clear
End Function
Pruebalo y me cuentas.
Esta parte va en el proyecto-
Sub Descomprimir_archivo()
Text1.Text = path_zip "La ruta donde esta el archivo comprimido
Text2.Text = path_uzip "ruta donde van a quedar los archivos
UnZip Text1, Text2
End Sub
y debes agregar este modulo
Dim resultado As Long
Dim intContadorFicheros As Integer
Dim FuncionesUnZip As UNZIPUSERFUNCTION
Dim OpcionesUnZip As UNZIPOPTIONS
Dim NombresFicherosZip As ZIPnames, NombresFicheros2Zip As ZIPnames
NombresFicherosZip.s(0) = vbNullChar
NombresFicheros2Zip.s(0) = vbNullChar
FuncionesUnZip.UNZIPMessage = 0&
FuncionesUnZip.UNZIPPassword = 0&
FuncionesUnZip.UNZIPPrntFunction = DevolverDireccionMemoria1(AddressOf UNFuncionParaProcesarMensajes)
FuncionesUnZip.UNZIPReplaceFunction = DevolverDireccionMemoria1(AddressOf UNFuncionReplaceOptions)
FuncionesUnZip.UNZIPService = 0&
FuncionesUnZip.UNZIPSndFunction = 0&
OpcionesUnZip.C_flag = 1
OpcionesUnZip.fQuiet = 2
OpcionesUnZip.noflag = 1
OpcionesUnZip.Zip = Zip
OpcionesUnZip.extractdir = extractdir
resultado = Wiz_SingleEntryUnzip(0, NombresFicherosZip, 0, NombresFicheros2Zip, OpcionesUnZip, FuncionesUnZip)
Exit Sub
err_Unzip:
MsgBox "Unzip: " + Err.Description, vbExclamation
Err.Clear
End Sub
Private Function UNFuncionParaProcesarMensajes(ByRef fname As CBChar, ByVal X As Long) As Long
On Error GoTo err_UNFuncionParaProcesarMensajes
UNFuncionParaProcesarMensajes = 0
Exit Function
err_UNFuncionParaProcesarMensajes:
MsgBox "UNFuncionParaProcesarMensajes: " + Err.Description, vbExclamation
Err.Clear
End Function
Private Function UNFuncionReplaceOptions(ByRef p As CBChar, ByVal L As Long, ByRef m As CBChar, ByRef Name As CBChar) As Integer
On Error GoTo err_UNFuncionReplaceOptions
UNFuncionParaProcesarPassword = 0
Exit Function
err_UNFuncionReplaceOptions:
MsgBox "UNFuncionParaProcesarPassword: " + Err.Description, vbExclamation
Err.Clear
End Function
Public Function DevolverDireccionMemoria1(Direccion As Long) As Long
On Error GoTo err_DevolverDireccionMemoria1
DevolverDireccionMemoria1 = Direccion
Exit Function
err_DevolverDireccionMemoria1:
MsgBox "DevolverDireccionMemoria1: " + Err.Description, vbExclamation
Err.Clear
End Function
Pruebalo y me cuentas.
