Using VB6 + WSH with Windows Compression - windows

Having trouble with WSH and Windows Compression.
My goal is to be able to zip up files (not folders, but individual files from various locations, which I have stored in an array) using the built-in Windows Compression. I am using VB6.
Here is my routine (vb6 code):
Dim objShell
Dim objFolder
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.namespace(savePath & "\export.zip")
' --
' loop through array holding files to zip
For i = 0 To filePointer
objFolder.CopyHere (filesToZip(i))
Next
' --
Set objShell = Nothing
Set objFolder = Nothing
It works, but issues arise when there are more than a few files. I start getting errors from Windows (presumably, its calling the compression too fast, and the zip file is locked). I cant seem to figure out how to WAIT until the COPYHERE function completes before calling the next one to avoid issues.
Does anyone have any experience with this?
Thanks -

You should be able to achieve that sort of synchronization by checking the file count in your target ZIP folder before proceeding to the next loop iteration (as suggested here and here):
For i = 0 To filePointer
objFolder.CopyHere filesToZip(i)
Do Until objFolder.Items.Count = i+1
WScript.Sleep 100
Loop
Next

Related

.VBS called by .BAT to create .zip - run silently (without interface)?

I have a .bat file which I use to back up files, which calls a .vbs and passes it two parameters, as follows:
...
ZipCMD.vbs "C:\Source" "C:\Destination\Data.zip"
...
ZipCMD.vbs contains the following code (Credit to garbb):
Set objArgs = WScript.Arguments
Set FS = CreateObject("Scripting.FileSystemObject")
InputFolder = FS.GetAbsolutePathName(objArgs(0))
ZipFile = FS.GetAbsolutePathName(objArgs(1))
CreateObject("Scripting.FileSystemObject").CreateTextFile(ZipFile, True).Write "PK" & Chr(5) & Chr(6) & String(18, vbNullChar)
Set objShell = CreateObject("Shell.Application")
Set source = objShell.NameSpace(InputFolder).Items
numfolderitems = objShell.NameSpace(InputFolder).Items.count
objShell.NameSpace(ZipFile).CopyHere(source)
' wait until number of items in zip file is the same as in the folder we are zipping up
' also sometimes gets errors when getting folder object for zip file, probably because it is in use? so ignore these
On Error Resume Next
Do while True
numitemsinzip = objShell.NameSpace(ZipFile).Items.count
If Err.Number = 0 and numitemsinzip = numfolderitems Then
Exit Do
ElseIf Err.Number <> 0 then
Err.Clear
End If
wScript.Sleep 10
Loop
On Error Goto 0
When the zipping is occurring, the usual windows 'Compressing files' interface appears, and shows the progress bar ticking along for a few minutes, before closing and disappearing.
Question: Can vbs run a compression silently (i.e. without interface)? -- I've read this article, which shows a flag, however this doesn't appear to work with copying to .zip, for some reason.
Follow-up question: If it's not possible for the .vbs which I'm using to achieve this, then is there an alternative way, which still utilises calling another file/process(?) (.vbs / .js, or other?) and feeding it the two paths from cmd?
Edit: I'm trying to achieve this without the use of third-party software (e.g. 7zip), and simply using native windows code.
Suppose I am almost 3 months late on this, but if you have powershell version 5 or later, you can simply create a powershell script:
Compress-Archive "C:\Source" "C:\Destination\Data.zip"
or from a batch file:
powershell Compress-Archive "C:\Source" "C:\Destination\Data.zip"
Also see this option

VBScript Continues Loop to Rename File

Trying to create a VBScript that loops continuously until it finds the specific file and renames it to a different extension with minute and seconds:
do
Set fso = CreateObject("Scripting.FileSystemObject")
Set myFile = fso.GetFile("C:\Users\user\Downloads\test.txt")
If (fso.FileExists(myFile)) Then
myFile.Move "C:\Users\user\Downloads\test.xml"
End If
WScript.Sleep 1000
loop
The above works and renames the file but when looped it errors with "file cannot be found". Will need to add a else statement but having a hard time doing that.
Try checking for the files existence first before attempting to instantiate the File object reference.
Dim fso, myFile, source, dest
Set fso = CreateObject("Scripting.FileSystemObject")
Do
source = "C:\Users\user\Downloads\test.txt"
dest = "C:\Users\user\Downloads\test.xml"
If fso.FileExists(source) Then
Set myFile = fso.GetFile(source)
Call myFile.Move(dest)
Set myFile = Nothing
End If
WScript.Sleep 1000
Loop
Set fso = Nothing
* This is a pseudo coded example based on the original example
Moved the fso instantiation outside of the loop to avoid re-instantiating it on each iteration.
At present not sure what purpose the loop serves but if you are going to be running this for long periods it best to un-instantiate any references to help with script memory optimisation by setting them to Nothing.
Would also recommend while testing the loop to limit the iterations using a counter and exiting the loop if the count is exceeded.

Using VBScript to examine properties of files within a zip file

I'm trying to use VBScript to examine the contents of several hundred .zip files. Essentially what I want to do is run through each .zip and find all of the files wihtin that zip file. For each one of these files within the zip, I want to record some information about it to an Oracle database. That information being: file name and file modified date.
So far, my solution has been extracting each zips folder structure to a temp folder then running through the temp folder with an fso object. However, this has been proven to be very slow.
Is there a way to accoplish this without unziping the zip files?
Ouch man. I have never heard of vbscript zip object. But it has been a long time since I have done vbscript. Is there anyway you can avoid it?
I did some googling for you. I did find this: http://www.example-code.com/vbscript/zip_List.asp Chilkat has done a lot of stuff I thought not possible. This gives me the impression - that what you are trying to do is not going to be painless.
If given the problem you have I would find a different solution than vbscript. But if you pull-it-off I would vote for you to be mayor of vb land
You can do it in place with Shell Objects. But it will be just as slow, maybe. If just name and date Explorer may get it direct from the zip directory (at the end of the file so the whole file still needs to be read).
This copies items in a folder to another folder. A zip file is a folder so it will copy in and copy out.
To Zip
Set objShell = CreateObject("Shell.Application")
Set Ag=Wscript.Arguments
set WshShell = WScript.CreateObject("WScript.Shell")
Set SrcFldr=objShell.NameSpace(Ag(1))
Set DestFldr=objShell.NameSpace(Ag(0))
Set FldrItems=SrcFldr.Items
DestFldr.CopyHere FldrItems, &H214
Msgbox "Finished"
To Unzip (note SrcFolder and DestFolder are reversed)
Set objShell = CreateObject("Shell.Application")
Set Ag=Wscript.Arguments
set WshShell = WScript.CreateObject("WScript.Shell")
Set DestFldr=objShell.NameSpace(Ag(1))
Set SrcFldr=objShell.NameSpace(Ag(0))
Set FldrItems=SrcFldr.Items
DestFldr.CopyHere FldrItems, &H214
Msgbox "Finished"
To Create a blank zip. (I should have used an ADODB binary stream rather than an FSO text stream, but it shouldn't matter)
Set Ag=Wscript.Arguments
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.OpenTextFile(Ag(0), 8, vbtrue)
BlankZip = "PK" & Chr(5) & Chr(6)
For x = 0 to 17
BlankZip = BlankZip & Chr(0)
Next
ts.Write BlankZip

Can I list apps that don't have registry entries?

I've been working on a way to quickly and easily list all of the software installed on my machine. Once complete, I'd like to send it out to my group so that I can have everyone run it. Since the purpose of this exercise is generate a list of all of the applications that we absolutely require access to to our IT administrators, I don't want to miss anything important.
Up to this point, I've used code very similar to this - it looks in the registry at SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\ and Software\Wow6432Node\Microsoft\Windows\CurrentVersion\Uninstall\ and gives me all of the software that has been installed. However, a bunch of important programs are conspicuously absent (e.g. R, RStudio, SQL Developer), and I assume it's because they do not use Windows Installers.
This brings me to my question - is there a way I can list all of the programs that can be run on my machine (that have not impacted the registry)? Essentially, I think I want all of the non-system *.exe files, but that is probably oversimplifying things.
Anyone have any ideas? My code is VBS now, but I can muddle my way through most things.
If you want to find them all then you need to search every single file on your machine and check whether or not it has an executable extension. I'm reasonably confident that you are not going to want to do this.
I read your answer and laughed, since I was also "reasonably confident" that I did not want to go through all of the files on my (or anyone else's) machine. Once the laughing stopped, I realized that that's essentially what I had to do...
I've come up with something that works, and it now takes minutes to run (it took seconds to only check the registry), but it does work. I'm putting it here in case it can assist someone else, or maybe someone can find a way to make it more efficient. You need to supply some paths to folders where you want to look for exe files, and a file that you want to output to.
Thanks for reading.
On Error Resume Next
Folders = Array("C:\users\me","C:\SoftwareFolder1","C:\SoftwareFolder2","C:\SoftwareFolder3")
sFile="C:\myExeFiles.txt"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Const ForReading = 1
Const ForWriting = 2
Const OverwriteIfExist = -1
Set fFile = objFSO.CreateTextFile(sFile, OverwriteIfExist, OpenAsASCII)
For Each x In Folders
Set objFolder = objFSO.GetFolder(x)
suckTheData objFSO, fFile, objFolder
Set objFolder = Nothing
Next
MsgBox("Done")
Set objFSO = Nothing
Sub suckTheData(objFSO, fFile, objFolder)
' *** STEP 1 *** 'Find files with a partiular extension in this folder
For Each objFile In objFolder.Files
If UCase(objFSO.GetExtensionName(objFile.Name))="EXE" Then
fFile.Write objFile & vbCrLf
If Err.Number <> 0 Then
fFile.Write "Error: " & objFile & " " & Err.Number & Err.Source & " " & Err.Description & vbCrLf
End If
End If
Next
Set objFile = Nothing
' *** STEP 2 *** 'Now that we've processed files, repeat for subdirectories
For Each subf In objFolder.SubFolders
'some folders can't/shouldn't be checked -
'16 is a normal folder, 32 is an archive, 1046 is symbolic, etc
If subf.Attributes ="16" Then
suckTheData objFSO, fFile, subf
End If
Next
Set subf = Nothing
End Sub

Is there a size limit for a .zip file using CopyHere in VBScript?

I have a vbscript that extracts multiple zip files to different locations. The code works for all but one file. This one file, that doesn't work, happens to be bigger than 6GB. The next, biggest, file that I am processing is around 3.5GB.
Here's a snippet of the code;
strFileDest = "path\to\some\dir1"
strZIPname = "file1.zip"
Call UnPack(strFileDest, strZIPname)
strFileDest = "path\to\some\dir2"
strZIPname = "file2.zip"
Call UnPack(strFileDest, strZIPname)
Function UnPack(strZIPdest, strZIPname)
Dim intOptions, objShell, objSource, objTarget
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject("Shell.Application")
sSourceFile = objFSO.GetAbsolutePathName(strZIPname)
Set objSource = objShell.NameSpace(sSourceFile).Items()
Set objTarget = objShell.NameSpace(strZIPdest)
intOptions = 256
If objFSO.FolderExists(strZIPdest) Then
objTarget.CopyHere objSource, intOptions
Else
MsgBox "Cannot complete unzip for " & strZIPname & ". The destination _
directory (" & strZIPdest & ") could not be located.", 0, "Invalid"
End If
End Function
I have taken a smaller zip and renamed it as the zip that won't copy. With the new size, the script will unzip that file proving that the rest of the script for that file works. I have also verified that the zip is valid by manually extracting it. When I run the script with it pointing at the large zip, I receive no errors either (I'm not using On Error resume next).
Yes there is. As far as I know it's around 2GB, though it's undocumented I've encountered it before. If you need to compress something larger than that, use the command line version of 7zip.
Here is a VBScript wrapper I wrote for 7zip.
From windows Vista, zip64 is supported for reading. But creation of compressed folders seems to be limited to classic zip format. 4GB max file size, 65535 entries in zip file. And microsoft has documented problems in windows xp for compressed folders larger than 2GB.

Resources