|
Alles oder nichts - das eigentlich recht praktische und bequeme  FileSystemObject
aus der Microsoft Scripting Runtime kann nicht anders: Entweder
liefert es Ihnen alle Dateien oder alle Unterordner eines Ordners,
oder keine. Und das Ergebnis wird Ihnen dann auch noch völlig
unsortiert geliefert (natürlich trifft das nur für das "Alles"-Ergebnis
zu...).
Wie Sie immerhin recht einfach eine Sortierung erhalten können,
indem Sie die File- oder Folder-Objekte in eine sortierte Collection
einfügen, sehen Sie
in  "Sortierte
Dateien und Ordner". Da bleibt nun noch der Wunsch
nach einer Filterung über eine Dateimaske (z.B. *.*
oder *.TXT oder A*.EXE oder ABC??*
usw.). Eine derartige Filterung kennen Sie sicher vom Betriebssystem
(DOS) her. Auch die auf andere Weise wiederum unpraktische Dir-Funktion
von Visual Basic erlaubt die Filterung über eine Dateimaske.
Fassen wir doch einmal beide Wünsche zusammen und erfüllen sie
uns in einer diesen Komfort bietenden Klasse, jeweils eine eigene
für Dateien (File-Objekte) und für Ordner (Folder-Objekte). Die
beiden Klassen gleichen sich in Ihrer Funktionsweise und ihren
Features. Die Dateien-Klasse (MaskedFiles) beruht auf der
Files-Collection eines Folder-Objekts und enthält selbst nur
File-Objekte. Die Ordner-Klasse beruht dagegen (MaskedFolders) auf
der SubFolders-Collection eines Ordners und enthält dementsprechend
nur Folder-Objekte. Die File- bzw. Folder-Objekte werden in der
internen Collection mItems gehalten. In dieser Hinsicht verhält
sich die Klasse wie eine einfache Collection. Sie können über die
Standard-Eigenschaft Item unter Angabe eines Schlüssel oder eines
Index ein Element auslesen, über die Eigenschaft Count die Anzahl
der aktuell enthaltenen Elemente erhalten, und auch in einer For...Each-Schleife
über die Funktion NewEnum die Elemente durchlaufen.
Private mItems As Collection
Public Property Get Count() As Long
Count = mItems.Count
End Property
Public Property Get Item(KeyIndex As Variant) As File ' bzw. Folder
On Error Resume Next
Set Item = mItems(KeyIndex)
End Property
Public Function NewEnum() As IUnknown
Set NewEnum = mItems.[_NewEnum]
End Function
Die interne Collection mItems wird im Class_Initialize-Ereignis
erstmals instanziert und der Ordnung halber im
Class-Terminate-Ereignis wieder zerstört.
Private Sub Class_Initialize()
' ...
Set mItems = New Collection
End Sub
Private Sub Class_Terminate()
Set mItems = Nothing
End Sub
Über die Eigenschaft Folder setzen Sie den Basis-Ordner, dessen
Files- bzw. SubFolders-Collection als Quelle dienen soll.
Private pFolder As Folder
Public Property Get Folder() As Folder
Set Folder = pFolder
End Property
Public Property Set Folder(New_Folder As Folder)
Set pFolder = New_Folder
zReadItems
End Property
Nach der Zuweisung des neuen Folder-Objekts wird die Prozedur
zReadItems aufgerufen, die die Files bzw. die SubFolders-Collection
des neuen Folder-Objekts erneut auswertet und der Maske entsprechend
die File- bzw. Folder-Objekte in die interne Collection mItems
einliest. Auf die Prozedur zReadItems werde ich weiter unten noch
näher eingehen.
Über die Eigenschaft Mask setzen Sie die Dateimaske. Deren
Auswertung wird intern über den Visual Basic-Operator Like
vorgenommen. Sie können daher die Filtermasken nach deren Muster
übergeben und gewinnen somit sogar noch ein wenig mehr Komfort
gegenüber den üblichen Dateimasken. Damit die vom Betriebssystem
nicht unterschiedene Groß-/Kleinschreibung unberücksichtigt
bleibt, wird für die Klasse übergeordnet
Option Compare Text
gesetzt.
Private pMask As String
Public Property Get Mask() As String
Mask = pMask
End Property
Public Property Let Mask(New_Mask As String)
If pMask <> New_Mask Then
pMask = New_Mask
zReadItems
End If
End Property
Wenn sich die neue Maske von der alten unterscheidet, wird sie
gesetzt. Dann wird auch hier die Prozedur zReadItems zum erneuten
Einlesen der File- bzw. Folder-Objekte aufgerufen, um die interne
Collection entsprechend der Maske zu aktualisieren.
Im Class_Initialize-Ereignis wird die Maske als Voreinstellung
auf "*.*" gesetzt.
Private Sub Class_Initialize()
pMask = "*.*"
' ...
End Sub
Neben der Dateimaske steht die Sortierung auf unserer
Wunschliste. Der Sortier-Modus wird über die Eigenschaft SortMode
gesetzt. Zulässig ist einer der Konstantwerte aus der Enumeration
mfiSortModeConstant (in MaskedFiles) bzw. mfoSortModeConstant (in
MaskedFolders).
Public Enum mfiSortModeConstants
mfiUnsorted
mfiSortByName
mfiSortBySize
mfiSortByDateCreated
mfiSortByDateLastAccessed
mfiSortByDateLastModified
End Enum
Private pSortMode As mfiSortModeConstants
Public Property Get SortMode() As mfiSortModeConstants
SortMode = pSortMode
End Property
Public Property Let SortMode(New_SortMode As mfiSortModeConstants)
Select Case New_SortMode
Case mfiUnsorted To mfiSortByDateLastModified
pSortMode = New_SortMode
zRefreshItems
Case Else
Err.Raise 380
End Select
End Property
Falls ein ungültiger Wert als SortMode übergeben wird, wird der
abfangbare VB-eigene Laufzeitfehler 380 ausgelöst
("Ungültiger Eigenschaftswert"). Anderenfalls wird der
neue Sortier-Modus übernommen, und wie bei den Eigenschaften Folder
und Mask wird wieder über eine Prozedur der Inhalt der internen
Collection aktualisiert. Hier wird jedoch die Prozedur zRefreshItems
aufgerufen. Denn hier ist es ja nicht notwendig, die der Maske
entsprechenden File- bzw. Folder-Objekte aus der Files- bzw.
SubFolders-Collection des internen Folder-Objekts erneut auszulesen.
Es ist lediglich notwendig, die in mItems enthaltenen Objekte
umzusortieren. Auch auf die Prozedur zRefreshItems werde ich weiter
unten noch näher eingehen.
Schließlich gibt es noch die Eigenschaft KeyMode. Über sie
legen Sie fest, ob beim Einfügen der File- bzw. Folder-Objekte in
die interne Collection mItems der Datei- bzw. Ordner-Name (Namne-Eigenschaft)
oder der Pfad (Path-Eigenschaft) als Schlüssel verwendet werden
soll. Standard ist die Verwendung des Namens als Schlüssel.
Public Enum mfiKeyModeConstants
mfiKeyModeName
mfiKeyModePath
End Enum
Private pKeyMode As mfiKeyModeConstants
Public Property Get KeyMode() As mfiKeyModeConstants
KeyMode = pKeyMode
End Property
Public Property Let KeyMode(ByVal New_KeyMode As mfiKeyModeConstants)
Select Case New_KeyMode
Case pKeyMode
Case mfiKeyModeName, mfiKeyModePath
pKeyMode = New_KeyMode
zRefreshItems
Case Else
Err.Raise 380
End Select
End Property
Auch hier ist wieder nur eine Reorganisation der internen
Collection mItems notwendig, so dass der Aufruf der Prozedur
zRefreshItems ausreicht.
Da jedes Setzen der Eigenschaften Folder, Mask, SortMode und
KeyMode ein Neueinlesen bzw. eine Reorganisation der internen
Collection mItems nach sich zieht, bietet es sich zur Steigerung der
Performance an, eine Methode zur Verfügung zu stellen, über die
alles auf einmal gesetzt werden kann. Alle Parameter sind optional,
so dass Sie beliebige Kombinationen neu setzen können.
Public Sub SetFolder(Optional Folder As Folder, _
Optional Mask As String, _
Optional ByVal SortMode As mfiSortModeConstants, _
Optional ByVal KeyMode As mfiKeyModeConstants)
If Not(Folder Is Nothing) Then
Set pFolder = Folder
End If
If StrPtr(Mask) <> 0 Then
pMask = Mask
End If
Me.SortMode = SortMode
Select Case SortMode
Case pSortMode
Case mfiUnsorted To mfiSortByDateLastModified
pSortMode = SortMode
Case Else
Err.Raise 380
End Select
Select Case KeyMode
Case pKeyMode
Case mfiKeyModeName, mfiKeyModePath
pKeyMode = KeyMode
Case Else
Err.Raise 380
End Select
zReadItems
End Sub
Da allerdings sowohl eine Änderung der Maske als auch des
Basis-Ordners ein komplettes Neueinlesen der File- bzw.
Folder-Objekte in die interne Collection mItems erfordert, wird hier
zum Abschluss wieder zReadItems aufgerufen. Ein Aufruf von SetFolder
ohne Parameter kommt daher einem Aufruf der Methode Refresh gleich -
in dieser wird daher auch lediglich zReadItems aufgerufen.
Public Sub Refresh()
zReadItems
End Sub
Da die interne Sortierung auf den Funktionen des Moduls
modCollAddSortedFileFolders.bas (siehe oben, aus "Sortierte
Dateien und Ordner") beruht, kann zunächst immer nur in
aufsteigender Reihung sortiert werden. Eine absteigende Sortierung
erhalten Sie mit dem Aufruf der Methode Revert. In ihr wird
lediglich die Reihenfolge der internen Collection mItems umgekehrt.
Dabei werden aus dieser die Elemente von hinten her ausgelesen und
in eine neue, frisch instanzierte Collection eingelesen. Danach wird
die neue Collection der Variablen mItems zugewiesen und damit zur
aktuellen Collection, während die alte automatisch freigegeben und
aufgelöst wird.
Public Sub Revert()
Dim nItem As File ' bzw. Folder
Dim nItems As Collection
Dim l As Long
Set nItems = New Collection
Select Case pKeyMode
Case mfoKeyModeName
With nItems
For l = mItems.Count To 1 Step -1
.Add mItems(l), mItems(l).Name
Next 'l
End With
Case mfoKeyModePath
With nItems
For l = mItems.Count To 1 Step -1
.Add mItems(l), mItems(l).Path
Next 'l
End With
End Select
Set mItems = nItems
End Sub
Betrachten wir nun die private Prozedur zReadItems. Sie liest die
Files- bzw. SubFolders-Collection des Basis-Folder-Objekts aus und
fügt die mit der Maske übereinstimmenden File- bzw Folder-Objekte
entsprechend der Sortierung in die Collection mItems ein. Genauer
gesagt wird zunächst die neu Collection nItems gefüllt, die erst
zum Abschluss der Prozedur der Variablen mItems zugewiesen wird.
Dieser Zwischenschritt ist notwendig, um den alten Inhalt von mItems
erst einmal unberührt zu lassen, falls die Prozedur im Fehlerfall
vorzeitig verlassen werden sollte.
Private Sub zReadItems()
Dim nItem As Folder
Dim nItems As Collection
Dim nMask As String
If Right$(pMask, 1) = "." Then
nMask = Left$(pMask, Len(pMask) - 1)
Else
nMask = pMask
End If
Set nItems = New Collection
If Not (pFolder Is Nothing) Then
Select Case pSortMode
Case mfoUnsorted
With nItems
Select Case pKeyMode
Case mfoKeyModeName
For Each nItem In pFolder.SubFolders
If nItem.Name Like nMask Then
.Add nItem, nItem.Name
End If
Next
Case mfoKeyModePath
For Each nItem In pFolder.SubFolders
If nItem.Name Like nMask Then
.Add nItem, nItem.Path
End If
Next
End Select
End With
Case mfoSortByName
For Each nItem In pFolder.SubFolders
If nItem.Name Like nMask Then
zAddFolderSorted nItems, nItem, pKeyMode
End If
Next
Case mfoSortBySize
For Each nItem In pFolder.SubFolders
If nItem.Name Like nMask Then
zAddFolderSortedBySize nItems, nItem, pKeyMode
End If
Next
Case mfoSortByDateCreated
For Each nItem In pFolder.SubFolders
If nItem.Name Like nMask Then
If zAddFolderSortedByDateCreated(nItems, nItem, pKeyMode) _
Then
Err.Raise mfoErrCannotSortByDateCreated, , _
"mfoErrCannotSortByDateCreated"
Exit Sub
End If
End If
Next
Case mfoSortByDateLastAccessed
For Each nItem In pFolder.SubFolders
If nItem.Name Like nMask Then
If zAddFolderSortedByDateLastAccessed(nItems, nItem, _
pKeyMode) Then
Err.Raise mfoErrCannotSortByDateLastAccessed, , _
"mfoErrCannotSortByDateLastAccessed"
Exit Sub
End If
End If
Next
Case mfoSortByDateLastModified
For Each nItem In pFolder.SubFolders
If nItem.Name Like nMask Then
zAddFolderSortedByDateLastModified nItems, nItem, _
pKeyMode
End If
Next
End Select
End If
Set mItems = nItems
End Sub
Die beiden Fehler-Ausstiege sind notwendig, da nicht alle File-
bzw. Folder-Objekte anhand der DateCreated- und DateLastAccessed
sortiert werden können. Bei im DOS-Modus erzeugten Dateien und
Ordnern löst nämlich ein Zugriff auf diese Eigenschaften einen
Fehler aus, da sie hier nicht verfügbar sind.
Die Prozedur zRefreshItems sieht ähnlich aus. Hier entfällt
allerdings in jeder der Schleifen die Prüfung der Dateimaske, da
RefreshItems nur aufgerufen wird, wenn die Dateimaske mit Sicherheit
unverändert geblieben ist. Die interne Collection mItems enthalt
somit bereits alle übereinstimmenden Elemente, die nur neu sortiert
werden oder entsprechend der KeyMode-Einstellung mit dem
gewünschten Schlüssel neu eingelesen werden. Auch hier erfolgt
wieder der Zwischenschritt über die neu instanzierte Collection
nFiles, die erst zum Abschluss der Prozedur der Variablen mItems
zugewiesen und damit zur aktuellen Collection wird.
Private Sub zRefreshItems()
Dim nItem As File
Dim nItems As Collection
Set nItems = New Collection
Select Case pSortMode
Case mfiUnsorted
With nItems
Select Case pKeyMode
Case mfiKeyModeName
For Each nItem In mItems
.Add nItem, nItem.Name
Next
Case mfiKeyModePath
For Each nItem In mItems
.Add nItem, nItem.Path
Next
End Select
End With
Case mfiSortByName
For Each nItem In mItems
zAddFileSorted nItems, nItem, pKeyMode
Next
Case mfiSortBySize
For Each nItem In mItems
zAddFileSortedBySize nItems, nItem, pKeyMode
Next
Case mfiSortByDateCreated
For Each nItem In mItems
If zAddFileSortedByDateCreated(nItems, nItem, pKeyMode) _
= -1 Then
Err.Raise mfiErrCannotSortByDateCreated, , _
"mfiErrCannotSortByDateCreated"
Exit Sub
End If
Next
Case mfiSortByDateLastAccessed
For Each nItem In mItems
If zAddFileSortedByDateLastAccessed(nItems, nItem, _
pKeyMode) Then
Err.Raise mfiErrCannotSortByDateLastAccessed, , _
"mfiErrCannotSortByDateLastAccessed"
Exit Sub
End If
Next
Case mfiSortByDateLastModified
For Each nItem In mItems
zAddFileSortedByDateLastModified nItems, nItem, pKeyMode
Next
End Select
Set mItems = nItems
End Sub
Die Funktionen zum sortierten Einfügen der File- bzw.
Folder-Objekte in die mItems-Collection werden hier nicht
dargestellt. Sie sind aber in den Klassen-Modulen als private
Funktionen enthalten und stammen aus dem bereits erwähnten Modul modCollAddSortedFileFolders.bas.
Im folgenden Beispiel sehen Sie, wie Sie alle Dateien mit der
Datei-Erweiterung .EXE in umgekehrt nach dem Namen sortierter
Reihenfolge erhalten und in eine ListBox einlesen können:
Private mFSO As New FileSystemObject
Private mMaskedFiles As MaskedFiles
Private Sub Command1_Click()
Dim nFolder As Folder
Dim nFile As File
Set nFolder = mFSO.GetSpecialFolder(WindowsFolder)
Set mMaskedFiles = New MaskedFiles
On Error Resume Next
mMaskedFiles.SetFolder nFolder, "*.EXE", mfiSortByName
If Err.Number Then
MsgBox Err.Description, vbCritical, Err.Number
Else
mMaskedFiles.Revert
With List1
.Clear
For Each nFile In mMaskedFiles
.AddItem nFile.Name
Next
End With
End If
End Sub
|