VBS: compression (zip) de fichiers (.extension1, .extension2)

Version imprimable

VBS: compression (zip) de fichiers (*.extension1, *.extension2)

Bonjour,
Je cherche à compresser certains fichiers (*.html, *.css etc.) de différents répertoires en un seul fichier zip.
Comment faire?
Ma 1ère tentative a été d'utiliser Chilkat, mais après 30j d'évaluation, c'est maintenant payant. Je dois trouver une autre méthode.
Celles vu sur forums ne correspondent pas à mes besoins.
Voilà mon code actuel (qui marche très bien si on a Chilkat...):

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
'Script permettant de zipper les fichiers de baseSRC (et sous répertoires de manière récursive) dans un fichier sauvegardé dans baseDST
 
'declaration des 2 variables avec la methode arg()
String baseSRC, baseDST
Dim oArgs
 
If wscript.Arguments.length <> 2 Then   
	WScript.Echo "------------- Incorrect Number of Arguments -------------"
	WScript.Quit  
End if
 
Set oArgs=WScript.Arguments ' tableau d'arguments
baseSRC=WScript.Arguments(0) ' premier argument
baseDST=WScript.Arguments(1) ' second argument
 
if not isAFolder(baseSRC) then
	WScript.Echo "------------- The " & baseSRC & " folder does NOT exist -------------"
	WScript.Quit  	
End if
 
set zip = CreateObject("ChilkatZip2.ChilkatZip2")
zip.UnlockComponent "anything for 30-day trial"
 
'  One last example -- combine DiscardPaths with PathPrefix
'  with multiple calls to AppendFiles:
 
'  Clear the zip object.
zip.NewZip baseDST & "master_new.zip"
'msgbox "Zip: " & baseDST & "master.zip"
 
zip.AppendFromDir = baseSRC
 
'take all the textual files
dim path
dim numDossier
numDossier = 1
dim recurse
recurse = true
do	
 
	Select case (numDossier) 
		case 1 
			path = "html\"	
 
		case 2 
			path = "css\"			
 
	end select 
 
	zip.AppendFiles path & "*.xml",recurse	
	zip.AppendFiles path & "*.txt",recurse
	zip.AppendFiles path & "*.html",recurse
	zip.AppendFiles path & "*.htm",recurse
	zip.AppendFiles path & "*.js",recurse
	zip.AppendFiles path & "*.xsl",recurse
	zip.AppendFiles path & "*.css",recurse
	zip.AppendFiles path & "*.gif",recurse
 
	numDossier = numDossier + 1
loop while (numDossier < 3)
 
zip.AppendFiles "/html/*.gif",recurse
zip.AppendFiles "/html/*.jpg",recurse
 
success = zip.WriteZipAndClose()
If (success <> 1) Then
    MsgBox zip.LastErrorText
    WScript.Quit
End If
 
WScript.Quit
 
 
Function isAFolder(pathName) Dim isFold
	isFold = false
	Dim fso
	Set fso=wscript.CreateObject("Scripting.FileSystemObject")	
	if fso.FolderExists(pathName) then
		isFold = true
	end if
	isAFolder = isFold
End Function

Comment faire autrement?

Choutlse31

18/11/2009, 18h29
omen999

bonjour,
il existe un composant MoleZip freeware qui traine toujours sur le net
par exemple ici

Je vais essayer d'utiliser Molezip et je te dirais quoi :mouarf:

Avant de poser la question sur ce forum, j'avais vu un post ici, mais je n'arrive pas à le mettre en oeuvre.
A chaque insertion de fichier (.NameSpace(MyZip).CopyHere(File1)), j'ai une fenêtre qui me demande si je souhaite remplacer le fichier MyTestZipFile.zip par test1.txt puis si je souhaite remplacer MyTestZipFile.zip par test2.txt.
Cela me crée une archive (non vide > 0ko) mais rien dedans!!!

Peut être y a t-il une erreur dans mon code?

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
'declaration des 2 variables avec la methode arg()
Dim baseSRC, baseDST
Dim oArgs
 
If wscript.Arguments.length <> 2 Then   
	WScript.Echo "-- Incorrect Number of Arguments --"
	WScript.Quit  
End if
 
Set oArgs=WScript.Arguments ' tableau d'arguments
baseSRC=WScript.Arguments(0) ' premier argument
baseDST=WScript.Arguments(1) ' second argument
 
if not isAFolder(baseSRC) then
	WScript.Echo "-- The " & baseSRC & " folder does NOT exist --"
	WScript.Quit  	
End if
 
'----------------------------------------
'----------------------------------------
'----------------------------------------
dim FOF_CREATEPROGRESSDLG
FOF_CREATEPROGRESSDLG = &H0&
dim MyZip, File1, File2
MyZip = baseDST & "\MyTestZipFile.zip"
File1 = "test1.txt"
File2 = "test2.txt"
 
' before start : delete existing archive if it exists
Dim fs
Set fs = CreateObject("Scripting.FileSystemObject")
If fs.FileExists(MyZip) Then fs.DeleteFile(MyZip)
 
'-------------- create empty zip file ---------
'Create the basis of a zip file.
'the CreateTextFile will create the file with 22 bytes inside
 
CreateObject("Scripting.FileSystemObject") _
.CreateTextFile(MyZip, True) _
.Write "PK" & Chr(5) & Chr(6) & String(18, vbNullChar)
 
 
'-------------- zip ---------------------------
'get ready to add files to zip
With CreateObject("Shell.Application")
	'add files
	' the NameSpace(MyZip).CopyHere will tell windows to insert compressed files in it. 
	' For that, windows will replace the file by some temp file, and the file will reappear only when it's finished.
	' so the compression is finisshed when I can see the file, with a size > 22 bytes.
	.NameSpace(MyZip).CopyHere(File1) , FOF_CREATEPROGRESSDLG
	.NameSpace(MyZip).CopyHere(File2)
End With
wScript.Sleep 5000
 
Dim fZipIsFinished
fZipIsFinished=0
While fZipIsFinished=0
	If fs.FileExists(MyZip) Then
		Dim h
		Set h=fs.getFile(MyZip)
		If h.size=22 Then
			fZipIsFinished=0
			' File created, compression did not start yet
		Else
			fZipIsFinished=1
			'File created, compression finished
		End If
	Else
		'File removed for compression, not yet recreated. compression is in progress
		fZipIsFinished=0
	End If
	wScript.Sleep 1000
Wend
 
msgbox "Done"
wscript.quit
'----------------------------------------
'----------------------------------------
'----------------------------------------
 
Function isAFolder(pathName) Dim isFold
	isFold = false
	Dim fso
	Set fso=wscript.CreateObject("Scripting.FileSystemObject")	
	if fso.FolderExists(pathName) then
		isFold = true
	end if
	isAFolder = isFold
End Function

Ma commande: wscript zipfiles.vbs C:\testsrc C:\testdst
Mes fichiers test1 et test2 se trouve dans le mme rép que zipfiles.vbs

Si tu vois une erreur....

Citation:

Envoyé par omen999

bonjour,
il existe un composant MoleZip freeware qui traine toujours sur le net
par exemple ici

19/11/2009, 14h22
omen999

je me doutais bien qu'on allait y venir :aie:
ce type de hack ne doit être utilisé qu'en dernier ressort lorsque, par exemple, tu ne peux pas référencer de nouveaux composants dans la base de registre
voir ici

ma solution

Salut,
Après avoir essayé Molezip sans succès, j'ai cherché et recherché et voilà ma solution: XZip ici. J'ai trouvé la solution dans ce forum.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
 
'declaration des 2 variables avec la methode arg()
String baseSRC, baseDST
Dim oArgs
 
If wscript.Arguments.length <> 2 Then   
	WScript.Echo "-- Incorrect Number of Arguments --"
	WScript.Quit  
End if
 
Set oArgs=WScript.Arguments ' tableau d'arguments
baseSRC=WScript.Arguments(0) ' premier argument
baseDST=WScript.Arguments(1) ' second argument
 
if not isAFolder(baseSRC) then
	WScript.Echo "-- The " & baseSRC & " folder does NOT exist --"
	WScript.Quit  	
End if
 
 
Dim objXStd
Dim pathZip
pathZip = baseDst & "\myZipFile.zip" 'Nom de l archive
 
'Supprimer l archive si elle existe deja
Set objFSO = CreateObject("Scripting.FileSystemObject")
if objFSO.FileExists(pathZip) then
	objFSO.DeleteFile(pathZip)
end if
set objFSO = nothing
 
'Création de l objet permettant de zipper
set objXStd =  CreateObject("XStandard.Zip") 
 
'take all the textual files
dim path
dim numDossier
numDossier = 1
baseSRC = baseSRC & "\"
do
	Select case (numDossier) 
		case 1 
			path = "rep1\"				
		case 2 
			path = "rep2\"			
	end select 
	'Zipper tout le dossier
	if numDossier = 3 or numDossier = 4 then	
		objXStd.Pack baseSrc & path, pathZip, true		
	else	
		objXStd.Pack baseSrc & path & "*.pdf", pathZip
		objXStd.Pack baseSrc & path & "*.txt", pathZip
		objXStd.Pack baseSrc & path & "*.html", pathZip
'comme je souhaite garder l arborescence, je deplace les fichiers dans mon archive - mettre true dans les param de Pack ne me convient pas
		For Each objItem In objXStd.Contents(pathZip)
			objXStd.Move objItem.Name, path & objItem.Name, pathZip
		Next
	end if
	numDossier = numDossier + 1
loop while (numDossier < 3)
 
'Mettre tous les *.gif et *.jpg de rep1\img dans l archive
	objXStd.Pack baseSrc & "rep1\img\*.gif", pathZip
	objXStd.Pack baseSrc & "rep1\img\*.jpg", pathZip
	path = "rep1\img\"
	For Each objItem In objXStd.Contents(pathZip)
		objXStd.Move objItem.Name, path & objItem.Name, pathZip
	Next
 
 
Set objXStd = Nothing
 
msgbox "End of the zip"
 
WScript.Quit
 
 
Function isAFolder(pathName) Dim isFold
	isFold = false
	Dim fso
	Set fso=wscript.CreateObject("Scripting.FileSystemObject")	
	if fso.FolderExists(pathName) then
		isFold = true
	end if
	isAFolder = isFold
End Function

Voilà, ça marche tout comme je voulais... même si ce n'est pas la meilleure solution, c'est celle que j'ai réussi à mettre en oeuvre! :mrgreen:

Citation:

Envoyé par omen999

je me doutais bien qu'on allait y venir :aie:
ce type de hack ne doit être utilisé qu'en dernier ressort lorsque, par exemple, tu ne peux pas référencer de nouveaux composants dans la base de registre
voir ici