Dateimasken bzw. Wildcards in VBScript

VBScript bietet keine Möglichkeit, z.B. beim Einlesen einer Files Collection eine Dateimaske vorzugeben; es werden immer alle Dateien des betreffenden Verzeichnisses geliefert. Aus gegebenem Anlass benötigte ich aber dieses Feature und habe deshalb eine VBS-Klasse für diesen Zweck geschrieben, deren Code ich hiermit der Öffentlichkeit zur Verfügung stellen möchte.

Der Code liefert nicht die selben Ergebnisse wie der DIR-Befehl der Kommandozeile, denn dessen Pattern Matching Algorithmus ist, wie so viele Konsolenbefehle, nicht fehlerfrei implementiert, d.h. er hält sich nicht exakt an die definierte Bedeutung des Wildcardzeichens ?.

Das Fragezeichen steht für ein beliebiges Zeichen, das genau einmal vorkommen muss. Bei folgender Verzeichnisstruktur
liefert der Befehl
wie erwartet kein Ergebnis. Der Befehl
liefert jedoch beide Dateinamen zurück, was nicht der Definition von ? entspricht. Der hier vorgestellte Code liefert das korrekte Ergebnis, nämlich nichts.




Jetzt aber erstmal der Code:

Die öffentliche Funktion FileNameMatch der Klasse zerlegt den Dateinamen und das Suchmuster in die Bestandteile Name und Erweiterung und prüft beides separat auf eine Übereinstimmung durch Aufruf der privaten Funktion FindMatch. Wenn beides dem angegebenen Suchmuster entspricht, wird True zurückgeliefert, sonst False.

Die Hauptschleife in den Zeilen 18 bis 39 prüft die einzelnen Zeichen des Dateinamens und der Suchmaske auf Gleichheit. Ein Fragezeichen in der Suchmaske wird als Übereinstimmung gewertet.

Wenn ein Stern/Asterisk in der Suchmaske gefunden wird, wird zunächst geprüft, ob es sich um das letzte Zeichen der Suchmaske handelt. Wenn ja haben wir einen Treffer. Wenn nicht, ruft sich die Funktion in Zeile 33 selbst auf. Die Position des Zeichenzeigers in die Suchmaske wird für die neue Instanz um eins erhöht (intIdxPattern + 1). Die neue Instanz der Funktion sucht also nach Übereinstimmungen ab der gleichen Position im Dateinamen und der um eins erhöhten Position in der Suchmaske (hinter dem Asterisk).

Wenn die neue Instanz keine Übereinstimmung gefunden hat, wird nach der Rückkehr der Positionszeiger intIdxStr in den Dateinamen um eins erhöht und, wenn die Abbruchbedingungen der Schleife nicht erfüllt sind, wieder eine Instanz der Funktion aufgerufen. intIdxPattern hat dabei wieder den gleichen Wert wie beim letzten Aufruf. Die Schleife und damit, wegen Zeile 37, auch die Funktion bricht ab, wenn ein Treffer gefunden wurde oder alle Zeichen des Dateinamens überprüft wurden.

Zeile 41 dient dazu den Fall zu erkennen, dass die Hauptschleife beendet wurde, weil nur einer der beiden Strings bis zum letzten Zeichen verarbeitet wurde. Dann liegt kein Treffer vor.

Zeile 42 ist für den Sonderfall, dass der Dateiname schon vollständig verarbeitet wurde, der Positionszeiger für die Suchmaske aber erst auf dem letzten Zeichen steht und dieses Zeichen ein Asterisk ist. Dann liegt ein Treffer vor (Ausnahme von der Ausnahme ).


Jetzt ein Beispiel zur Verwendung. Der obige Code muss in die Datei mit dem folgenden Code kopiert werden.

Aufruf:

In Zeile 19 wird eine Files Collection erzeugt, die alle Dateien des übergebenen Verzeichnisses enthält. Jeder Dateiname wird in Zeile 22 auf Übereinstimmung mit dem übergebenen Muster geprüft und bei einem Treffer das File Objekt in das Array arrFilesToOpen gespeichert, das dafür jedesmal dynamisch vergrößert wird.

Über die Abfrage in Zeile 28 lässt sich feststellen, ob passende Dateien gefunden wurden. Es wird dann durch das Array iteriert, um mit jeder Datei die vorgesehene Aktion auszuführen. Im Beispiel wird der komplette Dateipfad angezeigt und die Datei zum Lesen geöffnet.

Gruß
Friemler

C:\>dir /b C:\script\friemler\*
test.cmd
test.txt
test1.txt
test2.txt

C:\>dir /b C:\script\friemler\t??t?.txt
test.txt
test1.txt
test2.txt

C:\>dir /b C:\script\friemler | findstr /i "t..t..txt"
test1.txt
test2.txt

Function FileNameMatch(strFileName, byVal strPattern)
  arrSpecialChars = Array("^", "$", "+", ".", "(", ")", "{", "}", "[", "]")  
  For Each strSpecialChar In arrSpecialChars
    strPattern = Replace(strPattern, strSpecialChar, "\" & strSpecialChar)  
  Next
  strPattern = Replace(strPattern, "?", ".")  
  strPattern = "^" & Replace(strPattern, "*", ".*") & "$"  
  Set objRegEx = New RegExp
  objRegEx.IgnoreCase = True
  objRegEx.Pattern = strPattern
  FileNameMatch = objRegEx.Test(strFileName)
  Set objRegEx = Nothing
End Function

Const GetFiles   = 0
Const GetFolders = 1


If WScript.Arguments.Count > 0 Then
  Set objWildcards = New clsWildcards

  If WScript.Arguments.Count > 1 Then
    strAttrib = WScript.Arguments(1)
  Else
    strAttrib = ""  
  End If


  arrFolders = objWildcards.GetFSItems(WScript.Arguments(0), strAttrib, GetFolders)

  For Each strFolder In arrFolders
    WScript.Echo strFolder
  Next

  If UBound(arrFolders) >= 0 Then Erase arrFolders


  WScript.Echo


  arrFiles = objWildcards.GetFSItems(WScript.Arguments(0), strAttrib, GetFiles)

  For Each strFile In arrFiles
    WScript.Echo strFile
  Next

  If UBound(arrFiles) >= 0 Then Erase arrFiles
End If




'************ Klasse zur Behandlung von Wildcards mit Hilfe des DIR-Kommandos **************  

Class clsWildcards
  Private objFSO


  Private Sub Class_Initialize()
    Set objFSO = CreateObject("Scripting.FileSystemObject")  
  End Sub


  Private Sub Class_Terminate()
    Set objFSO = Nothing
  End Sub


  'DIR-Befehl ausführen und Ausgabe zeilenweise in ein Array schreiben  
  Private Function GetItems(strMask, strAttrib)
    Dim objShell, objExec

    Set objShell = CreateObject("WScript.Shell")  
    Set objExec  = objShell.Exec("%comspec% /c " & Chr(34) & "Dir /b /o:ne " & strAttrib & " " & Chr(34) & strMask & Chr(34) & Chr(34))  
    GetItems     = Split(objExec.StdOut.ReadAll, vbCRLF)
  End Function


  'Eingabedaten vorbereiten, DIR-Befehl ausführen und dessen Ausgabe nachbearbeiten  
  Public Function GetFSItems(strMask, strAttrib, intKind)
    Dim I, str_Attrib, str_Mask, arrItems

    arrItems = Array()

    str_Mask = objFSO.GetAbsolutePathName(strMask)

    If objFSO.FolderExists(str_Mask) Then
      str_Mask = objFSO.BuildPath(str_Mask, "\*.*")  
    End If

    'Sollen Dateien oder Verzeichnisse ermittelt werden?  
    If intKind = 0 Then
      'DIR für Dateien ausführen  
      arrItems = GetItems(str_Mask, "/a:-d" & str_Attrib)  
    Else
      'DIR für Verzeichnisse ausführen  
      arrItems = GetItems(str_Mask, "/a:d" & str_Attrib)  
    End If

    'Zusätzliche Leerzeile der Ausgabe von DIR entfernen  
    If UBound(arrItems) >= 0 Then ReDim Preserve arrItems(UBound(arrItems) - 1)

    'Pfad des Elternverzeichnisses vor die Elemente setzen  
    For I = 0 To UBound(arrItems)
      arrItems(I) = objFSO.BuildPath(objFSO.GetParentFolderName(str_Mask), arrItems(I))
    Next

    GetFSItems = arrItems
  End Function
End Class