Exported from Notepad++

REM ============================================================ REM Fichier : dir_longest_path.vbs REM Desc : recherche les plus longs chemins dans une arborescence (utilisation de dir et sort) REM Année : 2009 REM Auteur : X. Gangand REM a faire : rediriger les erreurs vers un fichier (2>...) quand on lance le dir REM ============================================================ '********** Liste des procédures et fonctions ********** 'Sub Main Procédure principale'Sub Scanner1(sDossier) 'Sub DelFileIfExists Supprimer un fichier s'il existe 'Sub EnleverSautLigneFinal Enlever le vbCrLf final d'un fichier 'Sub GetPath_Lengths Analyser les fichiers issus de la commande dir 'Function LesPlusLongs Générer le code des tables HTML pour les 50 plus ongs D+F 'Sub ScannerDossier Lancer recherche dossiers et fichiers 2 'Sub SaveToFile Sauvegarde un texte dans un fichier 'Function ShellRun Lancer une commande Run de l'object Shell '********** Fin liste procédures fonctions ********** Option Explicit Const OUTPUT_FILE = "dir_longest_path.htm" Const MAX_DISPLAY = 25 'valeur à changer si on veut afficher plus de longs chemins Dim gHTML, gHTML_recap Main Sub Main REM ========================================== REM Procédure principale REM ========================================== If Wscript.Arguments.Count = 0 Then Msgbox "Passer un/des dossiers en arguments (exemple : c:\ d:\)" Wscript.Quit(0) End If Wscript.Echo "Recherche des plus longs chemins dans les dossiers spécifiés." Dim sAdvice sAdvice = _ " Il arrive parfois qu'un fichier/dossier devienne inaccessible" & vbcrlf & _ " Ceci peut être dû à une arborescence trop longue en amont de ce fichier/dossier." & vbcrlf & _ " (pour le rendre de nouveau accessible, renommer un ou plusieurs dossiers en amont)" & vbcrlf & _ " Cet utilitaire vous aide à repérer les longs dossiers." & vbcrlf & _ " " 'init code HTML gHTML = _ "<html> " & vbcrlf & _ "<body bgcolor=#FFFCB1>" & vbcrlf & _ "<hr>" & vbcrlf & _ "<center>" & vbcrlf & _ "<h2>Recherche des plus longs chemins dans une arborescence</h2>" & vbcrlf & _ "Utilisation des commandes internes dir et sort" & vbcrlf & _ "<hr>" & vbcrlf & _ " " & vbcrlf & _ " " & vbcrlf & _ sAdvice & vbcrlf & _ "</center>" & vbcrlf & _ "[[gHTML_recap]]" gHTML_recap = "<center><table border=10>" & vbcrlf & _ "<tr> <td> Dossier</td>" & vbcrlf & _ " <td align=right>Nb Sous-dossiers</td>" & vbcrlf & _ " <td align=right>Plus long path</td>" & vbcrlf & _ " <td align=right>Nb fichiers</td>" & vbcrlf & _ " <td align=right>Plus long path</td>" & vbcrlf & _ "</tr>" 'scanner chjaque dossier de la ligne de commande Dim i, oFSO, tArg Set oFSO = CreateObject("Scripting.FileSystemObject") Set tArg = Wscript.Arguments For i = 0 To Wscript.Arguments.Count-1 If oFSO.FolderExists(tArg(i)) Then Scanner1 tArg(i) Next 'finaliser le code HTML gHTML = _ gHTML & vbcrlf & _ "</body> " & vbcrlf & _ "</html>" gHTML_recap = _ gHTML_recap & "<table> </center> " 'sauvegarder les résultats gHTML = Replace(gHTML, "[[gHTML_recap]]", gHTML_recap) SaveToFile gHTML, OUTPUT_FILE Wscript.Echo vbcrlf & "Résultats enregistrés dans le fichier " & OUTPUT_FILE & "." 'ménage DelFileIfExists "directories.tmp" DelFileIfExists "files.tmp" DelFileIfExists "u_numerote.txt" DelFileIfExists "u_numerote_sorted.txt" End Sub Function CountLines(sFile) REM ========================================= REM Compter le nombre de lignes d'un fichier REM ========================================= Dim ofso_cl, f, n Set ofso_cl = CreateObject("Scripting.FileSystemObject") Set f = ofso_cl.OpenTextFile(sFile) Do f.SkipLine n = n + 1 Loop Until f.AtEndOfStream CountLines = n End Function Function LesPlusLongs(sDossier, les50d, les50f) REM ========================================== REM Générer le code des tables HTML pour les 50 plus ongs D+F REM ========================================== LesPlusLongs = vbcrlf & _ " " & vbcrlf & _ "<table border=5>" & vbcrlf & _ "<tr><td colspan=3 align=middle>Dossiers de " & sDossier & "</td></tr>" & vbcrlf & _ " <td>N°</td>" & vbcrlf & _ " <td>Long.</td>" & vbcrlf & _ " <td>Dossier</td>" & vbcrlf & _ "</tr>" & vbcrlf & _ CreerCorpsTableau (les50d) & vbcrlf & _ "</table>" & vbcrlf & _ " " & vbcrlf & _ " " & vbcrlf & _ " " & vbcrlf & _ "<table border=5>" & vbcrlf & _ "<tr><td colspan=3 align=middle>Fichiers de " & sDossier & "</td></tr>" & vbcrlf & _ " <td>N°</td>" & vbcrlf & _ " <td>Long.</td>" & vbcrlf & _ " <td>Dossier</td>" & vbcrlf & _ "</tr>" & vbcrlf & _ CreerCorpsTableau (les50f) & vbcrlf & _ "</table> " End Function Function CreerCorpsTableau(g) REM ========================================== REM Ajouter un point-virgule entre le nombre 0001, 0254, ... REM et le nom complet du dossier/fichier REM ========================================== Dim tt, i, Zebre, sSep, b, j, sLongueur sSep = "|" tt = Split(g, vbcrlf) For i = LBound(tt) To UBound(tt) sLongueur = Left(tt(i),4) Do If Left(sLongueur,1) = "0" Then sLongueur = Right(sLongueur, Len(sLongueur) - 1) Else Exit Do End If Loop Zebre = sLongueur & sSep & Right(tt(i), Len(tt(i))-4) 'mettre en gras un élément sur deux 'dans l'ensemble délimité par \ b = Split(Zebre, "\") Zebre = b(0) For j = 1 To UBound(b) If j Mod 2 = 1 Then Zebre = Zebre & "\" & "" & b(j) & "" Else Zebre = Zebre & "\" & b(j) End If Next tt(i) = "" & Zebre & "" Next CreerCorpsTableau = Tab2HTML(tt, sSep, "rr") End Function Sub DelFileIfExists(sFile) REM ================================== REM = Supprimer un fichier s'il existe REM ================================== On Error Resume Next Dim oFSOdf Set oFSOdf = CreateObject("Scripting.FileSystemObject") If oFSOdf.FileExists(sFile) Then oFSOdf.DeleteFile sFile End If End Sub Sub GetPath_Lengths(sFile, nb, sLongest, les50plus_longs) REM ========================= REM Analyser les fichiers issus de la commande dir REM les50plus_longs est une chaine avec des sauts de ligne pour séparer chaque élément REM nb est read-only REM ========================= Dim tout, u, i, n 'reconstruire le tableau ajouter la longueur en tête de chaque ligne tout = FileReadAll(sFile) u = Split(tout, vbCrLf) For i = LBound(u) To UBound(u) n = Len(u(i)) n = String(4-Len(Len(u(i))), "0") & Len(u(i)) & u(i) u(i) = n Next 'trier avec la aommnde sort (beaucoup plus rapide que QSort_Simple) SaveToFile Join(u, vbcrlf), "u_numerote.txt" ShellRun "cmd /c sort < u_numerote.txt", "u_numerote_sorted.txt" EnleverSautDeLigneFinal "u_numerote_sorted.txt" u = Split(FileReadAll("u_numerote_sorted.txt"), vbCrLf) 'initialiser pour éviter de retrouver le saut de ligne en début (=ligne vide qui pose problème après) les50plus_longs = u(UBound(u)) 'ATTENTION : problème pour dossier très petit For i = UBound(u)-1 To UBound(u)-(MAX_DISPLAY-1) Step - 1 les50plus_longs = les50plus_longs & vbcrlf & u(i) Next sLongest = u(UBound(u)) End Sub Sub Scanner1(sDossier) REM ========================================== REM Traiter un dossier de la ligne de commande REM ========================================== 'pour chaque dossier traité, l'ajouter dans le sommaire 'afficher 5 colonnes : dossier , nb sous-dossiers, nombre de fichiers, plus long chemin dossier, plus long chemin fichier Dim les50f, les50d, nbd, nbf, sLongestPathD, sLongestPathF Wscript.Echo "" ScannerDossier sDossier, "dossiers", "directories.tmp", nbd ScannerDossier sDossier, "fichiers", "files.tmp", nbf Wscript.Echo "" GetPath_Lengths "directories.tmp", nbd, sLongestPathD, les50d GetPath_Lengths "files.tmp", nbf, sLongestPathF, les50f Wscript.Echo nbd & " dossiers, " & nbf & " fichiers trouvés." 'tabeau récapitulatif gHTML_recap = gHTML_recap & vbcrlf & _ "<tr> <td>" & sDossier & "</td>" & vbcrlf & _ " <td align=right>" & FormatNumber(nbd,False,,,True) & "</td>" & vbcrlf & _ " <td align=right>" & Len(sLongestPathD)-4 & "</td>" & vbcrlf & _ " <td align=right>" & FormatNumber(nbf,False,,,True) & "</td>" & vbcrlf & _ " <td align=right>" & Len(sLongestPathF)-4 & "</td>" & vbcrlf & _ "</tr>" REM les50d est une chaine avec des sauts de ligne pour séparer chaque élément REM les50f est une chaine avec des sauts de ligne pour séparer chaque élément gHTML = gHTML & vbcrlf & _ LesPlusLongs (sDossier, les50d, les50f) End Sub Function Tab2HTML(t, sSep, sPosition) REM ========================================== REM Transforme un tableau VBS en tableau HTML REM Le tableau t contient des lignes, dont les éléments sont séparés par sSep REM ========================================== Dim i, u, j For i = LBound(t) To UBound(t) Tab2HTML = Tab2HTML & vbcrlf & " <tr>" u = Split(t(i), sSep) Tab2HTML = Tab2HTML & vbcrlf & " <td align=middle>" & i+1 & "</td>" For j= 0 To UBound(u) Tab2HTML = Tab2HTML & vbcrlf & " <td aligne=middle>" & u(j) & "</td>" Next Tab2HTML = Tab2HTML & vbcrlf & " </tr>" Next End Function Sub ScannerDossier (Dossier, sType, sReportFile, nb) REM ========================================= REM Lancer recherche dossiers et fichiers 2 REM Attention : la commande dir ajoutre un saut de ligne à la dernière ligne REM ========================================= Wscript.Echo "Recherche des " & sType & " dans " & Dossier & " ..." Select Case sType Case "dossiers" : ShellRun "cmd /c dir """ & Dossier & """ /ad /s /b ", sReportFile Case "fichiers" : ShellRun "cmd /c dir """ & Dossier & """ /a-d /s /b ", sReportFile End Select 'enlever le CRLF de fin de fichier EnleverSautDeLigneFinal(sReportFile) nb = CountLines(sReportFile) End Sub Sub EnleverSautDeLigneFinal(sFile) REM ========================================= REM Enlever le vbCrLf final d'un fichier REM ========================================= Dim tout tout = FileReadAll(sFile) If Right(tout, Len(vbcrlf)) = vbcrlf Then tout = Left(tout, Len(tout) - Len(vbCrLf)) SaveToFile tout, sFile End If End Sub Function FileReadAll(sFile) REM ======================================== REM = Renvoie le contenu complet d'un fichier texte REM ======================================== On Error Resume Next Dim f, oFSOstf Set oFSOstf = CreateObject("Scripting.FileSystemObject") Set f = oFSOstf.OpenTextFile(sFile) If Err Then Msgbox "Erreur de lecture du fichier " & sFile & vbCrLf & "Fin du programme." WScript.Quit(0) End If FileReadAll = f.ReadAll Set f = Nothing Set oFSOstf = Nothing End Function Sub SaveToFile (sTexte, sFile) REM ======================================== REM = Sauvegarde un texte dans un fichier REM ======================================== Dim oFSOstf, f1 Set oFSOstf = CreateObject("Scripting.FileSystemObject") Set f1 = oFSOstf.CreateTextFile(sFile) f1.Write sTexte f1.Close Set f1 = Nothing Set oFSOstf = Nothing End Sub Function ShellRun(sCmd, sOutputFile) REM =========================================== REM = Lancer une commande Run de l'object Shell REM = vers le fichier sOutputFile (synchrone) REM = ATTENTION : toujours vérifier cmd /c !!! REM =========================================== Dim oShell Set oShell = CreateObject("Wscript.Shell") ShellRun = oShell.Run(sCmd & " > " & sOutputFile, 0, True) '0 = '1 = Activates and displays a window 'true = bWaitOnReturn, Boolean value 'indicating whether the script should 'wait for the program to finish executing 'before continuing to the next statement in your script. Set oShell = Nothing End Function