[VBS] Collapse and Expand ?
Posted: Fri Feb 28, 2014 8:45 pm
Hi
In order to finish my code, i would like to add a function when i click over (+) ==> Expand
and when i click over (-) ==> Collpase
So here is my code :
In order to finish my code, i would like to add a function when i click over (+) ==> Expand
and when i click over (-) ==> Collpase
So here is my code :
VBScript Code
Double-click the code block to select all.Option Explicit Dim oFilesys,oFiletxt,Path,Ws,SourceImgFolder,StartTime,MsgTitre,DurationTime,objFolder,CheminDossier,Dossier,Copyright Dim SizeKo,SizeMo,SizeGo,objShell,fso,size,Sig,OutFile,MsgAttente,oExec,Temp Copyright = "© Hackoo © 2014" Set ws = CreateObject("wscript.Shell") Temp = ws.ExpandEnvironmentStrings("%Temp%") MsgTitre = "Générer une arborescence d'un dossier en HTML "&Copyright&"" MsgAttente = "Veuillez patienter un peu la génération 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,":","") Set fso = CreateObject("Scripting.FileSystemObject") On error Resume Next Set Dossier = fso.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 après la Virgule SizeMo = Round(FormatNumber(Dossier.Size)/(1048576),2) & " Mo" 'Taille en Mo avec 2 chiffres après la Virgule SizeGo = Round(FormatNumber(Dossier.Size)/(1073741824),2) & " Go" 'Taille en Go avec 2 chiffres après 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 oFilesys = CreateObject("Scripting.FileSystemObject") 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 "</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://upload.wikimedia.org/wikipedia/c ... folder.gif" Call CreateProgressBar(MsgTitre,MsgAttente)'Creation de barre de progression Call LancerProgressBar()'Lancement de la barre de progression StartTime = Timer 'Début du Compteur Timer wscript.sleep 1000 oFiletxt.WriteLine("+ <img src="&SourceImgFolder&"><A href=""#"" OnClick='Explore("""& CheminDossier & """)'>" & CheminDossier & "</A><font color=""Yellow""> ["&Size&"]</font><hr>") oFiletxt.WriteLine(List(CheminDossier)) oFiletxt.WriteLine(Sig) oFiletxt.WriteLine("</body></hmtl>") oFiletxt.Close Call FermerProgressBar()'Fermeture de barre de progression DurationTime = FormatNumber(Timer - StartTime, 0) & " seconds." 'La durée de l'exécution du script Ws.Popup "La génération au format HTML est terminée en "& DurationTime & " !","2",MsgTitre,64 Ws.Run DblQuote(OutFile) '********************************************************************************* 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://upload.wikimedia.org/wikipedia/c ... folder.gif" SourceImgFile = "http://upload.wikimedia.org/wikipedia/e ... t_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 après la Virgule SizeMo = Round(FormatNumber(objFile.Size)/(1048576),2) & " Mo" 'Taille en Mo avec 2 chiffres après la Virgule SizeGo = Round(FormatNumber(objFile.Size)/(1073741824),2) & " Go" 'Taille en Go avec 2 chiffres après 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 après la Virgule SizeMo = Round(FormatNumber(objFolder.Size)/(1048576),2) & " Mo" 'Taille en Mo avec 2 chiffres après la Virgule SizeGo = Round(FormatNumber(objFolder.Size)/(1073741824),2) & " Go" 'Taille en Go avec 2 chiffres après 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("+ <img src="&SourceImgFolder&"><A href=""#"" OnClick='Explore("""& objFolder.Path & """)'>" & objFolder.Path & "</A> <font color=""Yellow"">["&Size&"]</font>") List(objFolder) 'Appel récusive de la fonction List 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 '**********************************************************************************************Thank you for any idea