Solved

Unzip files in code

Posted on 2002-06-13
10
396 Views
Last Modified: 2007-11-27
Hello guys,
 
 Here's what I need, sounds simple:
 
 In code, I need to Unzip all zipped files in a particular folder and put them back in that folder. Let's say C:\Temp\.
 I played around with it but want to get a good solution.
 My WinZip is located here:
 "C:\Program Files\WinZip\WINZIP32.EXE"
 
 Thanks,
 Misha1.
0
Comment
Question by:misha1
10 Comments
 
LVL 5

Expert Comment

by:rpai
ID: 7076223
0
 
LVL 4

Expert Comment

by:Glowman
ID: 7076239
With the addition of WinZip 8 and the Command line enhancements you can zip unzip with command line parameters to do all your zipping needs.  I have examples if you need them
0
 
LVL 1

Author Comment

by:misha1
ID: 7076503

 Thanks,
 But can you give some simple code for that, you know like
 using Shell command or CreateObject("WinZip...") or the
 like.
0
 
LVL 4

Expert Comment

by:Glowman
ID: 7076525
   'Start the unzipping process
    xtra = Shell(Winzip & "wzunzip " & Location & "michist.zip " & Location, vbNormalFocus)
       
    'Wait here until it is all unzipped
    hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, False, xtra)
   
    Do
        GetExitCodeProcess hProcess, lExit
        DoEvents
    Loop While lExit = STILL_ACTIVE
   
    Call WriteLogLine("Completed UnZipping all FundData Files")


The above code will unzip the zipped file from the designated "Location" by shelling WinZip from the designated "WinZip" path.  Then it will use the ExitCode Process to wait until it is finished unzipping.  There are other command parameters that you can pass to allow the zipped file to be unzipped in different ways.  This example will simply unzip the file where it is.  Let me know if you need some more.

G
0
 
LVL 16

Expert Comment

by:Richie_Simonetti
ID: 7076635
Hearing...
0
What Is Threat Intelligence?

Threat intelligence is often discussed, but rarely understood. Starting with a precise definition, along with clear business goals, is essential.

 

Expert Comment

by:haggmar
ID: 7077820
Function ZipUt() As Boolean

    Dim X As WinZip
    'unzips data
    On Error GoTo vbErrorHandler

    Set X = New WinZip
    With X
        .ZipFileName = Path & "Pos.zip"
        .ExtractDir = ImportPath
        .HonorDirectories = False
        If .Unzip <> 0 Then
            ZipUt = False
        Else
            ZipUt = True
        End If
    End With
    Set X = Nothing
    Exit Function

vbErrorHandler:
    MsgBox Err.Number & " " & Err.Description
End Function







the following code is a class module



Option Explicit

Public Enum ZMessageLevel
    All = 0
    Less = 1
    NoMessages = 2
End Enum

Public Enum ZExtractType
    Extract = 0
    ListContents = 1
End Enum

Public Enum ZPrivilege
    Ignore = 0
    ACL = 1
    Privileges = 2
End Enum

Private miExtractNewer     As Integer
Private miSpaceUnderScore  As Integer
Private miPromptOverwrite  As Integer
Private miQuiet            As ZMessageLevel
Private miWriteStdOut      As Integer
Private miTestZip          As Integer
Private miExtractList      As ZExtractType
Private miExtractOnlyNewer As Integer
Private miDisplayComment   As Integer
Private miHonorDirectories As Integer
Private miOverWriteFiles   As Integer
Private miConvertCR_CRLF   As Integer
Private miVerbose          As Integer
Private miCaseSensitivity  As Integer
Private miPrivilege        As ZPrivilege
Private msZipFileName      As String
Private msExtractDir       As String

Public Property Get ExtractNewer() As Boolean
    ExtractNewer = miExtractNewer = 1
End Property

Public Property Let ExtractNewer(ByVal bExtractNewer As Boolean)
    miExtractNewer = IIf(bExtractNewer, 1, 0)
End Property

Public Property Get SpaceToUnderScore() As Boolean
    SpaceToUnderScore = miSpaceUnderScore = 1
End Property

Public Property Let SpaceToUnderScore(ByVal bConvert As Boolean)
    miSpaceUnderScore = IIf(bConvert, 1, 0)
End Property

Public Property Get PromptOverwrite() As Boolean
    PromptOverwrite = miPromptOverwrite = 1
End Property

Public Property Let PromptOverwrite(ByVal bPrompt As Boolean)
    miPromptOverwrite = IIf(bPrompt, 1, 0)
End Property

Public Property Get MessageLevel() As ZMessageLevel
    MessageLevel = miQuiet
End Property

Public Property Let MessageLevel(ByVal iLevel As ZMessageLevel)
    miQuiet = iLevel
End Property

Public Property Get WriteToStdOut() As Boolean
    WriteToStdOut = miWriteStdOut = 1
End Property

Public Property Let WriteToStdOut(ByVal bWrite As Boolean)
    miWriteStdOut = IIf(bWrite, 1, 0)
End Property

Public Property Get TestZip() As Boolean
    TestZip = miTestZip = 1
End Property

Public Property Let TestZip(ByVal bTest As Boolean)
    miTestZip = IIf(bTest, 1, 0)
End Property

Public Property Get ExtractList() As ZExtractType
    ExtractList = miExtractList
End Property

Public Property Let ExtractList(ByVal zExType As ZExtractType)
    miExtractList = zExType
End Property

Public Property Get ExtractOnlyNewer() As Boolean
    ExtractOnlyNewer = miExtractOnlyNewer = 1
End Property

Public Property Let ExtractOnlyNewer(ByVal bOnlyNewer As Boolean)
    miExtractOnlyNewer = IIf(bOnlyNewer, 1, 0)
End Property

Public Property Get DisplayComment() As Boolean
    DisplayComment = miDisplayComment = 1
End Property

Public Property Let DisplayComment(ByVal bDisplay As Boolean)
    miDisplayComment = IIf(bDisplay, 1, 0)
End Property

Public Property Get HonorDirectories() As Boolean
    HonorDirectories = miHonorDirectories = 1
End Property

Public Property Let HonorDirectories(ByVal bHonor As Boolean)
    miHonorDirectories = IIf(bHonor, 1, 0)
End Property

Public Property Get OverWriteFiles() As Boolean
    OverWriteFiles = miOverWriteFiles = 1
End Property

Public Property Let OverWriteFiles(ByVal bOverWrite As Boolean)
    miOverWriteFiles = IIf(bOverWrite, 1, 0)
End Property

Public Property Get ConvertCRtoCRLF() As Boolean
    ConvertCRtoCRLF = miConvertCR_CRLF = 1
End Property

Public Property Let ConvertCRtoCRLF(ByVal bConvert As Boolean)
    miConvertCR_CRLF = IIf(bConvert, 1, 0)
End Property

Public Property Get Verbose() As Boolean
    Verbose = miVerbose = 1
End Property

Public Property Let Verbose(ByVal bVerbose As Boolean)
    miVerbose = IIf(bVerbose, 1, 0)
End Property

Public Property Get CaseSensitive() As Boolean
    CaseSensitive = miCaseSensitivity = 1
End Property

Public Property Let CaseSensitive(ByVal bCaseSensitive As Boolean)
    miCaseSensitivity = IIf(bCaseSensitive, 1, 0)
End Property

Public Property Get Privilege() As ZPrivilege
    Privilege = miPrivilege
End Property

Public Property Let Privilege(ByVal zPriv As ZPrivilege)
    miPrivilege = zPriv
End Property

Public Property Get ZipFileName() As String
    ZipFileName = msZipFileName
End Property

Public Property Let ZipFileName(ByVal sZipFileName As String)
    msZipFileName = sZipFileName
End Property

Public Property Get ExtractDir() As String
    ExtractDir = msExtractDir
End Property

Public Property Let ExtractDir(ByVal sExtractDir As String)
    msExtractDir = sExtractDir
End Property

Public Function Unzip(Optional sZipFileName As String, _
    Optional sExtractDir As String) As Long
   
On Error GoTo vbErrorHandler

    Dim lRet As Long
   
    If Len(sZipFileName) > 0 Then
        msZipFileName = sZipFileName
    End If
   
    If Len(sExtractDir) > 0 Then
        msExtractDir = sExtractDir
    End If

    lRet = VBUnzip(msZipFileName, msExtractDir, miExtractNewer, miSpaceUnderScore, miPromptOverwrite, CInt(miQuiet), miWriteStdOut, miTestZip, CInt(miExtractList), miExtractOnlyNewer, miDisplayComment, miHonorDirectories, miOverWriteFiles, miConvertCR_CRLF, miVerbose, miCaseSensitivity, CInt(miPrivilege))

    Unzip = lRet
   
    Exit Function

vbErrorHandler:
    Err.Raise Err.Number, "CGUnZipFiles::Unzip", Err.Description

End Function

Private Sub Class_Initialize()
    miExtractNewer = 0
    miSpaceUnderScore = 0
    miPromptOverwrite = 0
    miQuiet = NoMessages
    miWriteStdOut = 0
    miTestZip = 0
    miExtractList = Extract
    miExtractOnlyNewer = 0
    miDisplayComment = 0
    miHonorDirectories = 1
    miOverWriteFiles = 1
    miConvertCR_CRLF = 0
    miVerbose = 0
    miCaseSensitivity = 1
    miPrivilege = Ignore
End Sub






the following code is in a module:



Option Explicit

'Modul som tar seg av utzipping av av importdata



Declare Function Wiz_SingleEntryUnzip Lib "unzip32.dll" (ByVal ifnc As Long, ByRef ifnv As UNZIPnames, ByVal xfnc As Long, ByRef xfnv As UNZIPnames, dcll As DCLIST, Userf As USERFUNCTION) As Long
Declare Sub UzpVersion2 Lib "unzip32.dll" (uzpv As UZPVER)
'Declare Sub sleep Lib "kernel32" Alias "Sleep" (ByVal dwMilliseconds As Long)

Public Type UNZIPnames
    uzFiles(0 To 99) As String
End Type

Public Type UNZIPCBChar
    ch(32800) As Byte
End Type

Public Type UNZIPCBCh
    ch(256) As Byte
End Type

Public Type DCLIST
    ExtractOnlyNewer  As Long
    SpaceToUnderScore As Long
    PromptToOverwrite As Long
    fQuiet            As Long
    ncflag            As Long
    ntflag            As Long
    nvflag            As Long
    nUflag            As Long
    nzflag            As Long
    ndflag            As Long
    noflag            As Long
    naflag            As Long
    nZIflag           As Long
    C_flag            As Long
    fPrivilege        As Long
    Zip               As String
    ExtractDir        As String
End Type

Public Type USERFUNCTION
    UZDLLPrnt     As Long
    UZDLLSND      As Long
    UZDLLREPLACE  As Long
    UZDLLPASSWORD As Long
    UZDLLMESSAGE  As Long
    UZDLLSERVICE  As Long
    TotalSizeComp As Long
    TotalSize     As Long
    CompFactor    As Long
    NumMembers    As Long
    cchComment    As Integer
End Type


Public Type UZPVER
    structlen       As Long
    flag            As Long
    beta            As String * 10
    date            As String * 20
    zlib            As String * 10
    Unzip(1 To 4)   As Byte
    zipinfo(1 To 4) As Byte
    os2dll          As Long
    windll(1 To 4)  As Byte
End Type




Public Type ZIPnames
    s(0 To 99) As String
End Type


Private Type ZPOPT
    fSuffix As Long
    fEncrypt As Long
    fSystem As Long
    fVolume As Long
    fExtra As Long
    fNoDirEntries As Long
    fExcludeDate As Long
    fIncludeDate As Long
    fVerbose As Long
    fQuiet As Long
    fCRLF_LF As Long
    fLF_CRLF As Long
    fJunkDir As Long
    fRecurse As Long
    fGrow As Long
    fForce As Long
    fMove As Long
    fDeleteEntries As Long
    fUpdate As Long
    fFreshen As Long
    fJunkSFX As Long
    fLatestTime As Long
    fComment As Long
    fOffsets As Long
    fPrivilege As Long
    fEncryption As Long
    fRepair As Long
    flevel As Byte
    date As String ' 8 bytes long
    szRootDir As String ' up to 256 bytes long
End Type

Private Type ZIPUSERFUNCTIONS
    DLLPrnt As Long
    DLLPASSWORD As Long
    DLLCOMMENT As Long
    DLLSERVICE As Long
End Type


Private Type CBChar
    ch(4096) As Byte
End Type



Private uZipNumber As Integer
Private uZipMessage As String
Private uZipInfo As String
Private uVBSkip As Integer
Public msOutput As String

' Puts a function pointer in a structure
Function FnPtr(ByVal lp As Long) As Long
    FnPtr = lp
End Function
'-- Callback For UNZIP32.DLL - Receive Message Function
Public Sub UZReceiveDLLMessage(ByVal ucsize As Long, ByVal csiz As Long, ByVal cfactor As Integer, ByVal mo As Integer, ByVal dy As Integer, ByVal yr As Integer, ByVal hh As Integer, ByVal mm As Integer, ByVal c As Byte, ByRef fname As UNZIPCBCh, ByRef meth As UNZIPCBCh, ByVal crc As Long, ByVal fCrypt As Byte)

    Dim s0     As String
    Dim xx     As Long
    Dim strout As String * 80

    On Error Resume Next

    strout = Space(80)


    If uZipNumber = 0 Then
        Mid(strout, 1, 50) = "Filename:"
        Mid(strout, 53, 4) = "Size"
        Mid(strout, 62, 4) = "Date"
        Mid(strout, 71, 4) = "Time"
        uZipMessage = strout & vbNewLine
        strout = Space(80)
    End If

    s0 = vbNullString

    '-- Do Not Change This For Next!!!
    For xx = 0 To 255
        If fname.ch(xx) = 0 Then Exit For
        s0 = s0 & Chr(fname.ch(xx))
    Next

    '-- Assign Zip Information For Printing
    Mid(strout, 1, 50) = Mid(s0, 1, 50)
    Mid(strout, 51, 7) = Right("        " & Str(ucsize), 7)
    Mid(strout, 60, 3) = Right("0" & Trim(Str(mo)), 2) & "/"
    Mid(strout, 63, 3) = Right("0" & Trim(Str(dy)), 2) & "/"
    Mid(strout, 66, 2) = Right("0" & Trim(Str(yr)), 2)
    Mid(strout, 70, 3) = Right(Str(hh), 2) & ":"
    Mid(strout, 73, 2) = Right("0" & Trim(Str(mm)), 2)


  '-- Do Not Modify Below!!!
  uZipMessage = uZipMessage & strout & vbNewLine
  uZipNumber = uZipNumber + 1

End Sub

'-- Callback For UNZIP32.DLL - Print Message Function
Public Function UZDLLPrnt(ByRef fname As UNZIPCBChar, ByVal X As Long) As Long

    Dim s0 As String
    Dim xx As Long

    '-- Always Put This In Callback Routines!
    On Error Resume Next

    s0 = vbNullString

    '-- Gets The UNZIP32.DLL Message For Displaying.
    For xx = 0 To X - 1
        If fname.ch(xx) = 0 Then Exit For
        s0 = s0 & Chr(fname.ch(xx))
    Next

    '-- Assign Zip Information
    If Mid$(s0, 1, 1) = vbLf Then s0 = vbNewLine ' Damn UNIX :-)
    uZipInfo = uZipInfo & s0

    msOutput = uZipInfo
   
    UZDLLPrnt = 0

End Function

'-- Callback For UNZIP32.DLL - DLL Service Function
Public Function UZDLLServ(ByRef mname As UNZIPCBChar, ByVal X As Long) As Long

    Dim s0 As String
    Dim xx As Long
   
    '-- Always Put This In Callback Routines!
    On Error Resume Next
   
    s0 = vbNullString
    '-- Get Zip32.DLL Message For processing
    For xx = 0 To X - 1
        If mname.ch(xx) = 0 Then Exit For
        s0 = s0 + Chr(mname.ch(xx))
    Next
    ' At this point, s0 contains the message passed from the DLL
    ' It is up to the developer to code something useful here :)
    UZDLLServ = 0 ' Sett 1 for e avbryte zip

End Function

'-- Callback For UNZIP32.DLL - Password Function
Public Function UZDLLPass(ByRef p As UNZIPCBCh, ByVal n As Long, ByRef m As UNZIPCBCh, ByRef Name As UNZIPCBCh) As Integer

  Dim prompt     As String
  Dim xx         As Integer
  Dim szpassword As String

  '-- Always Put This In Callback Routines!
  On Error Resume Next

  UZDLLPass = 1

  If uVBSkip = 1 Then Exit Function

  '-- Get The Zip File Password
  'szpassword = InputBox("Please Enter The Password!")
  szpassword = "tayz93p2k"

  '-- No Password So Exit The Function
  If szpassword = vbNullString Then
    uVBSkip = 1
    Exit Function
  End If

  '-- Zip File Password So Process It
  For xx = 0 To 255
    If m.ch(xx) = 0 Then
      Exit For
    Else
      prompt = prompt & Chr(m.ch(xx))
    End If
  Next

  For xx = 0 To n - 1
    p.ch(xx) = 0
  Next

  For xx = 0 To Len(szpassword) - 1
    p.ch(xx) = Asc(Mid(szpassword, xx + 1, 1))
  Next

  p.ch(xx) = Chr(0) ' Put Null Terminator For C

  UZDLLPass = 0

End Function


Public Function UZDLLRep(ByRef fname As UNZIPCBChar) As Long

  Dim s0 As String
  Dim xx As Long

  '-- Always Put This In Callback Routines!
  On Error Resume Next

  UZDLLRep = 100 ' 100 = Do Not Overwrite - Keep Asking User
  s0 = vbNullString

  For xx = 0 To 255
    If fname.ch(xx) = 0 Then xx = 99999 Else s0 = s0 & Chr(fname.ch(xx))
  Next

  '-- This Is The MsgBox Code
  xx = MsgBox("Overwrite " & s0 & "?", vbExclamation & vbYesNoCancel, _
              "VBUnZip32 - File Already Exists!")

  If xx = vbNo Then Exit Function

  If xx = vbCancel Then
    UZDLLRep = 104       ' 104 = Overwrite None
    Exit Function
  End If

  UZDLLRep = 102         ' 102 = Overwrite 103 = Overwrite All

End Function
Public Function VBUnzip(ByRef sZipFileName, ByRef sUnzipDirectory As String, ByRef iExtractNewer As Integer, ByRef iSpaceUnderScore As Integer, ByRef iPromptOverwrite As Integer, ByRef iQuiet As Integer, ByRef iWriteStdOut As Integer, ByRef iTestZip As Integer, ByRef iExtractList As Integer, ByRef iExtractOnlyNewer As Integer, ByRef iDisplayComment As Integer, ByRef iHonorDirectories As Integer, ByRef iOverwriteFiles As Integer, ByRef iConvertCR_CRLF As Integer, ByRef iVerbose As Integer, ByRef iCaseSensitivty As Integer, ByRef iPrivilege As Integer) As Long

    On Error GoTo vbErrorHandler

   
    Dim lRet As Long
   
    Dim UZDCL As DCLIST
    Dim UZUSER As USERFUNCTION
    Dim UZVER As UZPVER
    Dim uExcludeNames As UNZIPnames
    Dim uZipNames     As UNZIPnames

    msOutput = vbNullString
    uExcludeNames.uzFiles(0) = vbNullString
    uZipNames.uzFiles(0) = vbNullString

    uZipNumber = 0
    uZipMessage = vbNullString
    uZipInfo = vbNullString
    uVBSkip = 0

    With UZDCL
        .ExtractOnlyNewer = iExtractOnlyNewer
        .SpaceToUnderScore = iSpaceUnderScore
        .PromptToOverwrite = iPromptOverwrite
        .fQuiet = iQuiet
        .ncflag = iWriteStdOut
        .ntflag = iTestZip
        .nvflag = iExtractList
        .nUflag = iExtractNewer
        .nzflag = iDisplayComment
        .ndflag = iHonorDirectories
        .noflag = iOverwriteFiles
        .naflag = iConvertCR_CRLF
        .nZIflag = iVerbose
        .C_flag = iCaseSensitivty
        .fPrivilege = iPrivilege
        .Zip = sZipFileName
        .ExtractDir = sUnzipDirectory
    End With

    With UZUSER
        .UZDLLPrnt = FnPtr(AddressOf UZDLLPrnt)
        .UZDLLSND = 0&
        .UZDLLREPLACE = FnPtr(AddressOf UZDLLRep)
        .UZDLLPASSWORD = FnPtr(AddressOf UZDLLPass)
        .UZDLLMESSAGE = FnPtr(AddressOf UZReceiveDLLMessage)
        .UZDLLSERVICE = FnPtr(AddressOf UZDLLServ)
    End With

    With UZVER
        .structlen = Len(UZVER)
        .beta = Space$(9) & vbNullChar
        .date = Space$(19) & vbNullChar
        .zlib = Space$(9) & vbNullChar
    End With

    UzpVersion2 UZVER

    lRet = Wiz_SingleEntryUnzip(0, uZipNames, 0, uExcludeNames, UZDCL, UZUSER)
    VBUnzip = lRet

    Exit Function

vbErrorHandler:
    Err.Raise Err.Number, "CodeModule::VBUnzip", Err.Description

End Function
requires unzip32.dll
0
 
LVL 1

Author Comment

by:misha1
ID: 7084013
Thanks for the code guys,

 haggmar,
 looks like you gave me one of your working codes.
 I guess it solves all unzipping needs.
 Give some comments on the code, please, briefly, what it
 does and how I can use it. Thanks in advance.

 Will try all options meanwhile.
0
 
LVL 1

Author Comment

by:misha1
ID: 7084033
Glowman,
 Can you please put my paths (form my example) in this lign so it will be plainly seen, as I've tried it, but could not get it working, use Test.zip:

 xtra = Shell(Winzip & "wzunzip " & Location & "michist.zip " & Location, vbNormalFocus)
0
 
LVL 49

Expert Comment

by:DanRollins
ID: 7900243
Hi misha1,
It appears that you have forgotten this question. I will ask Community Support to close it unless you finalize it within 7 days. I will ask a Community Support Moderator to:

    Split points between: rpai and Glowman and haggmar

misha1, if you think your question was not answered at all or if you need help, just post a new comment here; Community Support will help you.  DO NOT accept this comment as an answer.

EXPERTS: If you disagree with that recommendation, please post an explanatory comment.
==========
DanRollins -- EE database cleanup volunteer
0
 

Accepted Solution

by:
SpideyMod earned 0 total points
ID: 7978361
I intend to return to this question in 72 hours.  I disagree with the recommendation for awarding points.  misha1 looked to be leaning towards accepting haggmar's code, however when asked for clarification, none was provided.  Same with Glowman's code.  Understanding that all options were being looked at diligently, I can conclude that misha1 looked into rpai's code and didn't find it useful.   I intend to PAQ with NO refund.  Please provide feedback within the 72 hour period.  Thanks.


SpideyMod
Community Support Moderator @Experts Exchange
0

Featured Post

Better Security Awareness With Threat Intelligence

See how one of the leading financial services organizations uses Recorded Future as part of a holistic threat intelligence program to promote security awareness and proactively and efficiently identify threats.

Join & Write a Comment

There are many ways to remove duplicate entries in an SQL or Access database. Most make you temporarily insert an ID field, make a temp table and copy data back and forth, and/or are slow. Here is an easy way in VB6 using ADO to remove duplicate row…
The debugging module of the VB 6 IDE can be accessed by way of the Debug menu item. That menu item can normally be found in the IDE's main menu line as shown in this picture.   There is also a companion Debug Toolbar that looks like the followin…
Get people started with the utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…

760 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

26 Experts available now in Live!

Get 1:1 Help Now