' gaffe times modulo 24h!
' fair noreg
' faire nolist
' faire ????
' faire --root facultatif
' nousers
' 11 go en 300"
' 1/2 go minute
' 7 go en 1000": 700 mo en 100" 500 mo ': 500000*8=4 000 000 4 Mbits/s (réseau 100 Mbits!)
option explicit
dim relufile
dim nook
nook=true
dim start
start=-1
dim excludeusers
excludeusers=false
dim excludewindows
excludewindows=false
dim includewindows
includewindows=true
dim excludeprograms
excludeprograms=false
dim includeprograms
excludeprograms=true
dim profondeur
profondeur=0
dim verb
verb=" copy "
dim buffer
buffer=""
dim excludesystem
excludesystem=false
dim tab(257)
dim nolog
nolog=false
dim copy
copy=false
dim nocopy
nocopy=false
dim logname
logname=""
dim logfile
init
dim remdos
remdos=""
dim target
target=""
dim nbficop
nbficop=0
dim nbccop
nbccop=0
dim bat
bat=false ' vrai si -bat
' 2do: wscript and prameters
' executed by wscript or cscript ?
dim who, w
who= ucase(wscript.fullname)
if instr(who,"CSCRIPT")>0 then
w=false
elseif instr(who,"WSCRIPT")>0 then
w=true
else
wscript.echo "unknown handler "& who
wscript.quit
end if
dim version
version="http://antiguide.free.fr/wiki/wakka.php?wiki=duw, 20201228 "
dim fs
set fs=createobject("scripting.filesystemobject")
dim count
count=wscript.arguments.count
dim gui
dim stdout
if w then
gui=true
' trop tot pour ouvrir fichier reultats don connaite pas encore son nom!
else
gui=false
Set stdout = fs.GetStandardStream (1)
'Set stderr = fs.GetStandardStream (2)
'msgbox "stdout not gui open "
end if ' gui
dim nberr
nberr=0
dim nbfiles
dim nbfolders
nbfolders=0
nbfiles=0
dim all
all=false
dim onlyfiles
onlyfiles=false
dim bsize
bsize=1
dim trailer
trailer="\"
dim bycluster
bycluster=false
dim lev
dim lonlev ' longueur de l'argument aà oter lors de copie
' wrlog "w:" & w & " count:"&count
if w then
if count=1 then
lev=wscript.arguments(0)
' lonlev=len(lev)
msgbox lev
else
lev=inputbox ("duw " &vbcrlf & _
version & vbcrlf & _
"version du 20201228-1800" & vbcrlf & _
"entrez le chemin à explorer")
if len(lev)=0 then
msgbox "Oooops"
wscript.quit
end if
end if ' lev
dim out
dim where
where=fs.GetAbsolutePathName(".")
out=inputbox ( "duw " &vbcrlf &_
version & vbcrlf & _
"Entrez le nom du fichier destinataire de la liste" & vbcrlf & _
"in: " & where &"\.")
if len(out)=0 then
msgbox "no out file"
wscript.quit
end if
out=fs.GetAbsolutePathName(".") &"\"&out
set stdout=fs.createtextfile(out)
' msgbox "ok creation " & out
wrlog remdos & "duw ("&version&")"
wrlog remdos & "Started @ "&nono
else ' donc c pas windows
wrlog remdos & "duw ("&version &")"
wrlog remdos & "Started @ "&nonow
dim ic
for ic=0 to count-1
dim opt
opt=ucase(wscript.arguments.item(ic))
wrlog remdos & "param: "& opt
if instr("-1-5-4-8-X-B",opt)>1 and bsize>1 then
wrlog "duplicated cluster-size option."
wscript.quit
end if
dim optcmd
dim optvalue
optcmd=opt
optvalue=""
if instr(opt,":")>0 then
optcmd=mid(opt,1,instr(opt,":")-1)
optvalue=mid(opt,instr(opt,":")+1)
end if
select case optcmd
case "-NOUSERS"
excludeusers=true
case "-CHRONO"
start=timer()
case "-NOWINDOWS"
excludewindows=true
case "-WINDOWSONLY"
includewindows=true
case "-NOPROGRAMS"
excludeprograms=true
case "-PROGRAMSONLY"
includeprograms=true
case "-NOLOG"
nolog=true
case "-NOSYSTEM":
excludesystem=true
case "-LOG":
logname=optvalue
logname=fs.GetAbsolutePathName(logname)
set logfile=fs.createtextfile(logname)
logfile.writeline buffer
wrlog remdos & "log: """&logname&""""
buffer=""
case "-TARGET":
target=optvalue
target=fs.GetAbsolutePathName(target)
wrlog remdos & "target: """&target&""""
case "-BAT":
bat=true
REMDOS = "REM "
case "-TESTONLY":
nocopy=true
copy=true
verb= " test "
wrlog "param testonly:" & nocopy
case "-COPY":
copy=true
case "-I":
info( wscript.arguments.item(count-1))
wscript.quit
case "-C": bycluster=true
case "-1": bsize=1024
case "-5": bsize=512
case "-4": bsize=4096
case "-8": bsize=8192
case "-X": bsize=16384
case "-B": bsize=1
case "-A":
all=true
case "--HELP" :
wrlog " -b count in bytes"
wrlog " -i information about disk drive"
wrlog " -f list only files "
wrlog " -a list files and folders"
wrlog " -5 cluster of 512 bytes"
wrlog " -1 cluster of 1024 bytes"
wrlog " -2 cluster of 2048 bytes"
wrlog " -4 cluster of 4096 bytes"
wrlog " -8 cluster of 8192 bytes"
wrlog " -x cluster of 16384 bytes"
wrlog " -c display count in clusters"
wrlog " -nolog no log file"
wrlog " -log: log file"
wrlog " -copy copy folders and files (need target:)"
wrlog " -target: folder to create to receive copy"
wrlog " -testonly browse files but NO copy"
wrlog " -nosystem exclude files/forders with system attribute"
wrlog " -nowindows exclude ?:\windows folder"
wrlog " -noprograms exclude ""?:\program files"" and ""?:\program files (x86)"" folders"
wrlog " soon: -windowsonly copy windows folder"
wrlog " soon: -programsonly copy ""program files"" and ""program files (x86)"" folders"
wrlog " -chrono display elapsed ""."
wrlog " -clock display wall time"
wrlog " -nousers exclude ""?:\users"" and ""?\documents and settings"" folders"
wscript.quit
case "-F": onlyfiles=true
case else:
if ic<count-1 then
wrlog "unknown! "&opt
wscript.quit
end if
end select
if instr("-1-5-4-8-X-B",opt)>=1 then wrlog "Cluster-size set to " & bsize
next 'ic
if bsize>1 then wrlog "Cluster-size: " & bsize
if count=0 and not w then
wrlog "aide: duw --help"
wscript.quit
end if
if w then
else
lev=wscript.arguments.item(count-1)
' oter le . final
if mid(lev,len(lev))="." then lev=mid(lev,1,len(lev)-1)
'lonlev=len(lev)
end if
end if
if bsize>1 then wrlog "cluster-size: "&bsize
if copy and (not nocopy) and len(target)=0 then
wrlog "copy needs target"
wscript.quit
end if
' fini les préparatifs
if bat then remdos="REM "
lev= fs.getabsolutepathname(lev)
wrlog remdos & "root: "&lev
lonlev=len(lev)
if lonlev>3 then lonlev=lonlev+1
dim x
dim xroot
dim fzero
set fzero=fs.getfolder(lev)
dim attribpp
attribpp=fzero.attributes
if BAT or copy and not nocopy then
target=fs.GetAbsolutePathName(target)
if not nook then wrlog "absolute target " & target & " copy:" & copy
if bat then wrlog "if not exist """&target& """ mkdir """&target&""""
if copy then
fs.createfolder target
if not nook then wrlog nonow& " (1) folder: ["&disp(attribpp)& "] """ & target&""""
else
wrlog nonow& " folder IGHNORED: ["&disp(attribpp)&"] """ & target&""""
end if
end if
'wrlog "ANDIAMO copy:" & copy
dim startnow
startnow=now
x=level(lev,attribpp)
if nberr>0 then wrlog "#errors: "&nberr
wrlog remdos & "#folders: "&nbfolders
wrlog remdos & "#files: "&nbfiles
wrlog remdos & "#files copied/tested: "&nbficop
wrlog remdos & "#bytes copied/tested: "&nbccop
' if not gui then stderr.writeline "Ended @ "&nonow
wrlog remdos & "Ended @ "&nonow&" ( started @ "&startnow& ")"
' ----- fin du PP
function level(p,attx)
if islink(attx) then
wrlog "LINK ignore "& p
exit function
end if
profondeur=profondeur+1
' BUG! if mid(p,len(p))="\" then p=mid(p,1,len(p)-1)
dim nberrfiles
nberrfiles=0
dim nberrfolders
nberrfolders=0
' wrlog remdos & "traite folder " & p
' wrlog "pour de bon " & p
dim s,smax
s=0 ' taile en byte
smax=0 'taille arrondie au cluster supérieur (selon taille indiquée, pas vérifié réelle)
on error resume next
dim fo
set fo=fs.getfolder(p)
dim attrx
attrx=fo.attributes
if err.number>0 then
wrerr "erreur "&err.number & " en lecture dossier: " & p
wrlog "ABANDON"
err.clear
on error goto 0
level=-1
exit function
end if
on error goto 0
dim fc, onefile, fsize, fmax, ffixe
on error resume next
Set fc = fo.Files
if err.number >0 then
wrlog "ERREUR 1 " & err.description& " en get files, dossier ABANDONNE"
err.clear
on error goto 0
exit function
end if
' wrlog "tester count fi"
dim nbfi
on error resume next
nbfi=fc.count
if err.number >0 then
wrlog "ERREUR 1 " & err.description& " en demandant le nombre de fichiers, dossier ABANDONNE"
err.clear
on error goto 0
exit function
end if
on error goto 0
' ici erreur si c;\.
on error resume next
' wrlog "nb files: "&fc.count
if err.number>0 then
wrerr "err 8 compte files indisponible"& err.number & " " & err.description
err.clear
on error goto 0
exit function
end if
on error goto 0
on error resume next
For Each onefile in fc
if err.number>0 then
wrerr "FILE illisible"
nberrfiles=nberrfiles+1
err.clear
on error goto 0
else
' wrlog "REM TRAITE FILE " &onefile.name
nbfiles=nbfiles+1
fsize=onefile.size
dim attribfi
attribfi=onefile.attributes
if islink(attribfi) then
wrlog "LINK ignore " & onefile.name
else
fmax=bsize*int((fsize+bsize-1)/bsize)
ffixe=fixe(fmax)
if all or onlyfiles then wrlog "REM FILE "& ffixe & " " &disp(attribfi) & " """ & p & """ """ & onefile.name & """"
if bat or copy then
dim sourcefi
dim ciblefi
dim inter
inter=""
if mid(p,len(p))<>"\" then inter="\"
on error resume next
sourcefi= p & inter& onefile.name
if err.number >0 then
wrlog "ERREUR 1 " & err.description& " en .names, dossier ABANDONNE"
err.clear
on error goto 0
exit function
end if
' wrlog "sourcefi construit::::::" & sourcefi&":::::"
' if bat then sourcefi=""""&sourcefi&""""
' GAFFE +1 au pif
' wrlog "p::::::"& p&"::::lonlev:"&lonlev
ciblefi=target & mid(p,lonlev)
if bat then ciblefi=ciblefi &"\."
if copy then
' wrlog "ciblefi:::::"& ciblefi&"::::"
dim bis
bis=""
if mid(ciblefi,len(ciblefi))<>"\" then bis="\"
ciblefi=ciblefi &bis&onefile.name
' wrlog "ciblefi:"& ciblefi
end if
' if bat then ciblefi=""""&ciblefi&""""
dim w4
w4= verb & " """ & sourcefi & """ """ &ciblefi&""""
if bat then w4= w3dos(w4)
if bat then wrlog w4
if copy then
dim fautcopy
fautcopy=true
' wrlog "sourcefi:"&sourcefi
if excludeusers and debute(1,sourcefi,"users\") then fautcopy=false
if excludeusers and debute(1,sourcefi,"documents and settings\") then fautcopy=false
if excludewindows and debute(2,sourcefi,"windows\") then fautcopy=false
if excludeprograms and debute(3,sourcefi,"program files\") then fautcopy=false
if excludeprograms and debute(4,sourcefi,"program files (x86)\") then fautcopy=false
if excludesystem and issystem(attribfi) then fautcopy=false
nbficop=nbficop+1
nbccop=nbccop+fsize
if nocopy then fautcopy=false
'
if fautcopy then
if not nook then wrlog nonow & " [" & fsize & disp(attribfi)&"] " & w4
if not nook then wrlog "copy """&sourcefi& """ """&ciblefi&""""
on error resume next
fs.copyfile sourcefi,ciblefi
if err.number>0 then
wrerr "err 2 #:"& err.number & " description:" & err.description & " source:" & err.source
err.clear
end if
on error goto 0
else
if nocopy then
if not nook then wrlog nonow & " [" & fsize & disp(attribfi)&"] """ & sourcefi&""""
else
if not nook then wrlog nonow & " NO [" & fsize & disp(attribfi)&"] EXCLUDED " & w4
end if
end if
end if
fautcopy=true
if nocopy then fautcopy=false
if excludeusers and debute(6,sourcefi,"users\") then fautcopy=false
if excludeusers and debute(1,sourcefi,"documents and settings\") then fautcopy=false
if excludewindows and debute(7,sourcefi,"windows\") then fautcopy=false
if excludeprograms and debute(8,sourcefi,"program files\") then fautcopy=false
if excludeprograms and debute(9,sourcefi,"program files (x86)\") then fautcopy=false
if excludesystem and issystem(attribfi) then fautcopy=false
if fautcopy then
if not fs.fileexists(ciblefi) then
wrerr "err 5 fichier non copié :" &ciblefi
else
if attribfi>=0 then
on error resume next
set relufile=fs.getfile(ciblefi)
if err.number>0 then
wrerr "err 3 "& err.number & " " & err.description & " " & err.source
err.clear
end if
on error goto 0
relufile.attributes=attribfi
dim attribrelu
attribrelu=relufile.attributes
' wrlog "----"&disp(attribfi)&"----"&disp(attribrelu)
end if
end if
end if
end if
end if ' bat / copy
smax=smax+fmax
end if 'err ou au 'PIF end if ' islink
Next ' fc files
if nberrfiles>0 then
wrlog "REM # FICHIERS illisisbles " & nberrfiles & " dans " & p
' wscript.quit
end if
Set fc = fo.subFolders
dim nbfo
on error resume next
nbfo=fc.count
if err.number >0 then
wrlog "ERREUR 3 " & err.description& " en demandant le nombre de folders, dossier ABANDONNE"
err.clear
exit function
end if
on error goto 0
dim onefolder
on error resume next
For Each onefolder in fc
if err.number>0 then
wrerr "err 7 sous folder " & p
err.clear
on error goto 0
else
on error goto 0
dim attribfo
attribfo=onefolder.attributes
'wrlog "memo attribfo="&disp(attribfo)& " " & onefolder.name
nbfolders=nbfolders+1
dim f2, anti, p2
set f2=fs.getfolder(onefolder)
p2=f2.name
if bat or copy then
dim sourcefo
dim ciblefo
dim plus
plus=""
if mid(p,len(p))<>"\" then plus="\"
sourcefo="""" & p &plus &p2 & """"
' GAFFE bricolage en cours
ciblefo=""""&target & mid(p & "\" & p2,lonlev+1)&""""
' wrlog "REM lonlev:"&lonlev
' wrlog "REM p2==="&p2&"==="
' wrlog "REM sourcefo==="&sourcefo&"==="
if bat then wrlog "REM ciblefo==="&ciblefo&"==="
dim w2
dim w1
w1="if not exist " & ciblefo & " mkdir " & ciblefo
'wrlog "REM W1:" & w1
w2= w3dos(w1 )
'msgbox "bonjour" & len(w2)
if bat then wrlog w2
if copy then
dim ter
ter=""
if mid(p,len(p))<>"\" then ter="\"
' wrlog "REM p\p2==="&p & ter & p2&"==="
dim ouf
ouf=target & "\" & mid(p & ter & p2,lonlev+1)
if not nook then wrlog nonow& " " & profondeur & " ["&disp(attribfo)&"] folder: """ & ouf&""""
fautcopy=true
if nocopy then fautcopy=false
if excludeusers and debute(10,sourcefo,"users\") then fautcopy=false
if excludeusers and debute(1,sourcefi,"documents and settings\") then fautcopy=false
if excludewindows and debute(11,sourcefo,"windows\") then fautcopy=false
if excludeprograms and debute(12,sourcefo,"program files\") then fautcopy=false
if excludeprograms and debute(13,sourcefo,"program files (x86)\") then fautcopy=false
if excludesystem and issystem(attribfo) then fautcopy=false
if not nook then wrlog "create folder fautcopy:"&fautcopy&" excludesystem:"&excludesystem & " excludeusers:"& excludeusers& " " &disp(attribfo)& " " & sourcefo
'
if fautcopy then
on error resume next
fs.createfolder ouf
if err.number>0 then
wrlog "ERREUR: 4 " &err.number & ": " & err.description & " " & err.source
err.clear
on error goto 0
exit function
end if '>0
on error goto 0
' wrlog "getgfolder " &ouf
set onefolder=fs.getfolder(ouf)
onefolder.attributes=attribfo
end if ' not nocopy
end if ' copy
end if ' bat or copy
anti=""
if mid(p,len(p))<>"\" then anti="\"
' recursion
fsize=0
fautcopy=true
' wrlog "sourefo:::::"&sourcefo&":::::"
if excludeusers and debute(14,sourcefo,"users\") then fautcopy=false
if excludeusers and debute(1,sourcefi,"documents and settings\") then fautcopy=false
if excludewindows and debute(154,sourcefo,"windows\") then fautcopy=false
if excludeprograms and debute(16,sourcefo,"program files\") then fautcopy=false
if excludeprograms and debute(17,sourcefo,"program files (x86)\") then fautcopy=false
if excludesystem and issystem(attribfo) then fautcopy=false
' wrlog "explore foilder fautcopy:"&fautcopy&" excludesystem:"&excludesystem & " excludeusers:"& excludeusers& " " &disp(attribfo)& " " & sourcefo
if fautcopy then
fsize=level(p & anti& p2,attribfo)
if fsize=-1 then
wrlog "retour -1 attibfo:" & attribfo & " " &p & anti& p2
else
fmax=bsize*int((fsize+bsize-1)/bsize)
smax=smax+fmax
end if
else
wrlog "no more folder: """ & p & "\" & onefolder.name&""""
end if
end if ' ajoute 2211
Next ' fc folders
dim t1
t1=trailer
if mid(p,len(p))="\" then t1=""
if not onlyfiles then wrlog remdos & "FOLD " & fixe(smax) &" " & disp(attx) & " """ & p & t1 & """"
profondeur=profondeur-1
level=smax
end function
function fixe(n)
dim nn
if bycluster then
nn=int((n+bsize-1)/bsize)
else
nn=n
end if
dim f
f=" " & nn
fixe=mid(f,len(f)-14)
end function
sub info (l)
Set objdrive = fs.GetDrive(fs.GetDriveName(l))
wrlog "Available space: " & objDrive.AvailableSpace
wrlog "Drive letter: " & objDrive.DriveLetter
wrlog "Drive type: " & objDrive.DriveType
wrlog "File system: " & objDrive.FileSystem
wrlog "Free space: " & objDrive.FreeSpace
wrlog "Is ready: " & objDrive.IsReady
wrlog "Path: " & objDrive.Path
wrlog "Root folder: " & objDrive.RootFolder
wrlog "Serial number: " & objDrive.SerialNumber
wrlog "Share name: " & objDrive.ShareName
wrlog "Total size: " & objDrive.TotalSize
wrlog "Volume name: " & objDrive.VolumeName
end sub
function disp(nn)
dim n
n=nn
dim d
d=""
'd=" " & n & ":"
if n MOD 2 <> 0 then d=d &"/R"
n=int(n/2)
if n MOD 2 <> 0 then d=d & "/H"
n=int(n/2)
if n MOD 2 <> 0 then d=d & "/S"
n=int(n/2)
if n MOD 2 <> 0 then d=d & "/V"
n=int(n/2)
if n MOD 2 <> 0 then d=d & "/F"
n=int(n/2)
if n MOD 2 <> 0 then d=d & "/A"
n=int(n/2) '64
n=int(n/2) ' 128
n=int(n/2) ' 256
n=int(n/2) ' 512
n=int(n/2) '1024
if n MOD 2 <> 0 then d=d & "/L"
n=int(n/2) '2048
if n mod 2 <> 0 then d=d & "/C"
disp=d
end function
function issystem(nn)
issystem= instr(disp(nn),"/S")>0
end function
function islink(nn)
islink= instr(disp(nn),"/L")>0
end function
sub init
dim i
for i=0 to 127
tab(i)=chr(i)
next 'i
for i=128 to 255
tab(i)=chr(0)
next 'i
tab(233)=chr(130) ' "é"
tab(231)=chr(135) ' "ç"
tab(224)=chr(153)' "à"
tab(232)=chr(138)' "è"
tab(249)=chr(151) '"ù"
tab(226)=chr(131) '"â"
tab(234)=chr(136) '"ê"
end sub
function w3dos (jn)
if not bat then
w3dos=jn
exit function
end if
dim ot
ot=""
dim i
for i=1 to len(jn)
dim car
car=mid(jn,i,1)
dim ascii
ascii=asc(car)
' wrlog len(jn) & " " & i & " " & car & " add " & ascii & " " & tab(ascii)
dim traduit
traduit = tab(ascii)
if traduit=chr(0) then msgbox jn & vbcrlf & "ajouter "&car& " " & ascii
if ascii>127 then wrlog remdos & " traduit " & ascii & " " & car & ">" & traduit
ot=ot&traduit
next 'i
w3dos=ot
end function
function w4dos (jn)
w4dos=jn
return
' msgbox jn
dim ot
ot=""
dim i
for i=1 to len(jn)
dim car
car=mid(jn,i,1)
dim ascii
ascii=asc(car)
code = tab(ascii)
msgbox "decode " & ascii
if code=chr(0) then
msgbox jn & " TRADUIRE:" & cun & " " & asc(cun)
else
ot=ot & chr(code)
end if
next 'i
wrlog jn & " TRADUIT:" & jn
msgbox "ot:" & ot
w4dos=ot
end function
sub wrlog(t)
' exit sub
stdout.writeline t
if nolog then EXIT SUB
if len(logname)=0 then
buffer=buffer & vbcrlf & t
else
logfile.writeline t
end if
end sub
sub wrerr(t)
stdout.writeline "ERREUR " & t
if not nolog then exit sub
if len(logname)>0 then
logfile.writeline "ERREUR "& tt
else
buffer=buffer & vbcrlf & "ERreur " & t
end if
end sub
function nonow
dim n
n=now
'dim elapsed
'elapsed=timer()-start
dim et
et=timer()
if start>=0 then
nonow=FormatNumber(et - Start, 0)&""""
else
nonow=mid(n,7,4)&mid(n,4,2)&mid(n,1,2)&mid(n,11)
end if
end function
function debute(appel,meule,aiguille)
if len(meule)=0 then
debute=false
exit function
end if
'wrlog ucase(meule) & " " & ucase(aiguille) & " ==== " & instr(ucase(meule), ucase(aiguille))&" ok="&ok
dim ou
ou= instr(ucase(meule)&"\", ucase(aiguille)&"\")
'wrlog meule & " " & aiguille & " " & ou
debute= ou=4
end function