foldertozip = "c:\temp\aqw" ' change folder to suit, note no trailing \
zippath = foldertozip & "\" & Mid(foldertozip, InStrRev(foldertozip, "\") + 1) & ".zip"
f = FreeFile
Open zippath For Output As f
Print #f, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0) ' zip file header
Close f
Set sh = CreateObject("shell.application")
Set n = sh.namespace(zippath)
n.copyhere foldertozip
this will create a zip file in the folder to be zipped, all files and sub folders are zipped into the archive, any existing zip file of the same name will be overwritten, tested to produce correct result
i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case. Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next
dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part
come back and mark your original post as resolved if your problem is fixed
pete
Thanks both. Looking first at Westconn1's because it is shorter, I get where to specify the input folder but I'm not sure where you specify the output zip location. I want that to be in My Documents and not within itself. Is that perhaps zippath?
Personally, I'd highly recommend wqweto's ZipArchive. I've used it for a couple of years now and never had one bit of trouble with it.
Good Luck,
Elroy
Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.
just specify the string to the path\zipfile you want in zippath
i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case. Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next
dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part
come back and mark your original post as resolved if your problem is fixed
pete
I use Chris Eastwood's DLLs, which do not require installation. You just place the two DLLs into the same folder as the application.
Here is a link to his web page - https://www.codeguru.com/vb/gen/vb_g...VB5-or-VB6.htm
His download includes his project, and the two DLLs.
I have refined it slightly, and have attached the project (I excluded the DLLs, as I believe our forum rules forbid attaching them)
foldertozip = "c:\temp\aqw" ' change folder to suit, note no trailing \
zippath = foldertozip & "\" & Mid(foldertozip, InStrRev(foldertozip, "\") + 1) & ".zip"
f = FreeFile
Open zippath For Output As f
Print #f, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0) ' zip file header
Close f
Set sh = CreateObject("shell.application")
Set n = sh.namespace(zippath)
n.copyhere foldertozip
this will create a zip file in the folder to be zipped, all files and sub folders are zipped into the archive, any existing zip file of the same name will be overwritten, tested to produce correct result
Sorry Westcott1, I totally failed with the above. After Dimming As I thought was needed, I did indeed get a file with .zip on the end, but it had nothing in it. I would like you to tell me what Dims etc. I need and if the Reference should be as I asked.
foldertozip is a variant
zippath is a variant
f is integer
as i used late binding no reference is required
sh and n are objects
or in this case, all could be variants
if you really want to use early binding, reference as you asked above
sh would be a shell
n would be a shell32.folder3
if you do not want to use variables of type variant, you could use string, but may have to convert to variant when passing to a shell object, like
Code:
Set n = sh.namespace(cvar(zippath))
i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case. Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next
dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part
come back and mark your original post as resolved if your problem is fixed
pete
Good intentions. The built-in stuff is slow, though, and offers only lousy compression. You might find out what the user has already installed (->registry: HKEY_CLASSES_ROOT\.zip), and use that tool. Their commandline syntax is widely harmonised.
Many thanks to everyone that responded, and especially to Westconn1, whose solution I have used. I am showing the code as slightly modified, below.
You'll see that instead of placing the zipped file holding the folder in the folder itself I have placed it in the folder above in the hierarchy , being My Documents, which is working fine.
I have one difficulty.
For background, the purpose of this exercise is to determine the best way to automate preparation of a zip file with certain critical information for a remote user, to be used to email some updated files in the case of my incapacity. In that case my wife (who is not really computer literate) would not be able to advise him.
The problem here is, looking at the zip file, as my remote correspondent will do, and seeing that it is a zip file, he will no doubt right click on it, and be offered extract, whereupon he will get the message that (in this test case) 'File will be extracted to this folder C:\Users\Alan\Documents\aatest. Is there some way of avoiding that message so that the folder is extracted to his own master folder. Incidentally, if I just click on it, the extraction occurs anyway.
Code:
Option Explicit
Dim aPath As String
Private Sub Form_Load()
aPath = "C:\Users\Alan\Documents\"
End Sub
Private Sub cmdDoIt_Click()
'** a Stuff
Dim aSource As String
Dim aDest As String
aSource = aPath & "aatest"
aDest = aPath
'Westconn1 remarked:
'as I used late binding no reference is required
'if you really want to use early binding, reference as you asked above
'sh would be a shell; n would be a shell32.folder3
'Westconn1's
Dim foldertozip As Variant
Dim zippath As Variant
Dim f As Integer
Dim sh As Object
Dim n As Object
foldertozip = aSource ' change folder to suit, note no trailing \
zippath = aDest & Mid(foldertozip, InStrRev(foldertozip, "\") + 1) & ".zip"
f = FreeFile
Open zippath For Output As f
Print #f, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0) ' zip file header
Close f
Set sh = CreateObject("shell.application")
Set n = sh.NameSpace(zippath)
n.CopyHere foldertozip
End Sub
he will no doubt right click on it, and be offered extract,
this varies depending on which, if any, zip program he has installed
i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case. Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next
dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part
come back and mark your original post as resolved if your problem is fixed
pete
This can be invoked using command-line arguments to accomplish the task if you don't want to deal with using the GUI it offers.
You can use the encryption, or not. Your choice. You can use an XML config file to drive the process so fewer command line arguments need to be supplied.
The feature you might be interested in is:
-d <pre_defined_unzip_dir>
Creates an EXE that will unzip to a pre-defined, hard-coded absolute directory path. Environment variables delimited with "%" characters can be used, such as "%TEMP%" or "%PROGRAMFILES%".
The bonus is that for the last few years it has become an unsupported tool, but now is completely free. That page at the link above contains the key required to unlock all of the premium features.
This is even handy for people who create applications that use an Activation Context manifest for reg-free COM and want to bundle their application up into one installer file. It can even unzip to a temporary location and run a bundled setup program as needed.
I love Chilkat's stuff too, but a glowing recommendation from Dilettante is a bit of a shocker! Linking to a closed-source (AFAIK), unsupported, mystery black-box EXE (and even the word "bonus" is in the post)! I don't know whether to be or , guess I'll go with
It is a stable product with no future churn to deal with.
Its signature is recognized by anti-malware suites because it is an established and commonly used self-extracting EXE format.
They admit that there is no future support, so you know you are using it "at your own risk" (minimal).
So unlike some other products, it has a lot going for it.
As for the "open source" question... That means far less to me than other issues. I've stopped posting finished tested non-trivial projects here, not because I am ripping off open source and sticking my name on it, but because I am tired of being ripped off myself.
I've stopped posting finished tested non-trivial projects here, not because I am ripping off open source and sticking my name on it, but because I am tired of being ripped off myself.
Just to make it clear for other readers, dilettante does not mean the RC5-libs with that "rip-off"-comment
(because if he did, he'd be lying, and he doesn't do that of course, far from it ).
Async is almost always more convenient when dealing with files. Not that it wouldn't be trivial to wait if you wanted. Besides, it the one by westconn1 that el84 is using is async too.
And I wasn't debating merits, just pointing out another way to do things, sorry if that's unwelcome.
Async is almost always more convenient when dealing with files. Not that it wouldn't be trivial to wait if you wanted. Besides, it the one by westconn1 that el84 is using is async too.
And I wasn't debating merits, just pointing out another way to do things, sorry if that's unwelcome.
Nothing is unwelcome. Especially to permanent newbs like me! But Wstconn1's solution fits my needs admirably,
Not that it wouldn't be trivial to wait if you wanted.
Not that it's unwelcome but I'm yet to see a waiting sample. A sync implementation would be very useful -- if the client app can get away w/ the progress dialog that is.
However trivial sync/waiting impl is I personally failed producing stable solution last time I attempted this. The trick mentioned some output file change tracking approach that might be useful.
@wqweto yeah that sounds like what I had in mind; since it's a shell interface, you can reliably count on a SHChangeNotify broadcast: an initial SHCNE_CREATE, followed by one SHCNE_UPDATEITEM per add operation; you only need to set the watch on the target directory. Let me look into it further a bit though as I just found a complication confirming those messages... there's no notification for a canceled operation (if the operation takes more than a few seconds Windows pops up a CLSID_ProgressDialog window with a Cancel option, and obviously monitoring this too renders the whole thing more trouble than avoiding the DLL saves)
As fafalone wrote, you can using only standard dependencies of system to zip/unzip.
To wait for complete zipping you can use INewMenuClient or SHChangeNotifyRegister. With SHChangeNotifyRegister you can get rid of Explorer window.
@The trick: Is there a simple way to see if the operation is cancelled? For large operations, Explorer shows a progress dialog with a Cancel button-- and if cancelled, there are no SHCNE_ messages at all. Every way I can think of is too big an inconvenience.
Also, could you elaborate on INewMenuClient usage here?
fafalone, about the progress window i'll answer later (i don't remember all details).
You can implement INewMenuClient and IServiceProvider interfaces and using IObjectWithSite.SetSite (you get it from IDropTarget) set your object as site.
When zipping is being performed it'll call IServiceProvider::QueryService with IID_INewMenuClient. You can pass your implementation of that interface and it'll call SelectAndEditItem method when zipping done.
This seems to be an entirely different technique; you're implementing IDropTarget too? Or if not how are you telling it which file is the drop target? Possible to just post a demo?
Edit: For reference, here's the method I've been using (error checking and debug prints removed for readability),
Code:
Public Sub ZipFiles(sZipPath As String, pszToZip() As String)
Dim pZipStg As IStorage
Dim pZipStrm As IStream
Dim psfZipFolder As IShellFolder
Dim pidlZipFolder As Long
Dim pDT As IDropTarget
Dim pidlToZip() As Long
Dim idoToZip As IDataObject
Dim pidlToZip2() As Long
Dim idoToZip2 As IDataObject
Dim pszZipFile As String 'name of zip file only, e.g. blah.zip
Dim pszZipFolder As String 'full path to folder that will contain .zip
Dim pidlZipFile As Long
Dim pchEaten As Long
Dim q As Long
Dim bMulti As Boolean
ReDim pidlZip(0)
ReDim pidlToZip(0)
pszZipFolder = Left$(sZipPath, InStrRev(sZipPath, "\") - 1)
pszZipFile = Right$(sZipPath, Len(sZipPath) - InStrRev(sZipPath, "\"))
pidlToZip(0) = ILCreateFromPathW(StrPtr(pszToZip(0)))
If UBound(pszToZip) > 0 Then
ReDim pidlToZip2(UBound(pszToZip) - 1)
For q = 1 To UBound(pszToZip)
pidlToZip2(q - 1) = ILCreateFromPathW(StrPtr(pszToZip(q)))
Next
bMulti = True
End If
pidlZipFolder = ILCreateFromPathW(StrPtr(pszZipFolder))
Set psfZipFolder = GetIShellFolder(isfDesktop, pidlZipFolder)
Set pZipStg = psfZipFolder 'this calls QueryInterface internally
Set pZipStrm = pZipStg.CreateStream(pszZipFile, STGM_CREATE, 0, 0)
psfZipFolder.ParseDisplayName 0&, 0&, StrPtr(pszZipFile), pchEaten, pidlZipFile, 0&
Call SHCreateFileDataObject(VarPtr(0&), UBound(pidlToZip) + 1, VarPtr(pidlToZip(0)), ByVal 0&, idoToZip)
Dim pidlFQZF As Long
pidlFQZF = ILCombine(pidlZipFolder, pidlZipFile)
pDT.DragEnter idoToZip, MK_LBUTTON, 0&, 0&, DROPEFFECT_COPY
pDT.Drop idoToZip, MK_LBUTTON, 0&, 0&, DROPEFFECT_COPY
If bMulti Then
Sleep 1500
DoEvents
Sleep 1500
Call SHCreateFileDataObject(VarPtr(0&), UBound(pidlToZip2) + 1, VarPtr(pidlToZip2(0)), ByVal 0&, idoToZip2)
pDT.DragEnter idoToZip2, MK_LBUTTON, 0, 0, DROPEFFECT_COPY
pDT.Drop idoToZip2, MK_LBUTTON, 0, 0, DROPEFFECT_COPY
End If
clnup:
CoTaskMemFree pidlToZip(0)
If bMulti Then
For q = 0 To UBound(pidlToZip2)
Call CoTaskMemFree(pidlToZip2(q))
Next
End If
Call CoTaskMemFree(pidlZipFile)
Call CoTaskMemFree(pidlZipFolder)
Call CoTaskMemFree(pidlFQZF)
End Sub
Last edited by fafalone; Feb 9th, 2018 at 07:21 AM.
fafalone, i'll make the examples later because all of the reversing researches are in the raw state (i temporary left these researches about 6 month ago).
Edit: For reference, here's the method I've been using (error checking and debug prints removed for readability),
Yes i saw it. It's very useful code.
I show a small example with the notification:
Form:
Code:
Option Explicit
Implements oleexpimp.IServiceProvider
Implements INewMenuClient
Private Sub Form_Load()
Dim sFolderToZip As String
Dim cFSO As FileSystemObject
Dim cFolder As Folder
Dim cFile As File
Dim cDataObject As IDataObject
Dim cDropTarget As IDropTarget
Dim cObjectWithSite As IObjectWithSite
Dim tCLSID As UUID
Dim tIID As UUID
Dim lPidls() As Long
Dim lIndex As Long
Dim hr As Long
sFolderToZip = "E:\Temp\S"
Set cFSO = New FileSystemObject
Set cFolder = cFSO.GetFolder(sFolderToZip)
ReDim lPidls(cFolder.Files.Count + cFolder.SubFolders.Count - 1)
For Each cFile In cFolder.Files
lPidls(lIndex) = ILCreateFromPathW(StrPtr(cFile.Path))
lIndex = lIndex + 1
Next
For Each cFolder In cFolder.SubFolders
lPidls(lIndex) = ILCreateFromPathW(StrPtr(cFolder.Path))
lIndex = lIndex + 1
Next
hr = SHCreateFileDataObject(VarPtr(Nothing), UBound(lPidls) + 1, lPidls(0), ByVal 0&, cDataObject)
If hr < 0 Then
MsgBox "SHCreateFileDataObject failed " & hr, vbCritical
Exit Sub
End If
CLSIDFromString CLSID_CSendTo, tCLSID
IIDFromString StrPtr(IID_IDropTarget), tIID
hr = CoCreateInstance(tCLSID, Nothing, CLSCTX_INPROC_SERVER, tIID, cDropTarget)
If hr < 0 Then
MsgBox "CoCreateInstance failed " & hr, vbCritical
Exit Sub
End If
Set cObjectWithSite = cDropTarget
HookIServiceProvider Me
cObjectWithSite.SetSite Me
cDropTarget.DragEnter cDataObject, MK_LBUTTON, 0&, 0&, DROPEFFECT_COPY
cDropTarget.Drop cDataObject, MK_LBUTTON, 0&, 0&, DROPEFFECT_COPY
End Sub
Private Sub INewMenuClient_IncludeItems(pFlags As Long)
End Sub
Private Sub INewMenuClient_SelectAndEditItem(ByVal pidlItem As Long, ByVal flags As Long)
Dim sBuf As String
sBuf = Space$(MAX_PATH)
SHGetPathFromIDList pidlItem, StrPtr(sBuf)
sBuf = Mid$(sBuf, 1, InStr(1, sBuf, vbNullChar) - 1)
MsgBox "Archive " & sBuf & " has been created"
End Sub
Private Sub IServiceProvider_QueryService(guidService As oleexp.UUID, riid As oleexp.UUID, ppvObject As Long)
' // Stub
End Sub
Module:
Code:
Option Explicit
Public Declare Function SHParseDisplayName Lib "shell32" ( _
ByVal pszName As Long, _
ByVal IBindCtx As Long, _
ByRef ppidl As Long, _
ByRef sfgaoIn As Long, _
ByRef sfgaoOut As Long) As Long
Public Declare Function ILFree Lib "shell32" ( _
ByVal pidlFree As Long) As Long
Public Declare Function SHCreateFileDataObject Lib "shell32" _
Alias "#740" ( _
ByVal pidlFolder As Long, _
ByVal cidl As Long, _
ByRef apidl As Any, _
ByRef pDataInner As Any, _
ByRef ppDataObj As IDataObject) As Long
Public Declare Function ILCreateFromPathW Lib "shell32" ( _
ByVal pwszPath As Long) As Long
Public Declare Function IIDFromString Lib "ole32" ( _
ByVal lpszIID As Long, _
ByRef iid As Any) As Long
Public Declare Function IsEqualGUID Lib "ole32" ( _
ByRef rguid1 As Any, _
ByRef rguid2 As Any) As Boolean
Public Declare Function GetMem4 Lib "msvbvm60" ( _
ByRef src As Any, _
ByRef Dst As Any) As Long
Public Declare Function VirtualProtect Lib "kernel32" ( _
ByRef lpAddress As Any, _
ByVal dwSize As Long, _
ByVal flNewProtect As Long, _
ByRef lpflOldProtect As Long) As Long
Public Declare Function SHGetPathFromIDList Lib "shell32" _
Alias "SHGetPathFromIDListW" ( _
ByVal pidList As Long, _
ByVal lpBuffer As Long) As Long
Public Const CLSID_CSendTo = "{888DCA60-FC0A-11CF-8F0F-00C04FD7D062}"
Public Const IID_IDropTarget = "{00000122-0000-0000-C000-000000000046}"
Public Const IID_INewMenuClient = "{dcb07fdc-3bb5-451c-90be-966644fed7b0}"
Public Const PAGE_READWRITE = 4&
Public Const MK_LBUTTON = 1
Public Sub HookIServiceProvider( _
ByVal cServiceProvider As IServiceProvider)
Dim pMethods(3) As Long
Dim pVtable As Long
Dim dwOldProtect As Long
GetMem4 ByVal ObjPtr(cServiceProvider), pVtable
MoveMemory pMethods(0), ByVal pVtable, (UBound(pMethods) + 1) * 4
pMethods(3) = FAR_PROC(AddressOf IServiceProvider_QueryService)
VirtualProtect ByVal pVtable, (UBound(pMethods) + 1) * 4, PAGE_READWRITE, dwOldProtect
MoveMemory ByVal pVtable, pMethods(0), (UBound(pMethods) + 1) * 4
VirtualProtect ByVal pVtable, (UBound(pMethods) + 1) * 4, dwOldProtect, dwOldProtect
End Sub
Private Function FAR_PROC( _
ByVal ptr As Long) As Long
FAR_PROC = ptr
End Function
Private Function IServiceProvider_QueryService( _
ByVal cObj As IServiceProvider, _
ByRef guidService As oleexp.UUID, _
ByRef riid As oleexp.UUID, _
ByRef ppvObject As Long) As Long
Dim tIID As UUID
Dim cUnk As oleexp.IUnknown
IIDFromString StrPtr(IID_INewMenuClient), tIID
ppvObject = 0
If IsEqualGUID(guidService, tIID) And IsEqualGUID(riid, tIID) Then
Set cUnk = cObj
cUnk.AddRef
ppvObject = ObjPtr(cUnk)
Else
IServiceProvider_QueryService = E_NOINTERFACE
End If
End Function
Don't see to code quality it was made for research purposes only.
Last edited by The trick; Feb 9th, 2018 at 09:06 AM.
Very interesting thank you... perhaps I'm not seeing, how do you tell it the destination file? There's pidlItem, but how's that set? Since it's the SendTo object does it just automatically get created in the current folder then you'd have to move to destination?
fafalone, as far as i remember it uses the path from the first item of the DataObject object.
It gets the name using SHGetItemFromDataObject and pShellItem.GetDisplayName(SIGDN_PARENTRELATIVEPARSING) then it calls PathStripExtension and appends ".zip" extension. For path it uses SIGDN_FILESYSPATH and PathRemoveFileSpecW.
Last edited by The trick; Feb 10th, 2018 at 02:46 AM.
Bonus chatter: On of the terms of the license is that the compression and decompression code for Zip folders should be tied to UI actions and not be programmatically drivable. The main product for the company that provided the compression and decompression code is the compression and decompression code itself. If Windows allowed programs to compress and decompression files by driving the shell namespace directly, then that company would have given away their entire business!
This is why Zip folders may work really well when manipulated in the user interface, but they aren't very helpful when you try to use them programmatically. They don't tell you when a Copy operation is done. They display password prompts for password-protected ZIP files, even if you said not to display UI. Various annoyances to make it impractical to use the Zip folders compression and decompression engine programmatically.
They made it on purpose not usable by anything but end-user UI.
Was it licensed from WinZip or PKWare I'm wondering. . .
https://www.7-zip.org/sdk.html has a bunch of free\open tools for zipping. 7zr.exe is easy to use and supports strong encryption and split volumes for large zips if you need them.
If the array of parameters passed in is multiple folders and files, a warning pops up:
[Window Title]
zipped folders
[Content]
Windows cannot add one or more empty directories to a zipped folder.
[confirm]
If the subdirectory is empty, the ZIP folder will not be added to the empty directory. How to solve this problem?