Zip a file programatically

Help why doesn't this zip work it creates the .ZIP file but does not
copy the source to it?!??! No errors, I can drag files into the .zip
created with the script what gives?
Also tried different source and locations -thanks.
Option Explicit

Dim MySource, MyTarget, MyZipName, MyHex, MyBinary, i
Dim oShell, oApp, oFolder, oFileSys, oCTF

MySource = "C:\tmp"
MyZipName = "SinkFolder"

MyHex = Array(80, 75, 5, 6, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0)
For i = 0 To UBound(MyHex)
MyBinary = MyBinary & Chr(MyHex(i))
Next

Set oShell = CreateObject("WScript.Shell")
MyTarget = "C:\temp\" & MyZipName & ".zip"

Set oFileSys = CreateObject("Scripting.FileSystemObject")
Set oCTF = oFileSys.CreateTextFile(MyTarget, True)
oCTF.Write MyBinary
oCTF.Close
Set oCTF = Nothing
Set oFileSys = Nothing

Set oApp = CreateObject("Shell.Application")
Set oFolder = oApp.NameSpace(MySource)
oApp.NameSpace(MyTarget).CopyHere oFolder.Items

Craig
Fri Oct 08 11:47:05 CDT 2004

WMI/WSH/VBscript doesn't know anything about the zip format.

One option is to use makecab.exe to script it. Makecab.exe is built into
2000/XP/2003. An example from the Directory Services version of the
MPSReports utility on the MS website:

Function Package()
Set txtCabDirect = fso.CreateTextFile(objLogs.Path &"\CABDIRECT.DDF", True)
txtCabDirect.WriteLine ";***MPS Reports 2000 MakeCAB Directive file" &
vbCrLf &_
";" & vbCrLf &_
".OPTION EXPLICIT" & vbCrLf &_
WshShell.ExpandEnvironmentStrings(".Set
CabinetNameTemplate=%COMPUTERNAME%_MPSReports.CAB") & vbCrLf &_
".set DiskDirectoryTemplate=.\cab" & vbCrLf &_
".Set MaxDiskSize=CDROM" & vbCrLf &_
".Set FolderSizeThreshold=2000000" & vbCrLf &_
".Set CompressionType=MSZIP" & vbCrLf &_
".Set Cabinet=on" & vbCrLf &_
".Set Compress=on"
For Each oFile In objLogs.Files
If UCASE(WshShell.ExpandEnvironmentStrings("%COMPUTERNAME%")) = _

UCase(Left(oFile.Name,Len(WshShell.ExpandEnvironmentStrings("%COMPUTERNAME%")))) Then txtCabDirect.WriteLine oFile.Path
Next
txtCabDirect.Close

Package = WshShell.Run("cmd /c cd /d %MPSLogs% & MakeCAB /f CABDIRECT.DDF
/L %MPSLogs%\cab", 7, TRUE)
End Function

"Red" wrote:

> Help why doesn't this zip work it creates the .ZIP file but does not
> copy the source to it?!??! No errors, I can drag files into the .zip
> created with the script what gives?
> Also tried different source and locations -thanks.
> Option Explicit
>
> Dim MySource, MyTarget, MyZipName, MyHex, MyBinary, i
> Dim oShell, oApp, oFolder, oFileSys, oCTF
>
> MySource = "C:\tmp"
> MyZipName = "SinkFolder"
>
> MyHex = Array(80, 75, 5, 6, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
> 0, 0, 0, 0, 0)
> For i = 0 To UBound(MyHex)
> MyBinary = MyBinary & Chr(MyHex(i))
> Next
>
> Set oShell = CreateObject("WScript.Shell")
> MyTarget = "C:\temp\" & MyZipName & ".zip"
>
> Set oFileSys = CreateObject("Scripting.FileSystemObject")
> Set oCTF = oFileSys.CreateTextFile(MyTarget, True)
> oCTF.Write MyBinary
> oCTF.Close
> Set oCTF = Nothing
> Set oFileSys = Nothing
>
> Set oApp = CreateObject("Shell.Application")
> Set oFolder = oApp.NameSpace(MySource)
> oApp.NameSpace(MyTarget).CopyHere oFolder.Items
>

Hal
Fri Oct 08 19:59:04 CDT 2004


"Red" <cap_sch@yahoo.co.uk> wrote in message
news:5eb6d95.0410080220.213176e0@posting.google.com...
> Help why doesn't this zip work it creates the .ZIP file but does not
> copy the source to it?!??! No errors, I can drag files into the .zip
> created with the script what gives?
> Also tried different source and locations -thanks.

if you use the dos version of pkzip "pkz204g.exe" - you cna zip files using
a shell command
but pkzip needs to be installed



---
Outgoing mail is certified Virus Free.
Checked by AVG anti-virus system (http://www.grisoft.com).
Version: 6.0.772 / Virus Database: 519 - Release Date: 10/1/2004

Johan
Sat Oct 09 03:12:35 CDT 2004

Info-zip may be an option. Also, WinZip has an API.

http://www.info-zip.org/

Regards, Johan Karlsson


"Red" <cap_sch@yahoo.co.uk> wrote in message
news:5eb6d95.0410080220.213176e0@posting.google.com...
> Help why doesn't this zip work it creates the .ZIP file but does not
> copy the source to it?!??! No errors, I can drag files into the .zip
> created with the script what gives?
> Also tried different source and locations -thanks.
> Option Explicit
>
> Dim MySource, MyTarget, MyZipName, MyHex, MyBinary, i
> Dim oShell, oApp, oFolder, oFileSys, oCTF
>
> MySource = "C:\tmp"
> MyZipName = "SinkFolder"
>
> MyHex = Array(80, 75, 5, 6, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
> 0, 0, 0, 0, 0)
> For i = 0 To UBound(MyHex)
> MyBinary = MyBinary & Chr(MyHex(i))
> Next
>
> Set oShell = CreateObject("WScript.Shell")
> MyTarget = "C:\temp\" & MyZipName & ".zip"
>
> Set oFileSys = CreateObject("Scripting.FileSystemObject")
> Set oCTF = oFileSys.CreateTextFile(MyTarget, True)
> oCTF.Write MyBinary
> oCTF.Close
> Set oCTF = Nothing
> Set oFileSys = Nothing
>
> Set oApp = CreateObject("Shell.Application")
> Set oFolder = oApp.NameSpace(MySource)
> oApp.NameSpace(MyTarget).CopyHere oFolder.Items

Joe
Sat Oct 09 03:31:05 CDT 2004

And ZipGenius...
"Johan Karlsson" <yohaan@tjohoo.se> wrote in message
news:OIFfcgdrEHA.1160@tk2msftngp13.phx.gbl...
> Info-zip may be an option. Also, WinZip has an API.
>
> http://www.info-zip.org/
>
> Regards, Johan Karlsson
>
>
> "Red" <cap_sch@yahoo.co.uk> wrote in message
> news:5eb6d95.0410080220.213176e0@posting.google.com...
>> Help why doesn't this zip work it creates the .ZIP file but does not
>> copy the source to it?!??! No errors, I can drag files into the .zip
>> created with the script what gives?
>> Also tried different source and locations -thanks.
>> Option Explicit
>>
>> Dim MySource, MyTarget, MyZipName, MyHex, MyBinary, i
>> Dim oShell, oApp, oFolder, oFileSys, oCTF
>>
>> MySource = "C:\tmp"
>> MyZipName = "SinkFolder"
>>
>> MyHex = Array(80, 75, 5, 6, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
>> 0, 0, 0, 0, 0)
>> For i = 0 To UBound(MyHex)
>> MyBinary = MyBinary & Chr(MyHex(i))
>> Next
>>
>> Set oShell = CreateObject("WScript.Shell")
>> MyTarget = "C:\temp\" & MyZipName & ".zip"
>>
>> Set oFileSys = CreateObject("Scripting.FileSystemObject")
>> Set oCTF = oFileSys.CreateTextFile(MyTarget, True)
>> oCTF.Write MyBinary
>> oCTF.Close
>> Set oCTF = Nothing
>> Set oFileSys = Nothing
>>
>> Set oApp = CreateObject("Shell.Application")
>> Set oFolder = oApp.NameSpace(MySource)
>> oApp.NameSpace(MyTarget).CopyHere oFolder.Items
>
>

jay
Sat Oct 09 06:22:04 CDT 2004

"Craig" <Craig@discussions.microsoft.com> wrote in message news:<2EBFFB3E-F61D-4290-9E37-6BB8A2981EFC@microsoft.com>...
> WMI/WSH/VBscript doesn't know anything about the zip format.

Right, but the Windows Shell does, so the attempt is to use the
automatic invocation of zipfldrs.dll that the shell application to
handle "zip folders" automagically.

Red, I found this code snippet the same place you did I imagine, and I
have the same problem. It appears to work but does not. Somebody's
going to figure this out soon I suspect. I just hope they post in a
language I speak/read.
>
> One option is to use makecab.exe to script it. Makecab.exe is built into
> 2000/XP/2003. An example from the Directory Services version of the
> MPSReports utility on the MS website:
>

Was hoping to avoid that...

<snip />

Christoph
Sat Oct 09 09:50:55 CDT 2004

08.10.2004 12:20, Red schrieb:

> Help why doesn't this zip work it creates the .ZIP file but does not
> copy the source to it?!??!

> Set oFolder = oApp.NameSpace(MySource)
> oApp.NameSpace(MyTarget).CopyHere oFolder.Items

would require MS to rewrite the implementation of
CopyHere-method for ShellFolders in order to also handle
zip-files as Targets.
Macromedia DW and HS afaik have scriptable zip-Api,
Progid for creation: "AllaireClientApp.TAllaireZIPProvider"


--
Gruesse, Christoph

Rio Riay Riayo - Gordon Sumner, 1979

Miyahn
Sat Oct 09 11:50:31 CDT 2004

"Red" wrote in message news:5eb6d95.0410080220.213176e0@posting.google.com
> Help why doesn't this zip work it creates the .ZIP file but does not
> copy the source to it?!??! No errors, I can drag files into the .zip
> created with the script what gives?
> Also tried different source and locations -thanks.

Try this "unreliable" script at your own risk.

Const ssfSendTo = 9, MySource = "C:\tmp", MyZipName = "C:\temp\SinkFolder.zip"
Dim WS, FS, SA, ZipFile
Set WS = CreateObject("WScript.Shell")
Set FS = CreateObject("Scripting.FileSystemObject")
Set SA = CreateObject("Shell.Application")
FS.CreateTextFile(MyZipName, True).Write _
Chr(80) & Chr(75) & Chr(5) & Chr(6) & String(18, Chr(0))
SA.Open SA.NameSpace(MyZipName)
WScript.Sleep 100
WS.SendKeys "%{F4}", True
FS.DeleteFile MyZipName
SelectItem MySource, ""
WS.SendKeys "^(ac)", True
WS.SendKeys "%{F4}", True
SelectItem ssfSendTo, "Compressed (zipped) Folder.ZFSendToTarget"
WS.SendKeys "+{F10}P", True
WS.SendKeys "%{F4}", True
ZipFile = FS.BuildPath(MySource, ZipFile)
Do Until FS.FileExists(ZipFile): WScript.Sleep 100: Loop
On Error Resume Next
Do
FS.GetFile(ZipFile).Move MyZipName
WScript.Sleep 100
Loop While Err
On Error GoTo 0
Set SA = Nothing: Set FS = Nothing: Set WS = Nothing
'
Sub SelectItem(Parent, Target)
SA.Open SA.NameSpace(Parent)
WScript.Sleep 100
For Each aWin In SA.Windows
If aWin.Document.Folder.Items.Item.Path = SA.NameSpace(Parent).Items.Item.Path Then
If Target <> "" Then
aWin.Document.SelectItem SA.NameSpace(Parent).ParseName(Target), 1
Else
ZipFile = FS.GetBaseName(aWin.Document.FocusedItem.Name) & ".zip"
End If
End If
Next
End Sub

--
Miyahn (Masataka Miyashita) JPN
Microsoft MVP (Office Systems - Excel)
HQF03250@nifty.ne.jp

Craig
Sat Oct 09 21:05:03 CDT 2004

Right, the Windows Shell can handle .zip files, but none of that is exposed
to WMI/WSH/VBScript so you can call it programmatically.

Here is some VB6 code to do it, but its somewhat of a kludge because it just
programmatically does the "send to compressed folder"

http://www.mvps.org/emorcillo/vb6/shell/xpzip.shtml

So that leaves you with calling winzip,winrar,makecab or whatever
compression utility you want from within your script. Or you can use
something like zlib - http://www.winimage.com/zLibDll/ - but that would
require calling it with VB, not vbscript. To make it accessible via vbscript,
you've have to roll your own COM object from it somehow.

"SumYungGuy" wrote:

> "Craig" <Craig@discussions.microsoft.com> wrote in message news:<2EBFFB3E-F61D-4290-9E37-6BB8A2981EFC@microsoft.com>...
> > WMI/WSH/VBscript doesn't know anything about the zip format.
>
> Right, but the Windows Shell does, so the attempt is to use the
> automatic invocation of zipfldrs.dll that the shell application to
> handle "zip folders" automagically.
>
> Red, I found this code snippet the same place you did I imagine, and I
> have the same problem. It appears to work but does not. Somebody's
> going to figure this out soon I suspect. I just hope they post in a
> language I speak/read.
> >
> > One option is to use makecab.exe to script it. Makecab.exe is built into
> > 2000/XP/2003. An example from the Directory Services version of the
> > MPSReports utility on the MS website:
> >
>
> Was hoping to avoid that...
>
> <snip />
>

cap_sch
Mon Oct 11 10:44:47 CDT 2004

Good god man your a genius it works.

jay
Mon Oct 11 18:49:29 CDT 2004

OK, Miyahn, your "unreliable" script works on WinXP SP2 if any
third-party zip utils are not installed. But I am having difficulty
making it work in Server 2003. I appreciate your help. But I am
beginning to lean like the others have posted about using 3rd party.
Or tackling my problem a different way.

Thanks

"Miyahn" <HQF03250@nifty.ne.jp> wrote in message news:<eG6#GAirEHA.2924@TK2MSFTNGP12.phx.gbl>...
> "Red" wrote in message news:5eb6d95.0410080220.213176e0@posting.google.com
> > Help why doesn't this zip work it creates the .ZIP file but does not
> > copy the source to it?!??! No errors, I can drag files into the .zip
> > created with the script what gives?
> > Also tried different source and locations -thanks.
>
> Try this "unreliable" script at your own risk.
>
> Const ssfSendTo = 9, MySource = "C:\tmp", MyZipName = "C:\temp\SinkFolder.zip"
> Dim WS, FS, SA, ZipFile
> Set WS = CreateObject("WScript.Shell")
> Set FS = CreateObject("Scripting.FileSystemObject")
> Set SA = CreateObject("Shell.Application")
> FS.CreateTextFile(MyZipName, True).Write _
> Chr(80) & Chr(75) & Chr(5) & Chr(6) & String(18, Chr(0))
> SA.Open SA.NameSpace(MyZipName)
> WScript.Sleep 100
> WS.SendKeys "%{F4}", True
> FS.DeleteFile MyZipName
> SelectItem MySource, ""
> WS.SendKeys "^(ac)", True
> WS.SendKeys "%{F4}", True
> SelectItem ssfSendTo, "Compressed (zipped) Folder.ZFSendToTarget"
> WS.SendKeys "+{F10}P", True
> WS.SendKeys "%{F4}", True
> ZipFile = FS.BuildPath(MySource, ZipFile)
> Do Until FS.FileExists(ZipFile): WScript.Sleep 100: Loop
> On Error Resume Next
> Do
> FS.GetFile(ZipFile).Move MyZipName
> WScript.Sleep 100
> Loop While Err
> On Error GoTo 0
> Set SA = Nothing: Set FS = Nothing: Set WS = Nothing
> '
> Sub SelectItem(Parent, Target)
> SA.Open SA.NameSpace(Parent)
> WScript.Sleep 100
> For Each aWin In SA.Windows
> If aWin.Document.Folder.Items.Item.Path = SA.NameSpace(Parent).Items.Item.Path Then
> If Target <> "" Then
> aWin.Document.SelectItem SA.NameSpace(Parent).ParseName(Target), 1
> Else
> ZipFile = FS.GetBaseName(aWin.Document.FocusedItem.Name) & ".zip"
> End If
> End If
> Next
> End Sub

Paul
Wed May 18 11:59:04 CDT 2005


Red wrote:
> *Help why doesn't this zip work it creates the .ZIP file but does
> not
> copy the source to it?!??! No errors, I can drag files into the .zip
> created with the script what gives?
> Also tried different source and locations -thanks.
> Option Explicit
>
> Dim MySource, MyTarget, MyZipName, MyHex, MyBinary, i
> Dim oShell, oApp, oFolder, oFileSys, oCTF
>
> MySource = "C:\tmp"
> MyZipName = "SinkFolder"
>
> MyHex = Array(80, 75, 5, 6, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
> 0, 0, 0, 0, 0)
> For i = 0 To UBound(MyHex)
> MyBinary = MyBinary & Chr(MyHex(i))
> Next
>
> Set oShell = CreateObject("WScript.Shell")
> MyTarget = "C:\temp\" & MyZipName & ".zip"
>
> Set oFileSys = CreateObject("Scripting.FileSystemObject")
> Set oCTF = oFileSys.CreateTextFile(MyTarget, True)
> oCTF.Write MyBinary
> oCTF.Close
> Set oCTF = Nothing
> Set oFileSys = Nothing
>
> Set oApp = CreateObject("Shell.Application")
> Set oFolder = oApp.NameSpace(MySource)
> oApp.NameSpace(MyTarget).CopyHere oFolder.Items *


Did you ever get this to wrk, using the code supplied with the
suggested tweaks I'm getting the zip file produced but then receiving
an error message "Cannot create or replace SinkFolder: There is already
a file with the folder name you specified. Specify a different name."
Tried removing the zip, renaming still get the same message. I'm trying
to use this method within a DTs packgae in SQL.



--
Paul Gee
------------------------------------------------------------------------
Posted via http://www.codecomments.com
------------------------------------------------------------------------

jort777
Wed Feb 08 09:38:21 CST 2006


Paul Gee wrote:
> *Did you ever get this to wrk, using the code supplied with the
> suggested tweaks I'm getting the zip file produced but then receiving
> an error message "Cannot create or replace SinkFolder: There is
> already a file with the folder name you specified. Specify a
> different name." Tried removing the zip, renaming still get the same
> message. I'm trying to use this method within a DTs packgae in SQL. *

I used the script from Philip (not sure who posted it first) and it
works perfectly on my system.

The question now is ... How can I add a password to it?

=======================================
To make sure we talk about the same script, this is the one I used:

Option Explicit

Const ForReading = 1, ForWriting = 2, ForAppending = 8

Dim MySource, MyTarget, MyZipName, MyHex, MyBinary, i
Dim oShell, oApp, oFolder, oCTF, oFile
Dim oFileSys

MySource = "c:\WUTemp"
MyTarget = "c:\SinkFolder.zip"

MyHex = Array(80, 75, 5, 6, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0)

For i = 0 To UBound(MyHex)
MyBinary = MyBinary & Chr(MyHex(i))
Next

Set oShell = CreateObject("WScript.Shell")
Set oFileSys = CreateObject("Scripting.FileSystemObject")

'Create the basis of a zip file.
Set oCTF = oFileSys.CreateTextFile(MyTarget, True)
oCTF.Write MyBinary
oCTF.Close
Set oCTF = Nothing

Set oApp = CreateObject("Shell.Application")

'Copy the files to the compressed folder
Set oFolder = oApp.NameSpace(MySource)
If Not oFolder Is Nothing Then
oApp.NameSpace(MyTarget).CopyHere oFolder.Items
End If

'Wait for compressing to begin, this was necessary on my machine
wScript.Sleep(5000)

'wait for lock to release
Set oFile = Nothing
On Error Resume Next
Do While (oFile Is Nothing)
'Attempt to open the file, this causes an Err 70, Permission Denied
when the file is already open
Set oFile = oFileSys.OpenTextFile(MyTarget, ForAppending, False)
If Err.number <> 0 then
Err.Clear
wScript.Sleep 3000
End If
Loop

Set oFile=Nothing
Set oFileSys=Nothing



--
jort777
------------------------------------------------------------------------
Posted via http://www.codecomments.com
------------------------------------------------------------------------

trosien
Tue Feb 14 22:03:00 CST 2006

Any idea on how one might do an extraction from a zip file using a
similar mechanism to how this zip folder was created? I messed around
with it a bit, but to no avail.

jg
Mon Feb 20 01:08:07 CST 2006

or you get download 7-zip from sourceforge.net and use it's command line
options
quick simple and easy
"jort777" <jort777.22xsxo@mail.codecomments.com> wrote in message
news:jort777.22xsxo@mail.codecomments.com...
>
> Paul Gee wrote:
>> *Did you ever get this to wrk, using the code supplied with the
>> suggested tweaks I'm getting the zip file produced but then receiving
>> an error message "Cannot create or replace SinkFolder: There is
>> already a file with the folder name you specified. Specify a
>> different name." Tried removing the zip, renaming still get the same
>> message. I'm trying to use this method within a DTs packgae in SQL. *
>
> I used the script from Philip (not sure who posted it first) and it
> works perfectly on my system.
>
> The question now is ... How can I add a password to it?
>
> =======================================
> To make sure we talk about the same script, this is the one I used:
>
> Option Explicit
>
> Const ForReading = 1, ForWriting = 2, ForAppending = 8
>
> Dim MySource, MyTarget, MyZipName, MyHex, MyBinary, i
> Dim oShell, oApp, oFolder, oCTF, oFile
> Dim oFileSys
>
> MySource = "c:\WUTemp"
> MyTarget = "c:\SinkFolder.zip"
>
> MyHex = Array(80, 75, 5, 6, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
> 0, 0, 0, 0)
>
> For i = 0 To UBound(MyHex)
> MyBinary = MyBinary & Chr(MyHex(i))
> Next
>
> Set oShell = CreateObject("WScript.Shell")
> Set oFileSys = CreateObject("Scripting.FileSystemObject")
>
> 'Create the basis of a zip file.
> Set oCTF = oFileSys.CreateTextFile(MyTarget, True)
> oCTF.Write MyBinary
> oCTF.Close
> Set oCTF = Nothing
>
> Set oApp = CreateObject("Shell.Application")
>
> 'Copy the files to the compressed folder
> Set oFolder = oApp.NameSpace(MySource)
> If Not oFolder Is Nothing Then
> oApp.NameSpace(MyTarget).CopyHere oFolder.Items
> End If
>
> 'Wait for compressing to begin, this was necessary on my machine
> wScript.Sleep(5000)
>
> 'wait for lock to release
> Set oFile = Nothing
> On Error Resume Next
> Do While (oFile Is Nothing)
> 'Attempt to open the file, this causes an Err 70, Permission Denied
> when the file is already open
> Set oFile = oFileSys.OpenTextFile(MyTarget, ForAppending, False)
> If Err.number <> 0 then
> Err.Clear
> wScript.Sleep 3000
> End If
> Loop
>
> Set oFile=Nothing
> Set oFileSys=Nothing
>
>
>
> --
> jort777
> ------------------------------------------------------------------------
> Posted via http://www.codecomments.com
> ------------------------------------------------------------------------
>