| ||
 |
Objects in Visual Basic- Thinking Objectively
By Guillermo Som (Translated by Joe LeVasseur [Any mistakes, etc are probably by translator.) |
There is an old saying in Spanish that says that if you want to show someone how to get moving- then get off your butt and start walking. We're not going to be walking today, we're too accustomed to sitting around at our desks while writing code - although we can start moving our applications toward the world of objects. I'm going to try to ensure this movement will be a little more understandable for those of you who wish to "objectify". As the above saying goes- the best way is with practical examples, at least as practical as I can make them in these few paragraphs.
This article will deal with collections and afterwards: collections of collections. We'll also see how to notify our program that our objects have something to tell it, we'll do this with events.
To do all of this, we're going to create a little utility that will permit us to examine the contents of a hard-disk. In one place we'll have the directories with their respective files and in another place all the files with different names, in order, among other things, to know in how many directories can be found a specific file. Since the number of files can be quite large, we'll allow a choice of only searching two levels of directories, or searching the entire drive.All of this information will be stored in collections maintained by a class, and will be displayed in two ComboBoxes, one with the names of the files, and another with the names of the directories. Upon selection of a file, all directories which contain a file of this name will be displayed, and upon selection of a directory, all of the files contained therein will be displayed.
Since VB collections aren't especially optimized for storing huge amounts of data, this type of utility can be a bit exasperating, especially when releasing the memory used by all of the objects created. In the case of my computer, upon examining the entire drive I found 29263 files in 1789 directories, with 22258 different file names. VB took almost seven minutes to fully release the memory ... but since we're trying to demonstrate some practical concepts, it was worth the wait. If instead of using a collection, I had used arrays, things would have been much better, but information processing time would have taken three or four times as long.
The components of the application
To perform this task we'll use a basic class which will store a name, which will be, according to the context it's used, a file or directory name. We'll also have a collection which will hold all of the file names in a specific directory. Lastly, we'll have a class which will in turn maintain a collection of those directories and all of their files- with different names, that are found on our drive. This class will also take on the responsibility of exploring the disk and will have methods which will allow us to show the files of a directory, and all directories in which a file is found. Also, this class will inform us, by way of an event, whenever it finds a new file or directory.
To use this class, since it uses events, we'll need to create it like this:
Dim WithEvents tDrive As cDriveThis way, a new entry will be created in the objects that are listed in our form, and we can select any of its events to use for our purposes. In our case, there will be an event each time the class finds a new directory, and each time the class finds a new name of a file (Without duplication.). When these events occur we'll add the file or directory names to our comboboxes.
Let's take a look at the code used in the events:
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 SubIn order for the process to start simply we'll call the method which will explore the disk and watch over the collections. This is done as follows:
tDrive.FillDirs Text1, vbHidden + vbReadOnly + vbSystem + vbArchive, chkLevelsIf we only want to look at one level, and only normal files, we could use the default values:
tDrive.FillDirs Text1This method will process each of the directories and each time it finds a new file name, it will call the Add method of the class. This class will take responsibility for including in the corresponding collections the values it has received. The Add method quite simple, here is the code:
Public Sub Add(ByVal sDir As String, ByVal sFile As String) Dirs(sDir)(sFile).Name = sFile 'Add to the file collection Call Files(sFile) End SubAs you can imagine, the hard work will be using Dirs or Files, but we're going to put that aside for now. First we're going to look at each of the pieces of the puzzle. We'll also see how to call the methods created to show the directories in which a file is found and to show all the files in a directory. In our example form let's see what happens when an element of a ComboBox is selected- for example when we select a file in Combo1:'Show the directories of the selected file sFile = Combo1.List(Combo1.ListIndex) 'Add the folders of this file to List1 tDrive.ShowFiles sFile, List1Likewise when combo2 is selected, we'll show the files in that directory.'Show the directories of the selected file sDir = Combo2.List(Combo2.ListIndex) ' tDrive.ShowDirs sDir, List1Now let's look at the code in each of the classes.
The basic class: cFile
This is the class used to store a name and it will be an element of the collection of files and/or directories.
It only has one property: Name and no methods.
Let's check out the code:'------------------------------------------------------------------ 'cFile.cls (22/May/98) 'A basic class to store a name ' '©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 PropertyThe class/collection to store cFile objects : cFiles
This is a collection which will contain cFile objects, which is one way to use a personalized collection. Even though I omitted the use of the customary methods such as Add, Count, and Remove for the sake of simplicity (And they're not necessary in this example.), I'll show how to implement them later.
This class/collection with have one property: Path which will be the name of the directory which contains the files, in other words in this class will be stored all of the file names in a specific directory. The method/property which will handle storing the different files will be Item- which will be the default property. In order to make this property the default one, go to the Tools menu in Visual Basic and select "Procedure Attributes". You will be presented with a dialog where you should press the "Advanced" button. In the Procedure ID listbox, select Default.
Another method of our collection, like all good collections, is the NewEnum method- which will permit us to flip through the contents using the For Each ... Next syntax. For this functionality, this method should be hidden and the Procedure ID should have a value of -4 (Minus four.). This setting can also be done from Tools/Procedure Attributes/Advanced route...
Let's see the code:
'------------------------------------------------------------------ 'cFiles.cls (22/May/98) 'Collection class to hold cFile objects ' '©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 'Should be a hidden member and the 'Procedure Id should be -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 SubIn the Item method error detection is used to determine if the item exists in the collection. In the case that the item exists, the item is returned, otherwise an error is generated when we try to obtain it from the collection. We'll take advantage of this error to know that the item doesn't exist in the collection and add it.Each time that a class is created there is a Class_Initialize event generated- and that is a good place to assign default values. In our case we'll only create the collection that contains the file names. There is also a corresponding Class_Terminate event when the class is terminated- we'll destroy our collection there.
Since I promised earlier, we'll also look at the Add, Remove, and Count methods that any class should have. (I repeat myself, but our class doesn't need them.) I'll also show how I usually implement a Clear method, I must note that in this case it is necessary to "recreate" the collection so that it can continue to be used. In other words, it's no goood to simply assign the collection a value of Nothing, since thereafter we wouldn't have a collection to add to.
Public Function Count() As Long 'Number of elements in the collection 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) 'The Key parameter is for compatibility to Add methods of normal 'collections, but we'll always assign the name Dim sKey As String On Local Error Resume Next If Not (TypeOf Item Is cFile) Then 'Error- only cFile objects Else sKey = Item.Name colFiles.Add Item, sKey, Before, After End If Err = 0 End Sub Public Sub Clear() 'Erase the contents of the collection Set colFiles = Nothing Set colFiles = New Collection End SubNow we only need to see the code for the cDrive class.
The cDrive class
This is the class that will manage all of the data and will provide Events and methods to show the files and directories contained in the collections. Let's see all of the code and then we'll attend to the small details:
'------------------------------------------------------------------ 'cDrive (22/May/98) 'Class to maintain collections of files and directories ' '©Guillermo 'guille' Som, 1998 '------------------------------------------------------------------ Option Explicit Option Compare Text Public Cancel As Boolean Private colFiles As Collection Private colDirs As Collection 'This event will be fired each time a new file is added Public Event NewFile(ByVal sFile As String) 'This event will be fired each time a new directory is added Public Event NewDir(ByVal sDir As String) Public Sub Add(ByVal sDir As String, ByVal sFile As String) Dirs(sDir)(sFile).Name = sFile 'Add to the file collection Call Files(sFile) End Sub Public Function Files(Optional ByVal Index As Variant) As Variant 'This method will return a collection of files or the indicated 'item ' 'If it doesn't exist, it's added ' 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 'If no Index is indicated, the collection 'is returned 'Otherwise the indicated directory is returned, 'if it doesn't exist, it's added ' Dim tFiles As New cFiles On Local Error Resume Next If IsMissing(Index) Then 'Return the collection 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) 'Show all the files in the indicated directory 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) 'Show all of the directories where the indicated file exists 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 SubThe Method/Properties Dirs and Files use an optional parameter to know if one wants to access an element or the collection itself. This is why the return type is a variant- since it could as easily be a collection of cFiles objects as it could be a single cFiles object. In these Method/Properties there are events produced whenever a new element is assigned to any of the collections. For this we use RaiseEvent with the appropriate event according to the type of data assigned- a directory or new file. Notice that in the collection of files only strings are stored, not any particular object.The Cancel property enables us to cancel the exploration of a drive process. To indicate to our class that we wish to cancel, the syntax would be:
tDrive.Cancel = True
Although this form of use has its problems, it's a simple way to manipulate the elements of a collection, at least when referring to ease of adding new elements. But we could possibly make the error of an assignment of this type:
tDrive.Dirs.Add "trash"
A string will be assigned instead of a cFiles object, then if we step through the contents of the Dirs collection with this::
For Each tFiles In tDrive.Dirs :Debug.Print tFiles.Path :Next
We'll get an error when we arrive at the "trash" element, since it's not a cFiles object. This problem can be solved by creating an intermediate class/collection to hold the cFiles object elements. This class will have an Add method (If we feel it's necessary.) which should take care of ensuring that the correct type of data is assigned- as we saw in the "extra" code for the cFiles object, except in this occasion cFiles would be the correct data type.
We'll do the same with the Files Method/Property, but in this case we won't need an intermediate class, since we have a class where we can srtore a series of names; cFiles. If we decide go ahead with these changes, the code would be as follows:
(The following is only the changed code, the rest would remain the same.)' Option Explicit Option Compare Text Public Cancel As Boolean Private colFiles As cFiles Private colDirs As cDirs 'This event will fire each time a file is added Public Event NewFile(ByVal sFile As String) 'This event will fire each time a directory is added Public Event NewDir(ByVal sDir As String) Public Sub Add(ByVal sDir As String, ByVal sFile As String) Dirs(sDir)(sFile).Name = sFile 'Add to the file collection 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 SubIn the Add method we only made a small change, because now we don't deal directly with strings, but with cFile objects. Of course the initialize event should create a different type of object, since it's not a simple collection. The Dir and Files properties have been simplified to the maximum. But... When are the evnts produced?Actually, in the CDrive class we can't tell when a new element is assigned to the collection of directories or files, because this process takes care of the Item methos of each of the collections. Although we can have those classes notify cDrive whenever a new item is added to their collections. Let's take a look at the necessary changes to the cFiles class:
Option Explicit 'We'll use this event to signal the addition of a new file 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 'Notify that a new element has been added RaiseEvent NewItem(NewFile) Set Item = tFile End If Err = 0 End Function Public Function Count() As Long 'The number of elements in the collection Count = colFiles.Count End FunctionFine, now all we have to do is change the decalration in cDrive to the following:Private WithEvents colFiles As cFiles
As we saw before, we'll now have a new colFiles object with a NewItem event, which we will use to raise the event that a file has been added:
Private Sub colFiles_NewItem(ByVal sFile As String) RaiseEvent NewFile(sFile) End SubIn the case of the "new" cDirs class, we'll do the same thing, or change the declaration of colDirs to the following:Private WithEvents colDirs As cDirs
Now we'll add this code to the NewItem event of this object:
Private Sub colDirs_NewItem(ByVal sDir As String) RaiseEvent NewDir(sDir) End SubLast, let's take a look at the final version of cDirs. (I left some additional methods commented out in case you want to implement them.)'------------------------------------------------------------------ 'cDirs collection of cFiles objects (25/May/98) ' '©Guillermo 'guille' Som, 1998 '------------------------------------------------------------------ Option Explicit Public Event NewItem(ByVal sDir As String) Private m_col As Collection 'Public Sub Clear() ' 'Erase the contents of the collection ' Set m_col = Nothing ' Set m_col = New Collection 'End Sub Public Function NewEnum() As IUnknown 'Should be a hidden member and have 'a Procedure ID of -4 ' Set NewEnum = m_col.[_NewEnum] End Function 'Public Sub Remove(ByVal Index As Variant) ' 'Remove method of a collection ' ' 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 'The Count method of a collection 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) ' 'Add a new element to the collection ' ' On Local Error Resume Next ' ' If TypeOf Item Is cFiles Then ' m_col.Add Item, Item.Path, Before, After ' Else ' 'Error, won't be added ' 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 SubActually, this last class is a "pattern" that I use to create new classes/collections- I just need to change the type of object that is added, this makes it fairly generic. If you would like to see the complete code (Iincluding a form.), to try everything out, press , here.Also, if you would like to leave me a message, press here, but please, no free consulting. I regret that I can't give much more than I do here, at least in English. If you would like to see code "explained" in Spanish , I invite you to my homepages. As my friend Joe said once when a fellow complained about my pages being in Spanish: Code is code.
Thanks.
See you around.
Guillermo
My homepages: http://guille.costasol.net/indice_cf.htm/
About the Author
Guillermo Som
Microsoft Developer MVP
Nerja, Spain
guille@costasol.net
| ||