Calcular tamaño de directorios

Esta basada en API, por lo cual es súper rápida, tarda unos 2 segundos en leer 22 directorios, 287 archivos con casi 10 Mb de información. Necesitaras incluir las funciones AñadirBarra y LimpiarCadena, las puedes encontrar en la sección FAQ.

Debes crear un módulo donde incluir:

Option Explicit

Const ATTR_DIRECTORY = 16
Const MAX_PATH = 64
Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, _
         lpFindFileData As WIN32_FIND_DATA) As Long
Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFind As Long, _
         lpFindFileData As WIN32_FIND_DATA) As Long
Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long

Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type

Type WIN32_FIND_DATA
    dwFileAttributes As Long
    ftCreationTime As FILETIME
    ftLastAccessTime As FILETIME
    ftLastWriteTime As FILETIME
    nFileSizeHigh As Long
    nFileSizeLow As Long
    dwReserved0 As Long
    dwReserved1 As Long
    cFileName As String * MAX_PATH
    cAlternate As String * 14
End Type

Type Datos_Directorio
    Path As String
    Tamaño As Long
    NumDir As Long
    NumFic As Long
End Type

Function InfoSubdirs(Directorio As Datos_Directorio) As Datos_Directorio
    Dim InfoTd As WIN32_FIND_DATA, Archivo As String, Atributos As Long, INull As Integer
    Dim Valor1 As Long, Valor2 As Long, NomSDir As String, NuevoSDir As String, Temporal As Datos_Directorio

    On Error Resume Next
    InfoSubdirs = Directorio
    InfoSubdirs.Path = AñadirBarra(InfoSubdirs.Path) ' Comprobamos que sea un camino correcto, que termine en "/"
    Valor1 = 0
    Valor2 = 1
    Valor1 = FindFirstFile(InfoSubdirs.Path & "*.*", InfoTd)
    Do
        Archivo = Trim$(InfoTd.cFileName)
        Atributos = InfoTd.dwFileAttributes
        If left(Archivo, 1)  "." Then
            Archivo = Limpiar_Cadena(Archivo, Right$(Archivo, 1))
            If Atributos And ATTR_DIRECTORY Then
                NomSDir = NomSDir & InfoSubdirs.Path & Archivo & vbNullChar
                InfoSubdirs.NumDir = InfoSubdirs.NumDir + 1
            Else
                InfoSubdirs.NumFic = InfoSubdirs.NumFic + 1
                InfoSubdirs.Tamaño = InfoSubdirs.Tamaño + InfoTd.nFileSizeLow
            End If
        End If
        InfoTd.cFileName = ""
        Valor2 = FindNextFile(Valor1, InfoTd)
    Loop Until Valor2 = 0

    FindClose (Valor1)
    'RECURSIVIDAD
    Temporal = InfoSubdirs
    Do Until NomSDir = ""
        INull = InStr(NomSDir, vbNullChar)
        If INull Then
            Temporal.Path = left$(NomSDir, INull - 1)
        End If
        NomSDir = Right$(NomSDir, Len(NomSDir) - INull)
        Temporal = InfoSubdirs(Temporal)
    Loop
    InfoSubdirs = Temporal
End Function

Una vez incluido todo lo anterior, incluye esto en un formulario (Crea 3 Labels, “Label1”, “Label2” y “Label3”) o donde lo necesites:

Private Sub Form_Load()
    Dim Directorio As Datos_Directorio
    Directorio.Path = "c:windows"
    Directorio = InfoSubdirs(Directorio)
    Label1.Caption = "Directorios: " & Directorio.NumDir
    Label2.Caption = "Ficheros: " & Directorio.NumFic
    Label3.Caption = "Tamaño: " & Directorio.Tamaño
End Sub

Descarga Código VB. 5.0

Anuncios

Responder

Introduce tus datos o haz clic en un icono para iniciar sesión:

Logo de WordPress.com

Estás comentando usando tu cuenta de WordPress.com. Cerrar sesión /  Cambiar )

Google photo

Estás comentando usando tu cuenta de Google. Cerrar sesión /  Cambiar )

Imagen de Twitter

Estás comentando usando tu cuenta de Twitter. Cerrar sesión /  Cambiar )

Foto de Facebook

Estás comentando usando tu cuenta de Facebook. Cerrar sesión /  Cambiar )

Conectando a %s