Solved

Urgent!! Zipping Files Programatically Ocx/Dll and fast like Winzip

Posted on 2003-11-26
16
1,234 Views
Last Modified: 2007-11-27
HI guys

Anybody know any free zipping utelity as Dll/Ocx/APIs which is simple and ready to use.

I have used ZlibTool.ocx for un/zipping which is ATL Control.

But while deploying the Exe I get the error System Error &H80004005 (-2147467259). Unspecified error.

Ref - http://support.microsoft.com/default.aspx?scid=http://support.microsoft.com:80/support/kb/articles/Q216/2/78.asp&NoWebContent=1

Thx
Anand
0
Comment
Question by:anand2k
  • 5
  • 3
  • 2
  • +4
16 Comments
 
LVL 14

Expert Comment

by:aelatik
ID: 9825047
Hi,

You can use vbzip10.dll, i use it to and it works like a charm...

http://www.vbaccelerator.com/home/VB/Utilities/VBPZip/VBPZip_Source_Code_zip_mZip_bas.asp

You will need to download the project and the Dll
0
 
LVL 1

Author Comment

by:anand2k
ID: 9825328
Hello aelatik

I have done that downloading.

But the problem is that i was not able to register that DLL with regsvr32.dll
pls advice


Anand
0
 
LVL 43

Expert Comment

by:TimCottee
ID: 9825367
Hi anand2k,

The DLL is a standard dll not an activex dll so does not need to be registered to be used.

Tim Cottee MCSD, MCDBA, CPIM
Brainbench MVP for Visual Basic
http://www.brainbench.com
0
 
LVL 16

Expert Comment

by:Richie_Simonetti
ID: 9825407
If you have winzip installed you could run command line winzip.
example:

dim sh
set sh =createobejct("wscript.shell")
sh run "winzip32 -min -a -r -p " & "S:\impuestos\backafip\" & replace(date,"/","-") & ".zip" & " C:\archiv~1\s.i.ap\*.*"
This command line tells winzip to run minimized, create a new zip called as current date and add all files/folders located in "C:\archiv~1\s.i.ap\*.*"
0
 
LVL 1

Author Comment

by:anand2k
ID: 9825418
I tried with vbuzip10.dll


BUt when I tryu to run the project  it keeps on asking for missing DLL file VBAccelator VB6 subclassing and timer assistant (SSubTmr6.dll)

when I download the ZIp file I did not get the SSubTmr6.dll

WHere is it.

THx
AnAND



0
 
LVL 1

Author Comment

by:anand2k
ID: 9825442
Ys, But i can not expect on each and every machine should be compatiable with windos Script and same with Winzip, eventhough it is free I can not ask the user to use it.


I tried to use PKZIP 16 bit with help of shell but it also failed.


ANAND
0
 
LVL 43

Expert Comment

by:TimCottee
ID: 9825479
You can get the ssubtmr6 dll from http://www.vbaccelerator.com/home/VB/Code/Libraries/Subclassing/SSubTimer/article.asp look at the downloads links on the left of the page.
0
How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

 
LVL 16

Expert Comment

by:Richie_Simonetti
ID: 9825644
To use pkzip16  you need to use short folders/files names and they would be stored in the same way so you lost long filenames inside the zip file too.
0
 
LVL 14

Accepted Solution

by:
aelatik earned 150 total points
ID: 9826007
Create a project from the following and place VBZIP in the same DIR :

Class Module ( cZip.cls )
------------------------------------------
Option Explicit

Public Enum EZPMsgLevel
   ezpAllMessages = 0
   ezpPartialMessages = 1
   ezpNoMessages = 2
End Enum

Public Event Cancel(ByVal sMsg As String, ByRef bCancel As Boolean)
Public Event PasswordRequest(ByRef sPassword As String, ByRef bCancel As Boolean)
Public Event Progress(ByVal lCount As Long, ByVal sMsg As String)


Private m_tZPOPT As ZPOPT
Private m_sFileName As String
Private m_sFileSpecs() As String
Private m_iCount As Long

Public Property Get ZipFile() As String
   ZipFile = m_sFileName
End Property
Public Property Let ZipFile(ByVal sFileName As String)
   m_sFileName = sFileName
End Property
Public Property Get BasePath() As String
   BasePath = m_tZPOPT.szRootDir
End Property
Public Property Let BasePath(ByVal sBasePath As String)
   m_tZPOPT.szRootDir = sBasePath
End Property
Public Property Get Encrpyt() As Boolean
   Encrypt = Not (m_tZPOPT.fEncrypt = 0)
End Property
Public Property Let Encrypt(ByVal bState As Boolean)
   m_tZPOPT.fEncrypt = Abs(bState)
End Property
Public Property Get IncludeSystemAndHiddenFiles() As Boolean
    IncludeSystemAndHiddenFiles = Not (m_tZPOPT.fSystem = 0)
End Property
Public Property Let IncludeSystemAndHiddenFiles(ByVal bState As Boolean)
   m_tZPOPT.fSystem = Abs(bState)
End Property
Public Property Get StoreVolumeLabel() As Boolean
    StoreVolumeLabel = Not (m_tZPOPT.fVolume = 0)
End Property
Public Property Let StoreVolumeLabel(ByVal bState As Boolean)
   m_tZPOPT.fVolume = Abs(bState)
End Property
Public Property Get StoreDirectories() As Boolean
   StoreDirectories = Not (m_tZPOPT.fNoDirEntries = 0)
End Property
Public Property Let StoreDirectories(ByVal bState As Boolean)
   m_tZPOPT.fNoDirEntries = Abs(Not (bState))
End Property
Public Property Get StoreFolderNames() As Boolean
   StoreFolderNames = (m_tZPOPT.fJunkDir = 0)
End Property
Public Property Let StoreFolderNames(ByVal bState As Boolean)
   m_tZPOPT.fJunkDir = Abs(Not (bState))
End Property
Public Property Get RecurseSubDirs() As Boolean
   RecurseSubDirs = Not (m_tZPOPT.fRecurse = 0)
End Property
Public Property Let RecurseSubDirs(ByVal bState As Boolean)
   If bState Then
      m_tZPOPT.fRecurse = 2
   Else
      m_tZPOPT.fRecurse = 0
   End If
End Property

Public Property Get UpdateOnlyIfNewer() As Boolean
    UpdateOnlyIfNewer = Not (m_tZPOPT.fUpdate = 0)
End Property
Public Property Let UpdateOnlyIfNewer(ByVal bState As Boolean)
    m_tZPOPT.fUpdate = Abs(bState)
End Property
Public Property Get FreshenFiles() As Boolean
    FreshenFiles = Not (m_tZPOPT.fFreshen = 0)
End Property
Public Property Let FreshenFiles(ByVal bState As Boolean)
    m_tZPOPT.fUpdate = Abs(bState)
End Property
Public Property Get MessageLevel() As EZPMsgLevel
   If Not (m_tZPOPT.fVerbose = 0) Then
      MessageLevel = ezpAllMessages
   ElseIf Not (m_tZPOPT.fQuiet = 0) Then
      MessageLevel = ezpPartialMessages
   Else
      MessageLevel = ezpNoMessages
   End If
End Property
Public Property Let MessageLevel(ByVal eLevel As EZPMsgLevel)
   Select Case eLevel
   Case ezpPartialMessages
      m_tZPOPT.fQuiet = 1
      m_tZPOPT.fVerbose = 0
   Case ezpNoMessages
      m_tZPOPT.fQuiet = 0
      m_tZPOPT.fVerbose = 0
   Case ezpAllMessages
      m_tZPOPT.fQuiet = 0
      m_tZPOPT.fVerbose = 1
   End Select
End Property
Public Property Get ConvertCRLFToLF() As Boolean
   ConvertCRLFToLF = (m_tZPOPT.fCRLF_LF <> 0)
End Property
Public Property Let ConvertCRLFToLF(ByVal bState As Boolean)
   m_tZPOPT.fCRLF_LF = Abs(bState)
End Property
Public Property Get ConvertLFToCRLF() As Boolean
   ConvertLFToCRLF = (m_tZPOPT.fLF_CRLF <> 0)
End Property
Public Property Let ConvertLFToCRLF(ByVal bState As Boolean)
   m_tZPOPT.fLF_CRLF = Abs(bState)
End Property

Friend Sub ProgressReport( _
      ByVal sMsg As String _
   )
   RaiseEvent Progress(1, sMsg)
End Sub
Friend Sub PasswordRequest( _
      ByRef sPassword As String, _
      ByRef bCancel As Boolean _
   )
   RaiseEvent PasswordRequest(sPassword, bCancel)
End Sub
Friend Sub Service( _
      ByVal sMsg As String, _
      ByRef bCancel As Boolean _
   )
   RaiseEvent Cancel(sMsg, bCancel)
End Sub
Public Sub ClearFileSpecs()
   m_iCount = 0
   Erase m_sFileSpecs()
End Sub
Public Function AddFileSpec(ByVal sSpec As String) As Long
   m_iCount = m_iCount + 1
   ReDim Preserve m_sFileSpecs(1 To m_iCount) As String
   m_sFileSpecs(m_iCount) = sSpec
End Function
Public Property Get FileSpecCount() As Long
   FileSpecCount = m_iCount
End Property
Public Property Get FileSpec(ByVal nIndex As Long)
   FileSpec = m_sFileSpecs(nIndex)
End Property
Public Property Get AllowAppend() As Boolean
   AllowAppend = (m_tZPOPT.fGrow = 1)
End Property
Public Property Let AllowAppend(ByVal bState As Boolean)
   m_tZPOPT.fGrow = Abs(bState)
End Property
Public Sub Zip()
   mZip.VBZip Me, m_tZPOPT, m_sFileSpecs(), m_iCount
End Sub
Public Sub Delete()
   m_tZPOPT.fDeleteEntries = 1
   mZip.VBZip Me, m_tZPOPT, m_sFileSpecs(), m_iCount
   m_tZPOPT.fDeleteEntries = 0
End Sub

Private Sub Class_Initialize()
   StoreDirectories = False
   StoreFolderNames = False
   RecurseSubDirs = False
End Sub
--------------------------------------------



Module (mzip.bas)
---------------------------------------------
Option Explicit
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)
Private Type ZIPnames
    s(0 To 1023) As String
End Type
Private Type CBChar
    ch(0 To 4096) As Byte
End Type
Private Type CBCh
    ch(0 To 255) As Byte
End Type
Private Type ZIPUSERFUNCTIONS
    lPtrPrint As Long
    lptrPassword As Long
    lptrComment As Long
    lptrService As Long
End Type

Public Type ZPOPT
  Date           As String
  szRootDir      As String
  szTempDir      As String
  fTemp          As Long
  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
  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
  fRecurse       As Long
  fRepair        As Long
  flevel         As Byte
End Type
Private Declare Function ZpInit Lib "vbzip10.dll" (ByRef tUserFn As ZIPUSERFUNCTIONS) As Long
Private Declare Function ZpSetOptions Lib "vbzip10.dll" (ByRef tOpts As ZPOPT) As Long
Private Declare Function ZpGetOptions Lib "vbzip10.dll" () As ZPOPT
Private Declare Function ZpArchive Lib "vbzip10.dll" (ByVal argc As Long, ByVal funame As String, ByRef argv As ZIPnames) As Long
Private m_cZip As cZip
Private m_bCancel As Boolean

Private Function plAddressOf(ByVal lPtr As Long) As Long
   plAddressOf = lPtr
End Function

Public Function VBZip( _
      cZipObject As cZip, _
      tZPOPT As ZPOPT, _
      sFileSpecs() As String, _
      iFileCount As Long _
   ) As Long
Dim tUser As ZIPUSERFUNCTIONS
Dim lR As Long
Dim i As Long
Dim sZipFile As String
Dim tZipName As ZIPnames

   m_bCancel = False
   Set m_cZip = cZipObject

   If Not Len(Trim$(m_cZip.BasePath)) = 0 Then
      ChDir m_cZip.BasePath
   End If
   tUser.lPtrPrint = plAddressOf(AddressOf ZipPrintCallback)
   tUser.lptrPassword = plAddressOf(AddressOf ZipPasswordCallback)
   tUser.lptrComment = plAddressOf(AddressOf ZipCommentCallback)
   tUser.lptrService = plAddressOf(AddressOf ZipServiceCallback)
   lR = ZpInit(tUser)
   lR = ZpSetOptions(tZPOPT)
   For i = 1 To iFileCount
      tZipName.s(i - 1) = sFileSpecs(i)
   Next i
   tZipName.s(i) = vbNullChar
   
   sZipFile = cZipObject.ZipFile
   lR = ZpArchive(iFileCount, sZipFile, tZipName)
   
   VBZip = lR

End Function

Private Function ZipServiceCallback(ByRef mname As CBChar, ByVal X As Long) As Long
Dim iPos As Long
Dim sInfo As String
Dim bCancel As Boolean
On Error Resume Next
   If X > 1 And X < 32000 Then
      ReDim b(0 To X) As Byte
      CopyMemory b(0), mname, X
      sInfo = StrConv(b, vbUnicode)
      iPos = InStr(sInfo, vbNullChar)
      If iPos > 0 Then
         sInfo = Left$(sInfo, iPos - 1)
      End If
      m_cZip.Service sInfo, bCancel
      If bCancel Then
         ZipServiceCallback = 1
      Else
         ZipServiceCallback = 0
      End If
   End If
End Function

Private Function ZipPrintCallback( _
      ByRef fname As CBChar, _
      ByVal X As Long _
   ) As Long
Dim iPos As Long
Dim sFIle As String
   On Error Resume Next
   If X > 1 And X < 32000 Then
      ReDim b(0 To X) As Byte
      CopyMemory b(0), fname, X
      sFIle = StrConv(b, vbUnicode)
      If iPos > 0 Then
         sFIle = Left$(sFIle, iPos - 1)
      End If
      ReplaceSection sFIle, "/", "\"
      m_cZip.ProgressReport sFIle
   End If
   ZipPrintCallback = 0
End Function

Private Function ZipCommentCallback( _
      ByRef s1 As CBChar _
   ) As CBChar
   On Error Resume Next
   s1.ch(0) = vbNullString
   ZipCommentCallback = s1
End Function

Private Function ZipPasswordCallback( _
      ByRef pwd As CBCh, _
      ByVal X As Long, _
      ByRef s2 As CBCh, _
      ByRef Name As CBCh _
   ) As Long

Dim bCancel As Boolean
Dim sPassword As String
Dim b() As Byte
Dim lSize As Long

On Error Resume Next
   ZipPasswordCallback = 1
   
   If m_bCancel Then
      Exit Function
   End If
   m_cZip.PasswordRequest sPassword, bCancel
   sPassword = Trim$(sPassword)
   If bCancel Or Len(sPassword) = 0 Then
      m_bCancel = True
      Exit Function
   End If
   lSize = Len(sPassword)
   If lSize > 254 Then
      lSize = 254
   End If
   b = StrConv(sPassword, vbFromUnicode)
   CopyMemory pwd.ch(0), b(0), lSize
   ZipPasswordCallback = 0
       
End Function

Private Function ReplaceSection(ByRef sString As String, ByVal sToReplace As String, ByVal sReplaceWith As String) As Long
Dim iPos As Long
Dim iLastPos As Long
   iLastPos = 1
   Do
      iPos = InStr(iLastPos, sString, "/")
      If (iPos > 1) Then
         Mid$(sString, iPos, 1) = "\"
         iLastPos = iPos + 1
      End If
   Loop While Not (iPos = 0)
   ReplaceSection = iLastPos

End Function




Form
---------------------------------------------------
Option Explicit
Private WithEvents m_cZ As cZip

Function ZipItUp(FileToCreate As String, FileToAdd As String)
    Set m_cZ = New cZip
    With m_cZ
    .ZipFile = FileToCreate
    .StoreFolderNames = False
    .RecurseSubDirs = False
    .ClearFileSpecs
    .AddFileSpec FileToAdd
    .Zip
    End With
End Function

Private Sub Form_Load()
    Call ZipItUp("c:\myfile.zip", "c:\myfile.txt")
End Sub

I can mail the project and DLL if you like ?
0
 
LVL 1

Author Comment

by:anand2k
ID: 9829686
THx aelatik

If u can add some instructions/comments on how to proceed with functionality and which one to register, it would be great.

If possible, try to comment on, any drawbacks, speed of zipping, compatibality etc.

Please mail me at  anand@coddo.com

THx
Anand
0
 

Expert Comment

by:ShanKonduru
ID: 9829699
Check out this following site...
http://www.vb-helper.com/howto_zlib.html

may be this might be of some help to you
Shan Konduru
0
 
LVL 14

Expert Comment

by:aelatik
ID: 9829815
anand2k,

Just build the project witht the pages i posted and put vbzip10.dll in the same directory as your exe and it will run.

Speed :
The speed of zipping is the same speed as winzip i guess ( to test that good you will need to test it with larger files, the files i zip are around 10 megs )

Compatibility :
I made a project for the company i work for, this project needed to run on operating systems 9X,WinMe,Win2K, XP.
I use this zip functionality in this project and it works without problems on these OS.

Drawbacks :

Can't tell, i didn't have any problems with it so far.
0
 
LVL 85

Expert Comment

by:Mike Tomlinson
ID: 9829951
anand2k,

I have successfully used the command-line version of 7-Zip in a commercial product that had to zip medical charts along with database files for transfer via FTP.  The number of files involved were many and often very large (hundred's of megabytes in some cases).

It performed flawlessly and is very fast in my opinion.

http://sourceforge.net/projects/sevenzip/

Keep it in mind as an alternative to winzip and/or pkzip.

Idle_Mind
0
 
LVL 1

Author Comment

by:anand2k
ID: 9864253
hi aelatik,

Sorry for delay in my response.

I m just testing ur fiels and it is giving great results. !!!

PLease be patient till my testing finishes. Just 2-3 days more.

Thx
Anand
0
 

Expert Comment

by:bomax
ID: 9894592
Hello all,

I have been following this thread closely.  I am able to add files to zips, but for some reason I cannot seem to add relative directors.  For example in my zip file I want the following files:

test.scr
\Media\image1.jpg
\Media\image2.jpg

I can add test, image1 and image2 to a zip, however when I try to use relative dirs so I can keep the two images files in the Media folder, the program crashes.  Any ideas?

Here is the code:
    Set m_cZ = New cZip
    With m_cZ
    .ZipFile = "C:\test.zip"
    .ClearFileSpecs
    .StoreFolderNames = False
    .BasePath = txtLocalDest.Text
    .AddFileSpec txtName.Text & ".scr"
    X = Dir(txtLocalDest.Text & "\Media\*.*")
    Do While X <> ""
        .AddFileSpec "\Media\" & X
        X = Dir()
    Loop
    .Zip  ** This is when it crashes **
    End With
0

Featured Post

Enabling OSINT in Activity Based Intelligence

Activity based intelligence (ABI) requires access to all available sources of data. Recorded Future allows analysts to observe structured data on the open, deep, and dark web.

Join & Write a Comment

Introduction While answering a recent question about filtering a custom class collection, I realized that this could be accomplished with very little code by using the ScriptControl (SC) library.  This article will introduce you to the SC library a…
This article describes some techniques which will make your VBA or Visual Basic Classic code easier to understand and maintain, whether by you, your replacement, or another Experts-Exchange expert.
As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…

747 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

10 Experts available now in Live!

Get 1:1 Help Now