friemler
Goto Top

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
test.text
test2.txt
liefert der Befehl
dir /b t?t*.txt
wie erwartet kein Ergebnis. Der Befehl
dir /b t??t????????.txt
liefert jedoch beide Dateinamen zurück, was nicht der Definition von ? entspricht. Der hier vorgestellte Code liefert das korrekte Ergebnis, nämlich nichts.


Trotzdem möchte ich betonen, dass der Code zwar getestet ist, aber trotzdem die Möglichkeit besteht,
dass er in speziellen Fällen falsche bzw. unvollständige Ergebnisse liefert. Verwendung auf eigene Gefahr!


Hinweise diesbezüglich sind mir sehr willkommen.


Jetzt aber erstmal der Code:
Class clsFileNameMatch
  Private objFSO


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


  Private Sub Class_Terminate()
    Set objFSO = Nothing
  End Sub


  Private Function FindMatch(ByRef strString, ByRef strPattern, ByVal intIdxStr, ByVal intIdxPattern)
    Dim chrString, chrPattern

    While (intIdxStr <= Len(strString)) And (intIdxPattern <= Len(strPattern))
      chrString  = Mid(strString, intIdxStr, 1)
      chrPattern = Mid(strPattern, intIdxPattern, 1)

      If chrPattern <> "*" Then  
        FindMatch = (UCase(chrString) = UCase(chrPattern) Or chrPattern = "?")  
        If Not FindMatch Then Exit Function

        intIdxStr     = intIdxStr + 1
        intIdxPattern = intIdxPattern + 1
      Else
        FindMatch = (intIdxPattern = Len(strPattern))
        If FindMatch Then Exit Function

        Do
          FindMatch = FindMatch(strString, strPattern, intIdxStr, intIdxPattern + 1)
          intIdxStr = intIdxStr + 1
        Loop Until FindMatch Or intIdxStr > Len(strString)

        Exit Function
      End If
    Wend

    If (intIdxStr <= Len(strString)) Or (intIdxPattern <= Len(strPattern)) Then FindMatch = False
    If (intIdxStr > Len(strString)) And (intIdxPattern = Len(strPattern)) And (Right(strPattern, 1) = "*") Then FindMatch = True  
  End Function


  Public Function FileNameMatch(ByRef strFileName, ByRef strPattern)
    Dim strName, strExt, strPatternName, strPatternExt

    strName = objFSO.GetBaseName(strFileName)
    strExt  = objFSO.GetExtensionName(strFileName)

    strPatternName = objFSO.GetBaseName(strPattern)
    strPatternExt  = objFSO.GetExtensionName(strPattern)

    If strPatternName = "" Then strPatternName = "*"  
    If strPatternExt  = "" Then strPatternExt  = "*"  

    FileNameMatch = FindMatch(strName, strPatternName, 1, 1) And FindMatch(strExt, strPatternExt, 1, 1)
  End Function
End Class

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 face-wink ).


Jetzt ein Beispiel zur Verwendung. Der obige Code muss in die Datei mit dem folgenden Code kopiert werden.
Const ForReading = 1
Const AsASCII    = 0

intResult        = 1

If WScript.Arguments.Count > 0 Then
  arrFilesToOpen  = Array()
  Set objFNMatch  = New clsFileNameMatch
  Set objFSO      = CreateObject("Scripting.FileSystemObject")  

  strMask         = WScript.Arguments(0)
  strFolder       = objFSO.GetParentFolderName(strMask)
  strFileName     = objFSO.GetFileName(strMask)

  If strFolder = "" Then strFolder = "."  

  If objFSO.FolderExists(strFolder) Then
    Set objFolder   = objFSO.GetFolder(strFolder)
    Set colAllFiles = objFolder.Files

    For Each objFile In colAllFiles
      If objFNMatch.FileNameMatch(objFile.Name, strFileName) Then
        ReDim Preserve arrFilesToOpen(UBound(arrFilesToOpen) + 1)
        Set arrFilesToOpen(UBound(arrFilesToOpen)) = objFile
      End If
    Next

    If UBound(arrFilesToOpen) >= 0 Then
      For Each objFile In arrFilesToOpen
        WScript.Echo "Datei " & objFile.Path & " wird geöffnet."  

        Set objStream = objFile.OpenAsTextStream(ForReading, AsASCII)
        '  
        'Dateiinhalt verarbeiten  
        '  
        objStream.Close
      Next

      intResult = 0
    Else
      WScript.Echo "Keine Datei(en) gefunden."  
    End If
  Else
    WScript.Echo "Verzeichnis nicht gefunden."  
  End If
Else
  WScript.Echo "Bitte eine Dateimaske übergeben!"  
End If

WScript.Quit intResult

Aufruf:
cscript /nologo example.vbs D:\Texte\*.txt

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

Content-ID: 169161

Url: https://administrator.de/contentid/169161

Ausgedruckt am: 08.11.2024 um 15:11 Uhr

60730
60730 06.07.2011 um 21:19:32 Uhr
Goto Top
Servus Friemler,

ich trau mich ja fast nicht, dich zu fragen - aber machs trotzdem.

Das "Problem" ist mir auch schon mal aufgestossen und bei einer Struktur
C:\>dir /b C:\script\friemler\*
test.cmd
test.txt
test1.txt
test2.txt

liefert wie du oben schon aufgeführt hast ein
C:\>dir /b C:\script\friemler\t??t?.txt
test.txt
test1.txt
test2.txt
nicht das, was man erwarten würde.

Ein gerade für dich simples
C:\>dir /b C:\script\friemler | findstr /i "t..t..txt"
test1.txt
test2.txt
bringt aber doch genau das, was gewünscht - war dir das zu einfach?

Trotzdem, oder gerade weil - 1.001 Dank für die Mühe.
Friemler
Friemler 06.07.2011 um 22:06:36 Uhr
Goto Top
Hi Timo,

Zitat von @60730:
... bringt aber doch genau das, was gewünscht - war dir das zu einfach?

ich wollte ja eine Möglichkeit haben, innerhalb eines VBScript Wildcards zu verarbeiten, ohne auf eine Batch-Krücke angewiesen zu sein. Das wäre für das Projekt, wegen dem ich das obige Script geschrieben habe, nicht praktikabel gewesen.

Innerhalb von VBS einen DIR-Befehl abzusetzen und dessen Ausgabe zu parsen ging mir gegen den Strich (Provisorium, unelegant, grummel face-wink ).

Mein eigentliches Ziel war auch nicht, besser als die Redmonder Praktikanten zu sein. Ich wollte eigentlich die Ausgabe des DIR-Befehls zum Gegenprüfen meines Scripts benutzen, das ging aber aus den o.g. Gründen nicht.

Aber ansonsten hast Du natürlich recht mit dem FINDSTR-Behelf.

Schönen Abend
Friemler
Skyemugen
Skyemugen 07.07.2011 um 08:22:33 Uhr
Goto Top
Aloha T-Mo,

stimmt, das hatte ich letztens erst, habe nach ?.* gesucht und bekam dann auch als Ergebnis: ._descrip.mms ich wunderte mich schon ... aber gut, dein simpler Test bestätigt es ja, dass dies ein immerwährender bug ist ... wobei das mit dem Punkt nach dem Fragezeichen zusammenhängen muss, denn in anderen Positionen kann ich das Phänomen nicht produzieren.

greetz André

... ob das in dem anderen Thread dann so funktioniert ... ??.??.????.doc ... ich bin gespannt, der TE gibt ja kein Feedback
edit: ??.??.????.doc findet auch Dateien mit 9.3.11.doc ... also nicht nur eine Stelle, sondern sogar mehrere Stellen weniger als angegeben ...
rubberman
rubberman 08.07.2011 um 19:42:33 Uhr
Goto Top
Hallo Friemler.

Da hast du eine Menge Hirnschmalz reingesteckt. Vermutlich einfacher wäre die Verwendung von Regulären Ausdrücken gewesen.
Diese (nur ansatzweise getestete) Funktion sollte es eigentlich schon tun:
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

Grüße
rubberman

<Edit: byVal ergänzt />
Friemler
Friemler 08.07.2011 um 20:27:11 Uhr
Goto Top
Moin rubberman,

das mit den Regulären Ausdrücken war auch zuerst meine Idee. Dabei war mir natürlich auch das Problem der zu maskierenden Metazeichen eingefallen. Ich hätte allerdings gründlicher darüber nachdenken sollen (so gründlich, wie beim Entwurf meines Algorithmus' face-wink ), denn ich hatte mir die Sache aufwändiger vorgestellt.

Aber gut, jetzt haben wir schon zwei Lösungen für das Problem face-smile . Allerdings muss strPattern ByVal übergeben oder einer funktionsinternen Hilfsvariable zugewiesen werden (besser), mit der dann weitergearbeitet wird, sonst wird der String des Aufrufers durch die Funktion verändert, was bei mehrmaligem Aufruf zu einem immer länger werdenden Pattern und einer Fehlfunktion führt.

Hier wäre dann noch die dritte Lösung, die ich in meiner Antwort auf Timo's Posting schon angesprochen hatte: Das Ausführen eines DIR-Befehls aus VBS heraus und parsen von dessen Ausgabe. Ich denke dann wären wir komplett face-wink . Aber Deine Lösung ist natürlich die kürzeste und birgt keine Gefahr eines Stacküberlaufs wegen zu tiefer Rekursion (zumindest wenn man sich da auf den Windows Script Host verlassen kann - BTW: Haben die Redmonder den eigentlich selbst geschrieben oder wie so manches andere in Windows, was gut funktioniert, zugekauft? face-wink ).

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

Die Zeilen 1 bis 34 sind wieder Beispielcode zur Anwendung der Klasse.

Die Methode GetFSItems liefert ein Array mit den vollständigen Pfaden aller auf die Maske passenden Dateien bzw. Verzeichnisse. Was gesucht werden soll (Dateien oder Verzeichnisse) wird durch den dritten Parameter intKind bestimmt. Ob Dateien/Verzeichnisse mit den Attributen Hidden bzw. System gefunden werden sollen, kann mit dem zweiten Parameter strAttrib ausgewählt werden.

Gruß
Friemler


PS:
Da fällt mir gerade aber noch ein, dass es bei dieser Methode wahrscheinlich zu fehlerhaften Ausgaben von Umlauten äöüß und anderen Zeichen kommt, die in ANSI und ASCII verschieden codiert sind. Na ja, dann ist es halt keine Methode sondern ein Konzept face-wink .
rubberman
rubberman 08.07.2011 um 22:05:53 Uhr
Goto Top
Hallo Friemler.

Zitat von @Friemler:
Allerdings muss strPattern ByVal übergeben
oder einer funktionsinternen Hilfsvariable zugewiesen werden (besser), mit der dann weitergearbeitet wird


ByVal ist die bessere Variante, da auch eine Hilfsvariable global vordefiniert sein könnte und somit verändert würde.
Danke für den Hinweis, ich ändere oben.

Grüße
rubberman

PS:
Zitat von @Friemler:
eigentlich ist es egal.

d'accord face-wink
Friemler
Friemler 08.07.2011 um 22:17:12 Uhr
Goto Top
Hallo rubberman,

Zitat von @rubberman:
ByVal ist die bessere Variante, da auch eine Hilfsvariable global vordefiniert sein könnte und somit verändert würde.

wenn die Hilfsvariable mit einer DIM-Anweisung lokal deklariert wird, kann ruhig eine gleichnamige globale Variable vorhanden sein.

Bei der Übergabe mit ByVal muss ja der ganze Stringinhalt beim Aufruf auf den Stack geschaufelt werden. Nicht so performant.
[EDIT]
Bei einer lokalen Hilfsvariable wird der Inhalt von strPattern bei der Zuweisung auch auf den Stack geschaufelt, eigentlich ist es egal.
[/EDIT]

Gruß
Friemler