1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199
| Option Explicit
Dim oFilesys,oFiletxt,Path,Ws,SourceImgFolder,StartTime,MsgTitre,DurationTime,objFolder,CheminDossier,Dossier,Copyright
Dim SizeKo,SizeMo,SizeGo,objShell,size,Sig,OutFile,MsgAttente,oExec,Temp
Copyright = "© Hackoo © 2014"
Set ws = CreateObject("wscript.Shell")
Temp = ws.ExpandEnvironmentStrings("%Temp%")
MsgTitre = "Generer une arborescence d'un dossier en HTML "&Copyright&""
MsgAttente = "Veuillez patienter un peu la generation est en cours..."
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(0, "Veuillez choisir un dossier "&Copyright, 1, "c:\Programs")
If objFolder Is Nothing Then
WScript.Quit
End If
CheminDossier = objFolder.self.path
OutFile = objFolder.self.name &".hta"
OutFile = Trim(OutFile)
OutFile = Replace(OutFile,":","") ' * ouvre la fenetre vide HTA a partir du dossier System32 par defaut pour des raisons inconnues (en particulier pour mon systeme)
Set oFilesys = CreateObject("Scripting.FileSystemObject") ' * assez pour creer un objet qu'une seule fois
On error Resume Next
Set Dossier = oFilesys.GetFolder(CheminDossier)
If Err <> 0 Then
MsgBox Err.Number & VbCrLF & Err.Description,16,MsgTitre
On Error GoTo 0
End if
SizeKo = Round(FormatNumber(Dossier.Size)/(1024),2) & " Ko" 'Taille en Ko avec 2 chiffres apres la Virgule
SizeMo = Round(FormatNumber(Dossier.Size)/(1048576),2) & " Mo" 'Taille en Mo avec 2 chiffres apres la Virgule
SizeGo = Round(FormatNumber(Dossier.Size)/(1073741824),2) & " Go" 'Taille en Go avec 2 chiffres apres la Virgule
If Dossier.size < 1024 Then
Size = Dossier.size & " Octets"
elseif Dossier.size < 1048576 Then
Size = SizeKo
elseif Dossier.size < 1073741824 Then
Size = SizeMo
else
Size = SizeGo
end If
Set oFiletxt = oFilesys.CreateTextFile(OutFile,True,-1)
Set Ws = CreateObject("Wscript.Shell")
oFiletxt.WriteLine("<html><HTA:APPLICATION SCROLL=""yes"" WINDOWSTATE=""Maximize""icon=""verifier.exe""><body text=white bgcolor=#1234568>"&_
"<meta content=""text/html; charset=UTF-8"" http-equiv=""content-type"">"&_
"<style type='text/css'>"&_
"a:link {color: #F19105;}"&_
"a:visited {color: #F19105;}"&_
"a:active {color: #F19105;}"&_
"a:hover {color: #FF9900;background-color: rgb(255, 255, 255);}"&_
"</style>")
oFiletxt.writeline "<SCRIPT LANGUAGE=""VBScript"">"
oFiletxt.writeline "Function Explore(filename)"
oFiletxt.writeline "Set ws=CreateObject(""wscript.Shell"")"
oFiletxt.writeline "ws.run ""Explorer /n,/select,""&filename&"""""
oFiletxt.writeline "End Function"
oFiletxt.writeline "Function ExpandTrigger()" '*Fonction pour afficher et de masquer du contenu ajouté par omegastripes (un grand merci à lui)
oFiletxt.writeline " With Window.Event.SrcElement" 'http://www.visualbasicscript.com/fb.ashx?m=104343
oFiletxt.writeline " If .FirstChild.NodeValue = ""+"" Then"
oFiletxt.writeline " .FirstChild.NodeValue = """""
oFiletxt.writeline " .NextSibling.NextSibling.NextSibling.Style.Display = ""inline"""
oFiletxt.writeline " Else"
oFiletxt.writeline " .FirstChild.NodeValue = ""+"""
oFiletxt.writeline " .NextSibling.NextSibling.NextSibling.Style.Display = ""none"""
oFiletxt.writeline " End If"
oFiletxt.writeline " End With"
oFiletxt.writeline "End Function"
oFiletxt.writeline "</SCRIPT>"
Sig = "<center><hr><img src='"&Chr(104)&Chr(116)&Chr(116)&Chr(112)&Chr(58)&Chr(47)&Chr(47)&Chr(110)&Chr(115)&Chr(109)&_
Chr(48)&Chr(53)&Chr(46)&Chr(99)&Chr(97)&Chr(115)&Chr(105)&_
Chr(109)&Chr(97)&Chr(103)&Chr(101)&Chr(115)&Chr(46)&Chr(99)&Chr(111)&Chr(109)&Chr(47)&Chr(105)&_
Chr(109)&Chr(103)&Chr(47)&Chr(50)&Chr(48)&Chr(49)&Chr(49)&Chr(47)&Chr(48)&Chr(55)&Chr(47)&Chr(50)&_
Chr(51)&Chr(47)&Chr(47)&Chr(49)&Chr(49)&Chr(48)&Chr(55)&_
Chr(50)&Chr(51)&Chr(48)&Chr(55)&Chr(52)&Chr(49)&_
Chr(52)&Chr(48)&Chr(49)&Chr(51)&Chr(49)&Chr(49)&Chr(48)&_
Chr(52)&Chr(56)&Chr(53)&Chr(48)&Chr(54)&Chr(52)&Chr(49)&_
Chr(57)&Chr(46)&Chr(103)&Chr(105)&Chr(102)&"' alt='"&Chr(104)&Chr(97)&_
Chr(99)&Chr(107)&Chr(111)&Chr(111)&Chr(102)&Chr(114)&Chr(64)&_
Chr(121)&Chr(97)&Chr(104)&Chr(111)&Chr(111)&Chr(46)&Chr(102)&Chr(114)&"'</img><hr></center>"
SourceImgFolder = "http://www.webmasters.by/images/articles/css-tree/folder-horizontal.png"
'"http://upload.wikimedia.org/wikipedia/commons/a/a4/Icons-mini-folder.gif"
Call CreateProgressBar(MsgTitre,MsgAttente)'Creation de barre de progression
Call LancerProgressBar()'Lancement de la barre de progression
StartTime = Timer 'Debut du Compteur Timer
wscript.sleep 5000
oFiletxt.WriteLine("<span onclick='ExpandTrigger' style='cursor: pointer;'>+</span><span> <img src="&SourceImgFolder&"><A href=""#"" OnClick='Explore("""& CheminDossier & """)'>" & CheminDossier & "</A><font color=""Yellow""> ["&Size&"]</font></span><br>") ' * l'obtention de la structure necessaire pour la fonction
oFiletxt.WriteLine("<div style='display: none;'>")
List(CheminDossier)
oFiletxt.WriteLine("</div>")
oFiletxt.WriteLine(Sig)
oFiletxt.WriteLine("</body></hmtl>")
oFiletxt.Close
Call FermerProgressBar()'Fermeture de barre de progression
DurationTime = FormatNumber(Timer - StartTime, 0) & " seconds." 'La duree de l'execution du script
Ws.Popup "La generation au format HTML est terminee en "& DurationTime & " !","2",MsgTitre,64
Ws.Run DblQuote(OutFile), 1, True ' * apres l'utilisation
'oFilesys.DeleteFile OutFile, True ' * nettoyage de debris
'*********************************************************************************
Function List(directory)
Dim fsoFolder,Folder,subfolders,objFile,objFolder,subfiles,SourceImgFile,NBFiles,Size,SizeKo,SizeMo,SizeGo,SourceImgFolder
On Error Resume next
Set fsoFolder = CreateObject("Scripting.FileSystemObject")
Set folder = fsoFolder.GetFolder(directory)
Set subfolders = folder.SubFolders
Set subfiles = folder.Files
SourceImgFolder = "http://www.webmasters.by/images/articles/css-tree/folder-horizontal.png"
'"http://upload.wikimedia.org/wikipedia/commons/a/a4/Icons-mini-folder.gif"
SourceImgFile = "http://upload.wikimedia.org/wikipedia/en/d/d8/VBSccript_file_format_icon.png"
NBFiles = 0
For each objFile in subfiles
NBFiles = NBFiles + 1
SizeKo = Round(FormatNumber(objFile.Size)/(1024),2) & " Ko" 'Taille en Ko avec 2 chiffres apres la Virgule
SizeMo = Round(FormatNumber(objFile.Size)/(1048576),2) & " Mo" 'Taille en Mo avec 2 chiffres apres la Virgule
SizeGo = Round(FormatNumber(objFile.Size)/(1073741824),2) & " Go" 'Taille en Go avec 2 chiffres apres la Virgule
If objFile.size < 1024 Then
Size = objFile.size & " Octets"
elseif objFile.size < 1048576 Then
Size = SizeKo
elseif objFile.size < 1073741824 Then
Size = SizeMo
else
Size = SizeGo
end If
oFiletxt.WriteLine("<dt>"& NBFiles &" |-<img src="&SourceImgFile&" height=""14"" width=""14""><A href=""#"" OnClick='Explore("""& objFile.Path & """)'>" & objFile.Name & "</A> ("&Size&")</dt><br>")
Next
For each objFolder in subfolders
SizeKo = Round(FormatNumber(objFolder.Size)/(1024),2) & " Ko" 'Taille en Ko avec 2 chiffres apres la Virgule
SizeMo = Round(FormatNumber(objFolder.Size)/(1048576),2) & " Mo" 'Taille en Mo avec 2 chiffres apres la Virgule
SizeGo = Round(FormatNumber(objFolder.Size)/(1073741824),2) & " Go" 'Taille en Go avec 2 chiffres apres la Virgule
If objFolder.size < 1024 Then
Size = objFolder.size & " Octets"
elseif objFolder.size < 1048576 Then
Size = SizeKo
elseif objFolder.size < 1073741824 Then
Size = SizeMo
else
Size = SizeGo
end If
oFiletxt.WriteLine("<DL><hr>")
oFiletxt.WriteLine("<span onclick='ExpandTrigger' style='cursor: pointer;'>+</span><span> <img src="&SourceImgFolder&"><A href=""#"" OnClick='Explore("""& objFolder.Path & """)'>" & objFolder.Path & "</A> <font color=""Yellow"">["&Size&"]</font></span><br>") ' * l'obtention de la structure necessaire pour la fonction
oFiletxt.WriteLine("<div style='display: none;'>")
List(objFolder) 'Appel recusive de la fonction List
oFiletxt.WriteLine("</div>")
oFiletxt.WriteLine("</DL>")
Next
End Function
'****************************************************************************************************
Sub CreateProgressBar(Titre,MsgAttente)
Dim ws,fso,f,f2,ts,ts2,Ligne,i,fread,LireTout,NbLigneTotal,Temp,PathOutPutHTML,fhta,oExec
Set ws = CreateObject("wscript.Shell")
Set fso = CreateObject("Scripting.FileSystemObject")
Temp = WS.ExpandEnvironmentStrings("%Temp%")
PathOutPutHTML = Temp & "\Barre.hta"
Set fhta = fso.OpenTextFile(PathOutPutHTML,2,True)
fhta.WriteLine "<HTML>"
fhta.WriteLine "<HEAD>"
fhta.WriteLine "<Title> " & Titre & "</Title>"
fhta.WriteLine "<HTA:APPLICATION"
fhta.WriteLine "ICON = ""magnify.exe"" "
fhta.WriteLine "BORDER=""THIN"" "
fhta.WriteLine "INNERBORDER=""NO"" "
fhta.WriteLine "MAXIMIZEBUTTON=""NO"" "
fhta.WriteLine "MINIMIZEBUTTON=""NO"" "
fhta.WriteLine "SCROLL=""NO"" "
fhta.WriteLine "SYSMENU=""NO"" "
fhta.WriteLine "SELECTION=""NO"" "
fhta.WriteLine "SINGLEINSTANCE=""YES"">"
fhta.WriteLine "</HEAD>"
fhta.WriteLine "<BODY text=""white""><CENTER><DIV><SPAN ID=""ProgressBar""></SPAN>"
fhta.WriteLine "<span><marquee DIRECTION=""LEFT"" SCROLLAMOUNT=""3"" BEHAVIOR=ALTERNATE><font face=""Comic sans MS"">" & MsgAttente &"</font></marquee></span></DIV></CENTER></BODY></HTML>"
fhta.WriteLine "<SCRIPT LANGUAGE=""VBScript""> "
fhta.WriteLine "Set ws = CreateObject(""wscript.Shell"")"
fhta.WriteLine "Temp = WS.ExpandEnvironmentStrings(""%Temp%"")"
fhta.WriteLine "Sub window_onload()"
fhta.WriteLine " CenterWindow 430,90"
fhta.WriteLine " Self.document.bgColor = ""Orange"" "
fhta.WriteLine " End Sub"
fhta.WriteLine " Sub CenterWindow(x,y)"
fhta.WriteLine " Dim iLeft,itop"
fhta.WriteLine " window.resizeTo x,y"
fhta.WriteLine " iLeft = window.screen.availWidth/2 - x/2"
fhta.WriteLine " itop = window.screen.availHeight/2 - y/2"
fhta.WriteLine " window.moveTo ileft,itop"
fhta.WriteLine "End Sub"
fhta.WriteLine "</script>"
fhta.close
End Sub
'**********************************************************************************************
Sub LancerProgressBar()
Set oExec = Ws.Exec("mshta.exe " & Temp & "\Barre.hta")
End Sub
'**********************************************************************************************
Sub FermerProgressBar()
oExec.Terminate
End Sub
'**********************************************************************************************
Function DblQuote(Str)
DblQuote = Chr(34) & Str & Chr(34)
End Function
'********************************************************************************************** |
Partager