' ----------------------------------------------------------
' Script de compression d'un dossier avec Winzip
'
' Syntaxe: 
'	zipfolder <source> <destination>
'		<source> : dossier à compresser
'		<destination> : dossier de destination du fichier zip
''
' JC BELLAMY © 2002
' ----------------------------------------------------------
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 & "JCB © 2002" & 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