1. Accueil
  2. Tous les snippets
  3. Snippets Visual Basic / VB.NET
  4. Compression d'un dossier avec winzip

Compression d'un dossier avec winzip

Soyez le premier à donner votre avis sur cette source.

Snippet vu 5 209 fois - Téléchargée 21 fois

Commenter

Contenu du snippet

' ----------------------------------------------------------
' Script de compression d'un dossier avec Winzip
'
' Syntaxe:
' zipfolder <source> <destination>
' <source> : dossier à compresser
' <destination> : dossier de destination du fichier zip
''
' PGM DJEBBI © 2010
' ----------------------------------------------------------

Source / Exemple : 


On Error Resume Next
Const SW_HIDE=0
Const SW_SHOWNORMAL=1 

Dim net, shell, user, computer, args, fso
Dim StdIn, StdOut
Set StdIn = WScript.StdIn
Set StdOut = WScript.StdOut

Set net   = Wscript.CreateObject("WScript.Network")
Set shell = WScript.CreateObject("WScript.Shell")
Set fso   = WScript.CreateObject("Scripting.FileSystemObject")
Set args  = Wscript.Arguments
user=net.UserName
computer=net.ComputerName

TestHost true

If args.count<2 Then
	s=    "Script de compression d'un dossier avec Winzip" & VBCRLF
	s=s & "PGM © 2011" & VBCRLF
	s=s & "----------------------------------------------" & VBCRLF
	s=s & "Syntaxe: " & VBCRLF
	s=s & " zipfolder <source> <cible>" & VBCRLF
	s=s & "   <source> : dossier à compresser" & VBCRLF
	s=s & "              (doit exister)" & VBCRLF
	s=s & "   <cible>  : dossier destination du fichier zip" & VBCRLF
	s=s & "              (créé s'il n'existe pas)" & VBCRLF
	wscript.echo s
	wscript.quit
	End If
srce=args(0)
If right(srce,1)<>"\" Then srce=srce & "\"
dest=args(1)
If not fso.FolderExists(srce) Then
	wscript.echo "Dossier source " & srce & " inexistant"
	wscript.quit
	End If
If right(dest,1)<>"\" Then dest=dest & "\"
If not fso.FolderExists(dest) Then
	wscript.echo "Dossier destination " & dest & " inexistant"
	StdOut.Write "Voulez-vous le créer ? (O/N) : "
	str = ucase(StdIn.ReadLine)
	If str="" Then str="N"
	r=left(str,1)
	If r="O" or r="Y" Then SuperCreateFolder dest else wscript.quit
	End If
today = FormatDateTime(now, 2)
ZipName=dest & user & "-" & replace(today, "/", "") & ".zip"
WinzipPath=shell.RegRead("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\winzip.exe\")
If Err.Number<>0 Then 
	Wscript.Echo "Erreur dans la lecture de la clef de Winzip" & vbcrlf
	wscript.quit
	End If
nomcmd=WinzipPath & " -min -a -r -hs " & ZipName & " " & srce & "*.*" 
shell.Run nomcmd, SW_SHOWNORMAL,true
If fso.FileExists(ZipName) Then
	set f=fso.GetFile(ZipName)
	s="Le fichier """ & f.name & """ de " & f.Size & " octets a été créé" & VBCRLF
	s=s & "dans le dossier """ & f.ParentFolder & """" & VBCRLF
	wscript.echo  s 
	End If
Wscript.quit

'--------------------------------------------------------------------
'Sous-programme de test du moteur
'Vu les sorties générées, c'est CSCRIPT (et non pas WSCRIPT)
'qui doit être utilisé de préférence
Sub TestHost(force)
dim rep
strappli=lcase(Wscript.ScriptFullName)
strFullName =lcase(WScript.FullName)
i=InStr(1,strFullName,".exe",1)
j=InStrRev(strFullName,"\",i,1)
strCommand=Mid(strFullName,j+1,i-j-1)
if strCommand<>"cscript" then
	If force then 
		Init="Ce script doit être lancé avec CSCRIPT"
	Else
		Init="Il est préférable de lancer ce script avec CSCRIPT"
		End If
	rep=MsgBox(Init & VBCRLF & _
	"Cela peut être rendu permanent avec la commande" & VBCRLF & _
	"cscript //H:CScript //S /Nologo" & VBCRLF & _
	"Voulez-vous que ce soit fait automatiquement?", _
	vbYesNo + vbQuestion,strappli)
	if rep=vbYes  then 
		nomcmd="setscript.bat"
		Set ficcmd = fso.CreateTextFile(nomcmd)
		ficcmd.writeline "@echo off"
		ficcmd.writeline "cscript //H:CScript //S /Nologo"
		ficcmd.writeline "pause"
		params=""
		For i = 0 To nbargs-1 
			params=params & " " & args(i)
			next
		ficcmd.writeline chr(34) & strappli & chr(34) & params
		ficcmd.writeline "pause"
		ficcmd.close
		shell.Run nomcmd, SW_SHOWNORMAL,true
		force=true
		end if
    If force then WScript.Quit
	end if
end sub
'--------------------------------------------------------------------
' sous-programme de création récursive de dossier
Sub SuperCreateFolder(fd)
If fd="" Then exit sub
bs=InstrRev(fd,"\")
parent=left(fd,bs-1)
If len(parent)>2 Then
	If not fso.FolderExists(parent) then SuperCreateFolder Parent
	End If
If not fso.FolderExists(fd) then fso.CreateFolder(fd)
End Sub

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (djebbipgm)