Información de Directorios

Fecha: 21/Ago/97
Autor: Francisco Bonet

From: "Francisco Bonet" <[email protected]>
Subject: Función para calcular tamaño total de un directorio con VB4
Date sent: Thu, 31 Jul 1997 00:14:02 +0200

Hola Guille,

En mis E-mails de 26 y 27 de julio recordarás que te pedía ayuda para
escribir una función que calculara el tamaño total de un directorio,
incluído nº subdirectorios, nº de archivos, etc.
Te comenté que si salía algo bueno te lo mandaría. Aquí lo tienes para, si
lo crees de interés, incluirlo en tus páginas.
Como verás no utilizo OCX ni clases, simplemente una función.
Te mando un Zip con un pequeño programa demostrativo (que si quieres puedes
ofrecerlo) para que pruebes la función.
Parte del programa está en catalán, puesto que un servidor es mallorquín.
Supongo que esto no ofrecerá ninguna dificultad. Si alguien no lo entiende,
gustosamente se lo traduciré.

Saludos,
Francisco Bonet

'//Se debe declarar del API 32:
'//funciones: FindFirstFile, FindNextFile y FindClose
'//types: FILETIME y  WIN32_FIND_DATA
'//constantes: Const MAX_PATH = 64 y Public Const
'//FILE_ATTRIBUTE_DIRECTORY = &H10
'//Asimismo las variables TotSize, NumSubdirs y NumArxius deben ser del
tipo Long '//y declarase como globales
'--------------------------------------------------------------------
Private Function InfoSubdirs(miPath As String) As Long
'Part d'aquest codi ha estat possible gràcies a la
'informació obtinguda de Bjorn Larsen

'Francisco Bonet, juliol de 1977
'-------------------------------------------------


Dim valor1 As Long, valor2 As Long, atribarx As Long
Dim inull As Integer
Dim NomArxiu As String, NomSdir As String, NouPath As String, NouCalcul As
String
Dim InfoTd As WIN32_FIND_DATA
On Error Resume Next
   If Right$(miPath, 1) <> "\" Then miPath = miPath & "\"
   valor1 = 0
   valor2 = 1
   valor1 = FindFirstFile(miPath & "*.*", InfoTd)
   Do
        NomArxiu = RTrim$(InfoTd.cFileName)
        atribarx = InfoTd.dwFileAttributes
            If Left(NomArxiu, 1) <> "." Then
               If atribarx And FILE_ATTRIBUTE_DIRECTORY Then
                    NomSdir = NomSdir & miPath & NomArxiu
                    NumSubdirs = NumSubdirs + 1
               Else
                    NumArxius = NumArxius + 1
                    TotSize = TotSize + InfoTd.nFileSizeLow
               End If
            End If
         InfoTd.cFileName = ""
         valor2 = FindNextFile(valor1, InfoTd)
    Loop Until valor2 = 0
   FindClose (valor1)
'RECURSSIO
   Do Until NomSdir = ""
        inull = InStr(NomSdir, vbNullChar)
        If inull Then
            NouPath = Left$(NomSdir, inull - 1)
        End If
        NomSdir = Right$(NomSdir, Len(NomSdir) - inull%)
        NouCalcul = InfoSubdirs(NouPath)
   Loop
End Function

Si quieres bajar el listado con los ejemplos, pulsa este link. (DirSizeFB.zip 3.41 KB)