Soyez le premier à donner votre avis sur cette source.
Snippet vu 5 343 fois - Téléchargée 22 fois
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
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.