Dice el refrán que el movimiento se demuestra andando, nosotros no vamos a andar, estamos demasiado acostumbrados a estar sentados como para demostrar el movimiento.
Aunque si que podemos mover (o encaminar) nuestras aplicaciones al mundo de los objetos. Al menos voy a intentar que este movimiento sea más comprensible para todos aquellos que quieran "objetivizar" un poco más de lo que hasta ahora hacían.
Y como decía al principio, lo mejor es verlo con ejemplos prácticos, al menos todo lo práctico que se puede mostrar en un artículo de unas cuantas páginas.En esta ocasión vamos a tratar con las colecciones y las colecciones de colecciones, también veremos cómo avisar al programa que use nuestros objetos de que ha ocurrido algo, esto lo conseguiremos mediante los eventos.
Para ver todo esto, vamos a crear una pequeña utilidad que nos permita examinar el contenido de una unidad de disco, por un lado se guardarán los directorios con sus respectivos ficheros y por otro todos los ficheros con nombres diferentes, para, entre otras cosas, saber en cuantos directorios existe un fichero en concreto. Como la cantidad de ficheros puede ser elevada, a la hora de "examinar" la unidad, se hará en un sólo nivel de directorios (realmente dos, el de inicio y cada uno de los que cuelgan de este) o bien recorriendo todos y cada uno de los directorios de la unidad examinada.
Toda esta información se guardará en unas colecciones mantenidas por una clase y se mostrarán en dos ComboBox, uno para los nombres de los ficheros y otro para los nombres de los directorios. Al seleccionar un fichero, se mostrarán todos los directorios en los que se encuentra y lo mismo ocurrirá cuando se seleccione un directorio: se mostrarán todos los ficheros que contiene.
Como quiera que las colecciones de VB no están lo suficientemente "optimizadas" para almacenar muchos datos, este tipo de utilidad son un poco "desesperantes", sobre todo a la hora de eliminar de la memoria todos los objetos creados. En mi caso, al examinar toda la unidad me he encontrado con 29263 ficheros repartidos en 1789 directorios con un total de 22258 ficheros diferentes, el VB ha tardado casi 7 minutos en liberar la memoria ocupada... pero como es para comprobar un par de cosillas prácticas, ha valido la pena. Si en lugar de usar colecciones se hubiese usado arrays la cosa hubiese mejorado, pero el tiempo empleado para procesar la información hubiese sido tres o cuatro veces superior.
Los componentes de la aplicación
Para realizar esta tarea vamos a usar una clase básica en la que se almacenará un nombre, que será, según el contexto en el que se use, el fichero o el directorio.
También tendremos una colección en la que almacenaremos todos los ficheros de un directorio en concreto.
Por último, otra clase mantendrá a su vez una colección de estos directorios y de todos los ficheros, con nombres diferentes, que se encuentren en esa unidad. Esta clase también será la que se encargue de explorar la unidad y tendrá unos métodos que nos permitirán mostrar los ficheros de un directorio y todos los directorios en los que se encuentra un fichero en concreto. Además nos avisará, por medio de eventos cuando se encuentre un nuevo directorio o un nuevo fichero.Para usar la clase, al usar eventos, tendremos que crearla de esta forma:
Dim WithEvents tDrive As cDriveDe esta forma, se creará una entrada en la lista de objetos del form en los que se podrá seleccionar cualquiera de los eventos, para hacer algo en particular. En nuestro caso, se producirá un evento cada vez que se encuentre un nuevo directorio y también cuando se encuentre un nuevo nombre de fichero (sin repetirse), cuando uno de estos eventos se produzca, añadiremos a los combos el nombre del directorio o fichero hallado.
Vamos a ver el código usado en estos eventos:Private Sub tDrive_NewDir(ByVal sDir As String) Label1(4) = tDrive.Dirs.Count & " folders" Combo2.AddItem sDir End Sub Private Sub tDrive_NewFile(ByVal sFile As String) Combo1.AddItem sFile Label1(2) = tDrive.Files.Count & " files" End SubPara que el proceso empiece simplemente llamaremos al método que se encarga de explorar la unidad y que será el encargado de llenar las colecciones, esto se hace simplemente así:
tDrive.FillDirs Text1, vbHidden + vbReadOnly + vbSystem + vbArchive, chkLevelsSi sólo queremos evaluar un nivel y sólo los ficheros normales, podríamos usar los valores por defecto:
tDrive.FillDirs Text1Este método simplemente procesará cada uno de los directorios y cada vez que encuentre un nuevo fichero, llamará al método Add de esta clase que se encargará de incluir en las colecciones correspondientes los valores que ha recibido, éste método es bastante simple y este es el código empleado:
Public Sub Add(ByVal sDir As String, ByVal sFile As String) Dirs(sDir)(sFile).Name = sFile 'Añadir a la colección de ficheros Call Files(sFile) End SubComo podrás adivinar, el trabajo "duro" está en lo que se haga al emplear Dirs o Files, pero esa parte vamos a dejarla para dentro de un poco, antes vamos a ver cada una de las piezas de este puzzle.
Veamos también cómo llamar a los métodos creados para mostrar los directorios en los que se encuentra un fichero en concreto y para mostrar todos los ficheros de un directorio.
En el form de ejemplo se hace al seleccionar un elemento del combo destinado para ello.
Por ejemplo cuando seleccionamos un fichero del Combo1:'Mostrar los directorios del fichero seleccionado sFile = Combo1.List(Combo1.ListIndex) 'Add the folders of this file to List1 tDrive.ShowFiles sFile, List1Igualmente al seleccionar en el combo2, se mostrarán todos los ficheros de ese directorio
'Mostrar los directorios del fichero seleccionado sDir = Combo2.List(Combo2.ListIndex) ' tDrive.ShowDirs sDir, List1Ahora veamos el código de cada una de las clases.
La clase básica: cFile
Esta es la clase empleada para almacenar un nombre y se usará como el elemento de la colección de ficheros y/o directorios.
Sólo tiene una propiedad: Nombre y ningún método.
Vamos a ver el código:'------------------------------------------------------------------ 'cFile.cls (22/May/98) 'Clase básica para almacenar un nombre ' '©Guillermo 'guille' Som, 1998 '------------------------------------------------------------------ Option Explicit Private m_Name As String Public Property Get Name() As String Name = m_Name End Property Public Property Let Name(ByVal NewName As String) Static BeenHere As Boolean If Not BeenHere Then BeenHere = True m_Name = NewName End If End Property
La clase/colección para almacenar objetos del tipo cFile: cFiles
Esta es una colección que contendrá objetos del tipo cFile, esta sería la forma de usar una colección personalizada, aunque he omitido el uso de los métodos habituales como Add, Count y Remove, no sería una tarea demasiado complicada, ya que simplemente tendríamos que delegar en la colección privada, después mostraré cómo se tendrían que implementar estos métodos, pero que en el ejemplo no he usado, ya que no serán necesarios.
Esta clase/colección tiene una propiedad: Path que será el nombre del directorio de los ficheros que contiene, es decir en esta clase se guardarán todos los ficheros de un directorio específico.
El método/propiedad que se encarga de almacenar los distintos ficheros será Item, que será la propiedad por defecto.Para hacer que una propiedad sea la que se use por defecto, hay que seleccionar esa propiedad y en el menú Herramientas, seleccionar la opción Atributos del procedimiento. Nos mostrará un cuadro de diálogo en el cual habrá que pulsar en el botón Avanzados y en la lista Id. del procedimiento, seleccionar Predeterminado.
Otro método que tendrá esta colección, como toda buena colección, es un método NewEnum, el cual nos permitirá recorrer el contenido de la colección usando For Each ... Next. Para ello este método debe estar oculto y el Id. del procedimiento tener un valor -4 (menos cuatro)
Estas indicaciones se hacen también desde el menú Herramientas/Atributos del procedimiento/Avanzados...
Veamos el código empleado:
'------------------------------------------------------------------ 'cFiles.cls (22/May/98) 'Clase colección para almacenar objetos del tipo cFile ' '©Guillermo 'guille' Som, 1998 '------------------------------------------------------------------ Option Explicit Private colFiles As Collection Private m_Path As String Public Function Item(ByVal NewFile As Variant) As cFile Dim tFile As New cFile On Local Error Resume Next Set Item = colFiles.Item(NewFile) If Err Then tFile.Name = NewFile colFiles.Add tFile, NewFile Set Item = tFile End If Err = 0 End Function Public Property Get Path() As String Path = m_Path End Property Public Property Let Path(ByVal NewPath As String) Static BeenHere As Boolean If Not BeenHere Then BeenHere = True m_Path = NewPath End If End Property Public Function NewEnum() As IUnknown 'Debe ser un miembro oculto y 'el id del procedimiento debe ser -4 ' Set NewEnum = colFiles.[_NewEnum] End Function Private Sub Class_Initialize() Set colFiles = New Collection End Sub Private Sub Class_Terminate() Set colFiles = Nothing End SubEn el método Item, se usa la detección de errores para comprobar si el item indicado existe en la colección, en caso de que exista, se devolverá ese item, pero si no existe, se producirá un error al intentar obtenerlo de la colección, error que aprovechamos para saber que no existe y añadirlo a la colección.
Cada vez que una clase se crea, se produce el evento Class_Initialize y ahí será un buen sitio para hacer las asignaciones por defecto que necesitemos, en este caso, sólo se crea la colección que contendrá los ficheros.
Igualmente cuando el objeto se destruye, se produce Class_Terminate y en ese sitio es dónde destruimos la colección.Y como lo prometido es deuda, vamos a ver cómo se implementarían los métodos Add, Remove y Count que toda clase debería tener, (repito que en este caso no son necesarios); también te muestro como suelo implementar un método Clear, hay que notar en este caso que es necesario "recrear" de nuevo la colección para poder seguir usándola, es decir, no serviría con asignarle simplemente Nothing, ya que entonces no tendríamos una colección a la que añadir nuestros objetos.
Public Function Count() As Long 'Número de elementos en la colección Count = colFiles.Count End Function Public Sub Remove(ByVal sFile As String) On Local Error Resume Next colFiles.Remove sFile Err = 0 End Sub Public Sub Add(ByVal Item As Variant, Optional ByVal Key As Variant, _ Optional ByVal Before As Variant, Optional ByVal After As Variant) 'El parámeto Key es por compatibilidad del método Add 'de las colecciones normales, pero siempre se asigna el nombre Dim sKey As String On Local Error Resume Next If Not (TypeOf Item Is cFile) Then 'Error sólo se pueden añadir del tipo cFile Else sKey = Item.Name colFiles.Add Item, sKey, Before, After End If Err = 0 End Sub Public Sub Clear() 'Borrar el contenido de la colección Set colFiles = Nothing Set colFiles = New Collection End Sub
Ahora sólo nos queda ver el código de la clase cDrive.
La clase cDrive
Esta es la clase que maneja cada uno de los datos y la que se encargará de proveer de Eventos y métodos para mostrar los ficheros y directorios contenidos en las colecciones.
Vamos a ver el código completo y después entraremos en los pequeños detalles que sean necesarios.'------------------------------------------------------------------ 'cDrive (22/May/98) 'Clase para mantener colecciones de ficheros y directorios ' '©Guillermo 'guille' Som, 1998 '------------------------------------------------------------------ Option Explicit Option Compare Text Public Cancel As Boolean Private colFiles As Collection Private colDirs As Collection 'Este evento se producirá cada vez que se añada un nuevo fichero Public Event NewFile(ByVal sFile As String) 'Este evento se producirá cada vez que se añada un nuevo directorio Public Event NewDir(ByVal sDir As String) Public Sub Add(ByVal sDir As String, ByVal sFile As String) Dirs(sDir)(sFile).Name = sFile 'Añadir a la colección de ficheros Call Files(sFile) End Sub Public Function Files(Optional ByVal Index As Variant) As Variant 'Este método devolverá una colección de los ficheros 'o el item indicado ' 'Si no existe, se añade ' On Local Error Resume Next If IsMissing(Index) Then Set Files = colFiles Else Files = colFiles.Item(Index) If Err Then colFiles.Add Index, Index Files = Index RaiseEvent NewFile(Index) End If End If Err = 0 End Function Public Function Dirs(Optional ByVal Index As Variant) As Variant 'Si no se indica el índice, se devuelve la colección ' 'En otro caso se devuelve ese directorio, 'si no existe, se añade ' Dim tFiles As New cFiles On Local Error Resume Next If IsMissing(Index) Then 'Devolver la colección Set Dirs = colDirs Else Set Dirs = colDirs.Item(Index) If Err Then tFiles.Path = Index colDirs.Add tFiles, Index Set Dirs = tFiles RaiseEvent NewDir(Index) End If End If Err = 0 End Function Public Sub ShowDirs(ByVal sDir As String, aList As Control) 'Muestra todos los ficheros del directorio indicado Dim tFile As cFile On Local Error GoTo ExitShowDirs Screen.MousePointer = vbArrowHourglass aList.Clear ' For Each tFile In colDirs(sDir) aList.AddItem tFile.Name Next ExitShowDirs: Screen.MousePointer = vbDefault Err = 0 End Sub Public Sub ShowFiles(ByVal sFile As String, aList As Control) 'Muestra los directorios en los que está el fichero indicado Dim tFiles As cFiles Dim tFile As cFile On Local Error GoTo ExitShowFiles Screen.MousePointer = vbArrowHourglass aList.Clear For Each tFiles In colDirs For Each tFile In tFiles If tFile.Name = sFile Then aList.AddItem tFiles.Path Exit For End If Next Next ExitShowFiles: Screen.MousePointer = vbDefault Err = 0 End Sub Private Sub Class_Initialize() Set colFiles = New Collection Set colDirs = New Collection End Sub Private Sub Class_Terminate() Set colFiles = Nothing Set colDirs = Nothing End Sub Public Sub FillDirs(ByVal NewDrive As String, Optional ByVal Atributos As Long = vbNormal, _ Optional ByVal AllLevels As Boolean = False) Dim sDir As String Dim sFile As String Dim i As Long Dim Dirs As New Collection Static FirstDir As String DoEvents If Cancel Then Exit Sub End If sDir = NewDrive If Right$(sDir, 1) <> "\" Then sDir = sDir & "\" End If If Len(FirstDir) = 0 Then FirstDir = sDir End If Dirs.Add sDir sFile = Dir$(sDir & "*.*", vbDirectory) Do While Len(sFile) If (GetAttr(sDir & sFile) And vbDirectory) = vbDirectory Then If sFile <> "." And sFile <> ".." Then Dirs.Add sFile End If End If sFile = Dir$ Loop For i = 1 To Dirs.Count sFile = "" sDir = Dirs(i) If Right$(sDir, 1) <> "\" Then sDir = sDir & "\" End If If i = 1 Then If FirstDir = sDir Then sFile = Dir$(sDir & "*.*", Atributos) End If Else If AllLevels Then FillDirs NewDrive & sDir, Atributos, AllLevels End If sFile = Dir$(NewDrive & sDir & "*.*", Atributos) sDir = NewDrive & sDir End If Do While Len(sFile) Me.Add sDir, sFile DoEvents If Cancel Then Exit For End If sFile = Dir$ Loop Next End SubLos métodos/Propiedades Dirs y Files usan un parámetro opcional para saber si se quiere acceder a un elemento o a la colección correspondiente, esa es la razón de que el tipo devuelto sea Variant, ya que lo mismo puede ser una colección de objetos cFiles como un objeto del tipo cFiles.
En estas propiedades/métodos se producen los eventos cuando se asigna un nuevo elemento a cualquiera de las colecciones, para ello se usa RaiseEvent con el evento adecuado según el tipo de dato asignado: un directorio o un nuevo fichero.
Fíjate que en la colección de ficheros sólo se almacena una cadena, no un objeto en particular.La propiedad Cancel se usa para poder cancelar el proceso de exploración de la unidad.
Para indicarle a la clase que queremos cancelar, simplemente se haría lo siguiente:
tDrive.Cancel = TrueAunque esta forma de uso tiene sus inconvenientes, es la forma más simple de "manipular" los elementos de una colección, al menos desde el enfoque que se le ha dado de sencillez a la hora de asignar nuevos elementos.
Pero podríamos caer en el error de hacer una asignación de este tipo:
tDrive.Dirs.Add "basura"
Y se asignaría una cadena en lugar de un objeto del tipo cFiles, en caso de que "recorrieramos" el contenido de la colección Dirs con esto:
For Each tFiles In tDrive.Dirs :Debug.Print tFiles.Path :Next
Nos encontaríamos con un error al llegar al elemento "basura", ya que no es del tipo cFiles.Esto se solucionaría si creasemos una clase/colección intermedia para almacenar los elementos del tipo cFiles, esa clase tendría un método Add (si lo creemos conveniente) que se debería preocupar del tipo de dato asignado, como vimos en el código "extra" para la clase cFiles, sólo que en esta ocasión el tipo de dato a asignar sería cFiles.
Lo mismo haríamos con el método/propiedad Files, pero en esta ocasión no necesitaríamos ninguna clase intermedia, ya que tenemos una clase que puede almacenar una serie de nombres: cFiles.
Si nos decidieramos a efectuar estos cambios, la clase cDrive quedaría así:
(el código mostrado es el que habría que modificar, el resto seguiría igual)' Option Explicit Option Compare Text Public Cancel As Boolean Private colFiles As cFiles Private colDirs As cDirs 'Este evento se producirá cada vez que se añada un nuevo fichero Public Event NewFile(ByVal sFile As String) 'Este evento se producirá cada vez que se añada un nuevo directorio Public Event NewDir(ByVal sDir As String) Public Sub Add(ByVal sDir As String, ByVal sFile As String) Dirs(sDir)(sFile).Name = sFile 'Añadir a la colección de ficheros Files(sFile).Name = sFile End Sub Public Property Get Dirs() As cDirs Set Dirs = colDirs End Property Public Property Get Files() As cFiles Set Files = colFiles End Property Private Sub Class_Initialize() Set colFiles = New cFiles Set colDirs = New cDirs End SubEn el métod Add sólo se ha hecho una pequeña modificación, porque ahora no tratamos directamente con cadenas, sino con objetos del tipo cFile.
Por supuesto el inicio de la clase ahora debe "crear" otro tipo de objetos, que no son colecciones.Las propiedades Dirs y Files se han simplificado al máximo... más simples: ¡imposible!
Pero...
¿Cuando se producen los eventos?Realmente en la clase cDrive no podemos saber cuando se asigna un nuevo elemento a la colección de directorios o de ficheros, ya que de ese proceso se encarga el método Item de cada una de las colecciones empleadas.
Aunque podemos hacer que esas clases "notifiquen" a la clase cDrive cuando se añada un nuevo elemento a la colección.Veamos los cambios que habría que realizar en la clase cFiles:
Option Explicit 'Usaremos un evento para notificar que se ha añadido un nuevo fichero Public Event NewItem(ByVal sFile As String) Private colFiles As Collection Private m_Path As String Public Function Item(ByVal NewFile As Variant) As cFile Dim tFile As New cFile On Local Error Resume Next Set Item = colFiles.Item(NewFile) If Err Then tFile.Name = NewFile colFiles.Add tFile, NewFile 'Notificamos de que se añade un nuevo elemento RaiseEvent NewItem(NewFile) Set Item = tFile End If Err = 0 End Function Public Function Count() As Long 'Número de elementos en la colección Count = colFiles.Count End FunctionBien, ahora sólo tendremos que cambiar la declaración que tenemos en cDrive para acceder a esta colección, por esta otra:
Private WithEvents colFiles As cFilesY como hemos visto, tendremos un nuevo "objeto" colFiles con un evento NewItem, el cual usaremos para lanzar el evento que indique que se ha añadido un nuevo fichero:
Private Sub colFiles_NewItem(ByVal sFile As String) RaiseEvent NewFile(sFile) End SubEn el caso de la "nueva" clase cDirs haremos lo mismo, por tanto en la clase cDrive cambiaremos la declaración de la variable colDirs por esta otra:
Private WithEvents colDirs As cDirsY añadiremos este código al evento NewItem de ese objeto:
Private Sub colDirs_NewItem(ByVal sDir As String) RaiseEvent NewDir(sDir) End SubPor último veamos la nueva clase cDirs al completo, (he dejado algunos métodos comentados por si se quieren implementar)
'------------------------------------------------------------------ 'cDirs colección de objetos del tipo cFiles (25/May/98) ' '©Guillermo 'guille' Som, 1998 '------------------------------------------------------------------ Option Explicit Public Event NewItem(ByVal sDir As String) Private m_col As Collection 'Public Sub Clear() ' 'Borrar el contenido de la colección ' Set m_col = Nothing ' Set m_col = New Collection 'End Sub Public Function NewEnum() As IUnknown 'Debe ser un miembro oculto y 'el id del procedimiento debe ser -4 ' Set NewEnum = m_col.[_NewEnum] End Function 'Public Sub Remove(ByVal Index As Variant) ' 'Método Remove de una colección ' ' On Local Error Resume Next ' ' m_col.Remove Index ' ' Err = 0 'End Sub Public Function Item(ByVal NewFile As Variant) As cFiles Dim tFiles As New cFiles On Local Error Resume Next Set Item = m_col.Item(NewFile) If Err Then tFiles.Path = NewFile m_col.Add tFiles, NewFile RaiseEvent NewItem(NewFile) Set Item = tFiles End If Err = 0 End Function Public Function Count() As Long 'Método Count de las colección Count = m_col.Count End Function 'Public Sub Add(ByVal Item As Variant, Optional ByVal Key As Variant, _ ' Optional ByVal Before As Variant, Optional ByVal After As Variant) ' 'Añadir un nuevo elemento a la colección ' ' On Local Error Resume Next ' ' If TypeOf Item Is cFiles Then ' m_col.Add Item, Item.Path, Before, After ' Else ' 'Error, no se añade a la colección ' End If ' ' Err = 0 'End Sub Private Sub Class_Initialize() Set m_col = New Collection End Sub Private Sub Class_Terminate() Set m_col = Nothing End SubRealmente esta última clase la tengo como "plantilla" para crear nuevas clases/colecciones, sólo necesito cambiar el tipo de objeto que se añade a la colección y de esta forma me sirve de forma genérica.
Si quieres ver el listado completo, incluido un formulario para comprobar todo lo dicho, pulsa este link.
Y si quieres dejarme algún mensaje, hazlo pulsando aquí, pero, por favor, nada de consultas, lamentándolo mucho no puedo dar más de lo que doy aquí, al menos en inglés, pero si te apetece ver código "explicado" en español, te invito a pasar por mis páginas. Y como le decía mi amigo Joe a un caballero que se quejaba de que mis páginas están en español: The code is the code.
Gracias.
Nos vemos.
Guillermo
Mis páginas: http://www.elguille.info/
El primer artículo publicado en VB Online USA