dim tabl()
dim tablold()
redim tabl(1)
tabl(0)="zaza"
num=1
nbtot=0
nboct=0
nbssrep=0

'choix du répertoire à recopier
nomrep=inputbox("nom du répertoire à enregistrer","choix du répertoire","C:\Mes Documents\")

'traiter le cas où nomrep est un disque ou un nom non valide
Set fs = CreateObject("Scripting.FileSystemObject")
if not fs.folderexists(nomrep) or ucase(fs.getdrivename(nomrep))=ucase(replace(nomrep,"\","")) then
MsgBox nomrep & " n'est pas un nom de répertoire valide"
wscript.quit
end if
tabl(1)=nomrep

'déterminer le chemin du container (à coté du fichier source)
chem=fs.getfolder(nomrep).path  'nom complet du répertoire à enregistrer
chem=left(chem,len(chem)-len(fs.getfolder(nomrep).name)) 'chemin d'accès
fichresult=chem & "container_" & fs.getfolder(nomrep).name & ".vbs" 
chemrep=fichresult

'******************************************************
'créer le fichier container et recopier le script de restauration des fichiers
'créer et ouvrir le fichier container en écriture
Set nouv_fich = fs.OpenTextFile(fichresult, 2, true)
'ouvrir le fichier actuel en lecture
Set fichsource = fs.OpenTextFile(Wscript.ScriptFullName, 1,False)
txt=""
'recherche du début du script à recopier
	do while txt<>"'RESTAURATION"
	txt=fichsource.readline
	loop
'recopie en retirant l'apostrophe
	Do While not fichsource.atEndOfStream 
	txt=fichsource.readline
	if len(txt)>0 then nouv_fich.writeLine right(txt,len(txt)-1)
	Loop 
nouv_fich.writeLine ""
fichsource.close
set fichsource=nothing
nouv_fich.close

'******************************************************
'ouvrir le fichier container en appending pour y recopier le répertoire
Set nouv_fich = fs.OpenTextFile(fichresult, 8, false) 

nouv_fich.writeline "'REPERTOIRE" 
nouv_fich.writeline "'" & fs.getfolder(nomrep).name
nouv_fich.write vbcrLf

'boucler sur les niveaux jusqu'à ce qu'il n'y ait 
'plus de sous répertoires dans le niveau
do while num>0 '------------------------------------
	
'recopie tabl dans tablold
redim tablold(ubound(tabl))
for n=0 to ubound(tabl)
tablold(n)=tabl(n)
next

'réinitialiser tabl
redim tabl(0)
tabl(0)=nomfich

'explorer le ss répertoire
for n=1 to ubound(tablold)
'ajouter ds le tableau tabl les ss rep de tablold(n)
'et recopier leur nom dans le fichier nouv_fich
expl(tablold(n)) 
next
loop '----------------------------------------------

nouv_fich.close
set nouv_fich=nothing
nboct2= int(fs.getfolder(nomrep).size/1024)
set fs=nothing 


'afficher le résultat
txtrep=""
if nbssrep=1 then txtrep=chr(10) & "avec son unique sous-répertoire"
if nbssrep>1 then txtrep=chr(10) & "avec ses " & nbssrep & " sous-répertoires"
Msgbox "le répertoire """ & nomrep & """" & txtrep & chr(10) & "(" & nbtot & " fichiers pour " & int(nboct/1024) & " ko, total " & nboct2 & " ko) " & chr(10) & "a été recopié dans le fichier vbs" & chr(10) & """"  & chemrep & """",,nomrep

'ouvrir le fichier container
Set sh = WScript.CreateObject("WScript.Shell") 
sh.run "explorer " & chem
set sh=nothing



'*************************************************************************
'*************************************************************************


sub expl(nomfich) 
'ajoute dans le tableau tabl() tous les sous-répertoires de nomfich
'et ajoute dans le fichier nouv_fich les noms des répertoires et fichiers 

Set rep=fs.getFolder(nomfich)

num=ubound(tabl)

'parcourir les sous répertoires de nomfich
for each ssrep in rep.subfolders 
num=num+1 
redim preserve tabl(num)
tabl(num)= ssrep.path
nbssrep=nbssrep+1
nouv_fich.writeline "'REPERTOIRE" 
'inscrire l'adresse sans le chemin complet
nouv_fich.writeline "'" & fs.getfolder(nomrep).name & replace(lcase(ssrep.path),lcase(nomrep),"")
nouv_fich.write vbcrLf
next 

'parcourir les fichiers de nomfich
for each fich in rep.files 
nbtot=nbtot+1
nboct=nboct+fich.size
nouv_fich.writeline "'FICHIER" & nbtot 
nouv_fich.writeline "'" & fs.getfolder(nomrep).name & replace(lcase(fich.path),lcase(nomrep),"")
recopie fich.path  'recopie les octets
nouv_fich.writeline "'FINFICH" & nbtot
next 

set rep=nothing 
end sub

'*************************************************************************
'*************************************************************************

sub recopie(adrfich)
'recopie dans le fichier texte nouv_fich le fichier adrfich complet
'ouvrir le fichier en lecture
Set fichsource = fs.OpenTextFile(adrfich, 1,False)
'recopie en neutralisant les chr(10) et chr(13)
nouv_fich.write "'"
txt=fichsource.read(1)
do while not fichsource.atendofstream
txt=replace(txt,chr(10),chr(10) & "'")
txt=replace(txt,chr(13),chr(13) & "'")
nouv_fich.write txt
txt=""
on error resume next
txt=fichsource.read(4*1024)
on error goto 0
if txt="" then txt=fichsource.readall
loop
txt=replace(txt,chr(10),chr(10) & "'")
txt=replace(txt,chr(13),chr(13) & "'")
nouv_fich.write txt
fichsource.close
set fichsource=nothing
end sub


'*************************************************************************
'*************************************************************************
'*************************************************************************
'*************************************************************************

'RESTAURATION
''choix du répertoire d'accueil
'repacc=inputbox("saisir l'adresse du répertoire dans lequel le fichier doit être copié",,replace(Wscript.Scriptfullname,Wscript.ScriptName,""))
'if right(repacc,1)<>"\" then repacc=repacc & "\"
'
''créer l'arborescence de répertoires '********************** début répertoires
''ouvrir le fichier en cours en lecture
'Set fs = CreateObject("Scripting.FileSystemObject")
'Set fichsource = fs.OpenTextFile(Wscript.ScriptFullName, 1,False)
'nom=""
'do while not fichsource.atendofstream '--------balayer les répertoires
''rechercher le tag répertoire
'do while txt<>"'REPERTOIRE" and not fichsource.atendofstream
'txt=fichsource.readline
'loop
''récupérer le nom du répertoire
'if not fichsource.atendofstream then
'txt=fichsource.readline 'lire le nom du répertoire
'txt=right(txt,len(txt)-1) 'retirer l'apostrophe
''construire le nom du nouveau répertoire
'copie=0
'nvrp=repacc & "copie" & copie & "_" & txt
'do while fs.folderexists(nvrp)
'copie=copie+1
'nvrp=repacc & "copie" & copie & "_" & txt
'loop
''créer le nouveau répertoire
'if nom="" then nom="copie" & copie & "_" & txt
'fs.createfolder(nvrp) 
'end if
'loop '--------répertoire suivant
'fichsource.close
''******************************************************* fin répertoires

''******************************************************* début fichiers
''recréer les fichiers
''ouvrir le fichier en cours en lecture
'Set fs = CreateObject("Scripting.FileSystemObject")
''chercher les fichiers
'numfich=0
'suiv=true
'do while suiv=true '-----------boucler sur les fichiers
'Set fichsource = fs.OpenTextFile(Wscript.ScriptFullName, 1,False)
'numfich=numfich+1
''chercher le tag fichier
'do while not instr(txt,"'FICHIER" & numfich)>0 and not fichsource.atendofstream'..............
'txt=fichsource.readline
'loop '..............
'if not fichsource.atendofstream then '////
''à ce stade "'FICHIER" a été lu
'txt=fichsource.readline 'lire le nom du fichier
''reconstituer fichier
''créer fichier texte
'set fich=fs.OpenTextFile(repacc & "copie" & copie & "_" & right(txt,len(txt)-1),2,true)

''récupérer les octets
'txt2=fichsource.read(1) 'retirer l'apostrophe de début

'txte=""
'do while not instr(txte,"'FINFICH" & numfich)>0
'txte=""
'on error resume next
'txte=fichsource.read(4*1024)
'if txte="" then txte=fichsource.readall
'on error goto 0 'si on dépasse la fin du fichier

''	gérer les ' à la fin
'	do while right(txte,1)="'" or right(txte,1)="F" or right(txte,1)="I" or right(txte,1)="N" or right(txte,1)="C" or right(txte,1)="H" or isnumeric(right(txte,1))
''	on error resume next
'	txte=txte & fichsource.read(1)
''	on error goto 0
'	loop
'txte2=txte
'if instr(txte2,"'FINFICH" & numfich)>0 then txte2=left(txte2,instr(txte2,"'FINFICH" & numfich)-1)
'txte2=replace(txte2,chr(13) & "'",chr(13))
'txte2=replace(txte2,chr(10) & "'",chr(10))
'fich.write txte2
'loop 'boucler à la recherche de la fin du fichier
'fich.close
'suiv=true
'else '/////
'suiv=false
'end if '/////
'fichsource.close
'loop '------------fichier suivant
''*****************************************************fin fichiers

'set fich=nothing
'set fichsource=nothing
'Set fs=nothing
'msgbox "le répertoire complet a été recopié dans le répertoire " & chr(10) & repacc & chr(10) & "sous le nom " & nom