Con la utilidad SelDir, podrás seleccionar (visualmente) un directorio de entre los mostrados por los controles estándards Drive y Dir, además de los que escribas en el TextBox, en el cual puedes incluir cualquier ruta a un equipo que esté conectado a la red en la que estés trabajando, el formato en este caso sería: \\Equipo\Unidad\Directorio
Esta utilidad es una revisión de
la ya presentada en la librería OLE y la utilidad de Buscar y
Reemplazar,
(seguramente habrás llegado aquí desde el apartado de
las clases en
Visual Basic)
En los ejemplos y listados aquí presentados se muestran las
clases, módulos y forms que componen la utilidad, así como un
ejemplo para poder probarla.
Si la usas en modo normal, es
decir que no es una librería OLE, debes agregar estos archivos a
tu proyecto:
SelectDir.Frm, cNombre.Cls, cNombresA.Cls, cSelectDir.Cls
Deberías quitarles los atributos de Pública y Multi-Creatable
de las clases, ya que así no serán objetos del proyecto.
En caso de que quieras crear una
librería OLE (un archivo DLL), esas propiedades deben ser
Públicas y Cratable Multiuse.
El proyecto que use esta librería sólo debe tener una
referencia a la DLL generada.
Ahora vamos a ver los tres casos:
- Crear la librería OLE y los listados de la utilidad SelDir
- Usar la librería creada (el ejemplo con OLE)
- Usarlo dentro de un proyecto normal (el ejemplo sin OLE)
1.- Crear la librería OLE y los listados de la utilidad SelDir
Para crear una librería OLE con esta utilidad, deberás cargar el proyecto OLE_SelDir.vbp
Recuerda de asignar a las tres
clases usadas las propiedades:
Instancing: 2-Creatable Multiuse
Public: True
De esta forma podrás usar los objetos expuestos. Que en este caso son:
| Clase/Objeto | Descripción | ||||||||
| cNombre |
La
clase básica de los elementos de la colección devuelta. Las propiedades expuestas son: .
|
||||||||
| cNombres |
Colección
de objetos cNombre. Las propiedades y métodos expuestos son: .
|
||||||||
| SelDir |
Permite
seleccionar el directorio y opcionalmente los archivos de
la extensión indicada. Las propiedades y métodos expuestos son: .
|
Ahora vamos a ver las clases que forman esta utilidad. (Una foto del form de selección, al final de esta página)
cNombre: La básica y más simple.
'--------------------------------------------------
'cNombre (15/Feb/97)
'
'©Guillermo Som Cerezo, 1997
'--------------------------------------------------
Option Explicit
'
Private sID As String
'
Public Nombre As String
Public Property Get ID() As String
ID = sID
End Property
Public Property Let ID(sNewValue As String)
Static bYaEstoy As Boolean
If Not bYaEstoy Then
bYaEstoy = True
sID = sNewValue
End If
End Property
cNombres: La colección de objetos cNombre.
'--------------------------------------------------
'cNombres (15/Feb/97)
'Esta es una colección de objetos cNombre
'
'©Guillermo Som Cerezo, 1997
'--------------------------------------------------
Option Explicit
Private colNombres As New Collection
Private sID As String
Public Property Get ID() As String
ID = sID
End Property
Public Property Let ID(sNewValue As String)
Static bYaEstoy As Boolean
If Not bYaEstoy Then
bYaEstoy = True
sID = sNewValue
End If
End Property
Public Function Nombres(Optional Index As Variant) As Variant
'El acceso a esta función permitirá usar
'los datos de la clase cNombre
'Si se especifica el Index, se devuelve ese item
'sino se devuelve la colección
'
Static tNombre As New cNombre
On Local Error Resume Next
'Si no se indica el index, se devuelve la colección
If IsMissing(Index) Then
Set Nombres = colNombres
Else
'Comprobar si está en la colección
Set Nombres = colNombres.Item(Index)
'Si produce error, es que no existe
If Err Then
Err = 0
Set tNombre = Nothing
tNombre.ID = Index
'Añadirlo
colNombres.Add tNombre, tNombre.ID
'Devolver el item creado
Set Nombres = tNombre
End If
End If
'Liberar memoria
Set tNombre = Nothing
End Function
Public Sub Nuevo(sNombre As String)
'Añade una nueva entrada a la colección (16/Feb/97)
Static NumEntradas As Integer
Dim sID As String
NumEntradas = NumEntradas + 1
sID = "nn" & Format(NumEntradas, "0000")
Me.Nombres(sID).Nombre = sNombre
End Sub
SelDir: La madre del cordero. Esta es la encarga de todo los procesos.
'------------------------------------------------------
'cSelectDir.cls (11/Mar/97)
'Clase para Seleccionar los directorios y/o archivos
'
'Los métodos expuestos por esta clase son:
' Seleccionar Permite seleccionar los directorios y devuelve el directorio seleccionador
' Directorios Devuelve una colección de directorios o archivos y todos los que estén por debajo del directorio especificado
' Directorio Devuelve una colección de los archivos del directorio indicado.
' Cancelar Asigna o Devuelve el estado de cancelación del proceso
'
'(c) Guillermo Som, 1997
'------------------------------------------------------
Option Explicit
Option Compare Text
Private pCancelar As Boolean
Public Sub Directorio(colDir As cNombres, sDir As String, sExt As String)
'Este método devolverá una colección del tipo Nombres
'con el contenido de los archivos del directorio indicado
'en la clase colDir
SelectDir.Dir1.Path = sDir
SelectDir.Archivos colDir, sExt
pCancelar = SelectDir.Cancelado
End Sub
Public Sub Directorios(colDir As cNombres, sDir As String, Optional vExt)
'Este método devolverá una colección del tipo Nombres
'con el contenido de los directorios y
'(opcionalmente) los archivos de la extensión especificada
'en la clase colDir
'
Dim sExt As String
If Not IsMissing(vExt) Then
sExt = CStr(vExt)
End If
SelectDir.Dir1.Path = sDir
If SelectDir.RecorrerDir(sDir, "", colDir, sExt) Then
colDir.Nuevo sDir
End If
pCancelar = SelectDir.Cancelado
End Sub
Public Function Seleccionar(Optional vDirInicial, Optional vExt) As String
'Esta función mostrará la ventana de diálogo
'y permitirá que se seleccione un directorio
'Devolverá el path completo o "" si se pulsa cancelar
'
Dim sDirInicial As String
Dim sExt As String
If Not IsMissing(vDirInicial) Then 'Empezar por el directorio introducido
sDirInicial = CStr(vDirInicial)
Else 'o el directorio actual
sDirInicial = CurDir
End If
If Not IsMissing(vExt) Then 'Si se especifica la extensión...
sExt = Trim$(CStr(vExt)) 'asignarla
End If
'Seleccionar el directorio en el que se empezará la Búsqueda
With SelectDir
.Directorio = Trim$(sDirInicial)
.Show vbModal
If .Cancelado Then
sDirInicial = ""
Else
sDirInicial = .Directorio
End If
End With
pCancelar = SelectDir.Cancelado
Unload SelectDir
Seleccionar = sDirInicial
End Function
Public Property Get Cancelar() As Boolean
'Devuelve la propiedad cancelar
Cancelar = pCancelar
End Property
Public Property Let Cancelar(New_Cancelar As Boolean)
'Asigna la propiedad cancelar
SelectDir.Cancelado = New_Cancelar
pCancelar = New_Cancelar
End Property
SelectDir.frm: La parte visible de toda esta utilidad y el primo hermano de la madre del cordero...
'------------------------------------------------------
'Formulario para seleccionar directorios (10/Mar/97)
'
'(c)Guillermo Som, 1997
'
'Revisiones:
' 8/Abr/97: Permite cancelar y seleccionar unidades de red tipo \\Equipo\Unidad
'------------------------------------------------------
Option Explicit
'tamaño inicial de la pantalla
Dim iH As Integer
Dim iW As Integer
'Para saber si está en el TextBox
Dim EnText As Boolean
'Se usará para informar si hemos cancelado
Public Cancelado As Boolean
'uso interno: el directorio seleccionado o el de inicio
Private pDirectorio As String
Public Function RecorrerDir(ByVal NewPath As String, PathAnt As String, col As Variant, sExt As String) As Boolean
'Función recursiva para recorrer los directorios
'basada en un ejemplo de Visual Basic para MS-DOS
'y adaptado para almacenar el resultado en una colección
'
Dim NumDirs As Integer
Dim OldPath As String
Dim sFic As String
Dim ThePath As String
Dim res As Boolean
Dim i As Integer
Dim sID As String
On Local Error GoTo RutinaError
NumDirs = Dir1.ListCount
Do While NumDirs > 0
DoEvents
If Cancelado Then
RecorrerDir = True
Exit Function
End If
OldPath = NewPath
If Dir1.ListCount > 0 Then
Dir1.Path = Dir1.List(NumDirs - 1)
'para crear la entrada de este directorio
sID = Dir1.Path
res = RecorrerDir((Dir1.Path), OldPath, col, sExt)
End If
If res Then
RecorrerDir = True
Exit Function
End If
NumDirs = NumDirs - 1
Loop
If Len(NewPath) <= 3 Then
ThePath = NewPath
Else
ThePath = NewPath & "\"
End If
'Añadir a la colección
If Len(sExt) Then 'si se especifica la extensión,
Archivos col, sExt 'añadir los archivos a la colección
Else
col.Nuevo ThePath 'Sólo añadir el directorio
End If
If Len(PathAnt) Then
Dir1.Path = PathAnt
End If
RecorrerDir = False
Exit Function
RutinaError:
If Err = 7 Then
MsgBox "No hay suficiente memoria para completar la tarea", vbCritical, "RecorrerDir"
Else
MsgBox "ERROR: " & CStr(Err) & ", " & Error$, vbCritical, "RecorrerDir"
End If
RecorrerDir = True
End Function
Private Sub cmdAceptar_Click()
Cancelado = False
pDirectorio = Dir1.Path
Hide
End Sub
Private Sub cmdCancelar_Click()
Cancelado = True
Hide
End Sub
Private Sub Dir1_Change()
pDirectorio = Dir1.Path
File1.Path = Dir1.Path
Drive1.Drive = Dir1.Path
If Not EnText Then
Text1 = Dir1.Path
End If
End Sub
Private Sub Drive1_Change()
Static YaEstoy As Boolean
If YaEstoy Then Exit Sub
YaEstoy = True
Dir1.Path = Drive1.Drive ' Establece la ruta del directorio.
YaEstoy = False
End Sub
Private Sub Form_Load()
Cancelado = False
Text1 = Dir1.Path
'Tamaños mínimos
iH = Height / 1.8
iW = Width
End Sub
Public Property Get Directorio() As String
Directorio = pDirectorio
End Property
Public Property Let Directorio(sDir As String)
On Local Error Resume Next
Dir1.Path = sDir
On Local Error GoTo 0
pDirectorio = Dir1.Path
End Property
Private Sub Form_Resize()
If WindowState = vbMinimized Then Exit Sub
'Tamaño mínimo de la ventana
If Width < iW Then
Width = iW
Exit Sub
End If
If Height < iH Then
Height = iH
Exit Sub
End If
Text1.Width = ScaleWidth - 1170
With Dir1
.Width = ScaleWidth - 210
.Height = ScaleHeight - 1035
End With
With CmdCancelar
.Top = ScaleHeight - 465
.Left = ScaleWidth - 1365
Drive1.Top = .Top
CmdAceptar.Top = .Top
CmdAceptar.Left = .Left - 1350
End With
End Sub
Private Sub Form_Unload(Cancel As Integer)
Set SelectDir = Nothing
End Sub
Public Sub Archivos(col As Variant, sExt As String)
Dim i As Integer
Dim sFic As String
Dim sPath As String
File1.Pattern = "*" & sExt 'asignar la extensión que queremos mostrar
sPath = File1.Path
If Right$(sPath, 1) <> "\" Then
sPath = sPath & "\"
End If
If File1.ListCount Then
For i = 0 To File1.ListCount - 1
DoEvents
If Cancelado Then Exit For
sFic = sPath & File1.List(i)
'Añadir a la colección
col.Nuevo sFic
Next
End If
End Sub
Private Sub Text1_GotFocus()
EnText = True
End Sub
Private Sub Text1_KeyPress(KeyAscii As Integer)
Dim drvTmp As Variant
If KeyAscii = 13 Then
On Local Error Resume Next
drvTmp = Dir1.Path
Dir1.Path = Text1
If Err Then
Err = 0
Dir1.Path = drvTmp
End If
On Local Error GoTo 0
KeyAscii = 0
End If
End Sub
Private Sub Text1_LostFocus()
EnText = False
End Sub
2.- Usar la librería creada (el ejemplo con OLE)
Para usar el form de ejemplo con
la librería creada, deberás cargar el proyecto:
testOLE_SelDir.vbp
En Tools/References... seleccionar la referencia a: SelDir
-Librería para Seleccionar Directorios
Y en el proyecto hay asignada una constante esOLE = -1, para usar
la parte correspondiente a las declaraciones con la librería
OLE, fijate que el form de ejemplo es el mismo para los dos
casos.
Aquí lo que te voy a mostrar es,
por un lado el form de prueba y por otro los listados de dicho
form.
El ejemplo te mostrará todos los archivos de la extensión
especificada en un list box, creo que es bastante evidente la
forma de procesar esos archivos... averigualo ejecutando el form
de ejemplo!!!
La foto del form de prueba: (al final de la página, para que no entorpezca la lectura)
El listado de este form:
'----------------------------------------------
'Prueba para SelectDir (11/Mar/97)
'
'(c)Guillermo Som, 1997
'----------------------------------------------
Option Explicit
Option Compare Text
Const cExtension = 0
Const cDirIni = 1
Dim Cancelar As Integer
Private Sub cmdAceptar_Click()
'Empieza la acción
Dim sRuta As String
Dim i As Integer
'las clases usadas...
#If esOLE Then
'Si usamos la librería OLE
Dim tNombre As New oSelDir.cNombre
Dim cSelDir As New oSelDir.SelDir
Dim colDir As New oSelDir.cNombres
#Else
'Si usamos las clases cargadas
Dim tNombre As New cNombre
Dim cSelDir As New SelDir
Dim colDir As New cNombres
#End If
On Local Error Resume Next
If CmdAceptar.Caption = "Cancelar" Then
Cancelar = True
cSelDir.Cancelar = True
GoTo Salir
End If
Cancelar = False
cSelDir.Cancelar = False
sRuta = Trim$(Text1(cDirIni))
CmdAceptar.Caption = "Cancelar"
MousePointer = vbArrowHourglass
DoEvents
'Leer la estructura de directorios, si se activa Check1
'
Text1(cExtension) = Trim$(Text1(cExtension))
If Check1 Then
'Si se recorren los directorios, usar la función
Label2 = "Procesando los directorios de " & sRuta
If Len(Text1(cExtension)) Then
Label2 = Label2 & vbCrLf & "con la extensión: " & Text1(cExtension)
End If
DoEvents
cSelDir.Directorios colDir, sRuta, Text1(cExtension)
Label2 = ""
If cSelDir.Cancelar Then
GoTo Salir
End If
Else
If Len(Text1(cExtension)) Then
'Los archivos del directorio especificado
cSelDir.Directorio colDir, sRuta, Text1(cExtension)
If cSelDir.Cancelar Then
GoTo Salir
End If
Else
'Sólo el directorio actual
colDir.Nuevo sRuta
End If
End If
'Mostrar el contenido de colDir
List1.Clear
For Each tNombre In colDir.Nombres
List1.AddItem tNombre.Nombre
Next
Label2 = "Archivos/Directorios hallados: " & List1.ListCount
'Liberar memoria y los objetos
Set tNombre = Nothing
Set colDir = Nothing
Set cSelDir = Nothing
'
Salir:
'Restaurar los "valores" por defecto
CmdAceptar.Caption = "&Aceptar"
MousePointer = vbDefault
DoEvents
On Local Error GoTo 0
End Sub
Private Sub cmdExaminar_Click()
'Seleccionar el directorio en el que se empezará la Busqueda
#If esOLE Then
Dim cSelDir As New oSelDir.SelDir 'Una referencia al objeto OLE
#Else
Dim cSelDir As New SelDir 'Una referencia a la clase cargada
#End If
Dim sDir As String 'Directorio seleccionado
sDir = cSelDir.Seleccionar(Trim$(Text1(cDirIni)), "")
If Len(sDir) = 0 Then
Text1(cDirIni).SetFocus
Else
If Right$(sDir, 1) = "\" Then
sDir = Left$(sDir, Len(sDir) - 1)
End If
Text1(cDirIni) = sDir
End If
Set cSelDir = Nothing
End Sub
Private Sub cmdSalir_Click()
Unload Me
End
End Sub
Private Sub Form_Load()
Label2 = ""
Cancelar = False
End Sub
Private Sub Form_Unload(Cancel As Integer)
Set Form1 = Nothing
End Sub
3.- Usarlo como un proyecto normal (el ejemplo sin OLE)
En este caso, vamos a usar esta
utilidad sin ser una librería OLE, es decir con el código en el
proyecto.
Deberás cargar el proyecto test_SelDir.vbp
Los únicos cambios a realizar, son los ya expuestos al
principio, es decir asignarle las propiedades públicas y
Instancing, para que los objetos no sean expuestos. En caso de
dejarlos como están ahora mismo, tendrías un archivo ejecutable
que expondría estos objetos y por tanto también podrían ser
usados por otras aplicaciones, pero no te lo recomiendo, hasta
que no lo pruebes bien. Yo aún estoy en ello.
Aquí no hay listados, porque ya está todo en los dos puntos anteriores.
Las "fotos" del form de prueba y de la utilidad de seleccionar los directorios:
El form de Selección de Directorios
El Form de Prueba
