LAUTREESIZE

Commentaire de joebarteamv le 30/06/2008 00:30:07

Bonjour; tous les droits te sont reservées et aussi les bugs!!!
ca bug ton logiciel;
ensuite point de vue creation ; il y a de la conception et cela a retenu mon attention!
Essaye par exemple de faire des gestion interruptions plus efficaces et de travailler avec des tableaux dynamiques pour ameliorer la rapidité du prog!!
Bonne continuation
(le bug ce le path qui prend le nom du volume entier au lieu de prendre son nom msdos)

Commentaire de Renfield le 30/06/2008 09:11:34 administrateur CS

d'accord avec Jack... je lance et boum, chemin d'accès introuvable..

FileExplorer.Path = Drive1.Drive & "\"
donne:  

d: [DONNEES]\

Commentaire de Renfield le 30/06/2008 10:08:41 administrateur CS

j'ai fait l'exercice d'ajouter ma classe...
j'ai viré tout ton code.  j'ai mis que l'essentiel (liste des dossiers dans ListView1, taille de ceux-ci)...

pas de fichiers, d'arbre, ni de pourcentage... mais coté rapidité, ca n'a rien a voir, surtout que pendant le calcul de la taille, on peut faire autre chose, changer de répertoire, etc...

j'ai inséré également le code:
http://www.vb-helper.com/howto_format_bytes_big.html


===========================================================

modification de ma classe (ajout d'une propriété FolderSize, qui parcoure le tout récursivement)

Private mbAbort As Boolean

Public Sub Terminate()
    mbAbort = True
    DoEvents
    If mhFind Then
        FindClose mhFind
        mhFind = 0
    End If
End Sub

Public Property Get FolderSize() As Variant
Dim oDir As CDir
    If (Me.Attributes And vbDirectory) = vbDirectory Then
        Set oDir = New CDir
        oDir.Initialize Me.FullPath & "\"
        Do Until oDir.EOF
            If (oDir.Attributes And vbDirectory) = vbDirectory Then
                FolderSize = FolderSize + oDir.FolderSize
                DoEvents
            Else
                FolderSize = FolderSize + oDir.FileSize
            End If
            oDir.MoveNext
            If mbAbort Then
                Exit Do
            End If
        Loop
    End If
End Property

'# On démarre une nouvelle enumeration
'# Par default, on accepte tousles atributs
Public Sub Initialize(ByVal vsPath As String, Optional veAttributes As FileAttributes = &HFFFFFFFF)
Dim i As Long
    mbAbort = False
    '# Si une recherche etait deja en cours, on la stoppe
    If mhFind Then
        Call FindClose(mhFind)
    End If
    
    '# On récupère le chemin
    i = InStrRev(vsPath, "\")
    If i Then
        msPath = Left$(vsPath, i)
    Else
        msPath = vbNullString
    End If
    
    '# Si nous avons 'C:\MonDossier\'
    '# Rien ne sera trouvé... on ajoute donc un joker
    If i = Len(vsPath) Then
        vsPath = vsPath & "*"
    End If
    
    '# On réinitalise le cache du nom.
    msName = vbNullString

    '# On démarre la recherche
    mhFind = FindFirstFile(StrPtr(vsPath), mtFileInfo)
    If mhFind > 0 Then
        '# La requete a été acceptée. On enregistre les parametres de la recherche
        meRequiredAttributes = veAttributes
        '# Permet de passer sur un fichier valide.
        msName = Me.Name
    Else
        '# Echec. on remet le handle à 0 (vaut -1)
        mhFind = 0
    End If
End Sub


===========================================================

CODE DE Form1

Option Explicit

Private moDir As CDir

Private Sub Drive1_Change()
    Explore Left$(Drive1.Drive, 2)
End Sub

Private Sub Explore(ByVal vsPath As String)
    If Right$(vsPath, 1) <> "\" Then
        vsPath = vsPath & "\"
    End If
    
    If Nothing Is moDir Then
        Set moDir = New CDir
    Else
        moDir.Terminate
    End If
    moDir.Initialize vsPath, [Standard Folder]
    
    ListView1.Tag = vsPath
    ListView1.ListItems.Clear
    ListView1.ListItems.Add.SubItems(1) = "."
    ListView1.ListItems.Add.SubItems(1) = ".."
    On Local Error GoTo Handler
    Do Until moDir.EOF
        With ListView1.ListItems.Add
            .SubItems(1) = moDir.Name
            .SubItems(4) = FormatBytes(moDir.FolderSize)
        End With
        moDir.MoveNext
    Loop
Exit Sub
Handler:
    If Err.Number = 35605 Then
        '# Le contrôle de cet élément a été supprimé
        '# Peut arriver, si on change de drive avat d'avoir terminé... rien de grave, on quitte la sub.
    Else
        Err.Raise Err.Number, Err.Source, Err.Description
    End If
End Sub

Private Function FormatBytes(ByVal num_bytes As Double) As String
Const ONE_KB As Double = 1024
Const ONE_MB As Double = ONE_KB * 1024
Const ONE_GB As Double = ONE_MB * 1024
Const ONE_TB As Double = ONE_GB * 1024
Const ONE_PB As Double = ONE_TB * 1024
Const ONE_EB As Double = ONE_PB * 1024
Const ONE_ZB As Double = ONE_EB * 1024
Const ONE_YB As Double = ONE_ZB * 1024
Dim value As Double
Dim txt As String
    ' See how big the value is.
    If num_bytes <= 999 Then
        FormatBytes = Format$(num_bytes, "0") & " bytes"
    ElseIf num_bytes <= ONE_KB * 999 Then
        FormatBytes = ThreeNonZeroDigits(num_bytes / ONE_KB) & " KB"
    ElseIf num_bytes <= ONE_MB * 999 Then
        FormatBytes = ThreeNonZeroDigits(num_bytes / ONE_MB) & " MB"
    ElseIf num_bytes <= ONE_GB * 999 Then
        FormatBytes = ThreeNonZeroDigits(num_bytes / ONE_GB) & " GB"
    ElseIf num_bytes <= ONE_TB * 999 Then
        FormatBytes = ThreeNonZeroDigits(num_bytes / ONE_TB) & " TB"
    ElseIf num_bytes <= ONE_PB * 999 Then
        FormatBytes = ThreeNonZeroDigits(num_bytes / ONE_PB) & " PB"
    ElseIf num_bytes <= ONE_EB * 999 Then
        FormatBytes = ThreeNonZeroDigits(num_bytes / ONE_EB) & " EB"
    ElseIf num_bytes <= ONE_ZB * 999 Then
        FormatBytes = ThreeNonZeroDigits(num_bytes / ONE_ZB) & " ZB"
    Else
        FormatBytes = ThreeNonZeroDigits(num_bytes / ONE_YB) & " YB"
    End If
End Function

Private Function ThreeNonZeroDigits(ByVal value As Double) As String
    If value >= 100 Then
        ' No digits after the decimal.
        ThreeNonZeroDigits = Format$(CInt(value))
    ElseIf value >= 10 Then
        ' One digit after the decimal.
        ThreeNonZeroDigits = Format$(value, "0.0")
    Else
        ' Two digits after the decimal.
        ThreeNonZeroDigits = Format$(value, "0.00")
    End If
End Function

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    If Not Nothing Is moDir Then
        moDir.Terminate
    End If
End Sub

Private Sub ListView1_DblClick()
Dim nPos As Long
    If Not Nothing Is ListView1.SelectedItem Then
        With ListView1.SelectedItem
            If .SubItems(1) = "." Then
                Explore ListView1.Tag
            ElseIf .SubItems(1) = ".." Then
                nPos = InStrRev(ListView1.Tag, "\", Len(ListView1.Tag) - 1)
                If nPos Then
                    Explore Left$(ListView1.Tag, nPos)
                Else
                    Explore ListView1.Tag
                End If
            Else
                Explore ListView1.Tag & ListView1.SelectedItem.SubItems(1)
            End If
        End With
    End If
End Sub

===============================================================

si tu as des questions, n'hésites pas.