Dateisuche nach *.ext findet auch *.ext2

  • VB6

Es gibt 2 Antworten in diesem Thema. Der letzte Beitrag () ist von Marcus Gräfe.

    Dateisuche nach *.ext findet auch *.ext2

    Ja, VB6. ;)

    Ich suche in meinem Programm nach allen Dateien in einem bestimmten Ordner, die eine definierte Dateiendung haben (in meinem Fall *.mdf). Leider findet die Routine auch alle Dateien, die die Endung *.mdf2 haben.

    Leider weiß ich einfach nicht, warum das so ist. In meinen Augen ist mein Code korrekt. Ich verwende die Standard-Windows-API dafür.

    Hier die relevanten Teile:

    Public Function FindFile (...)

    Visual Basic-Quellcode

    1. Public Function FindFile(ByVal StartPath As String, _
    2. ByVal SearchSubfolder As Boolean, _
    3. ByVal file As String, _
    4. ByRef FileFound() As Datei)
    6. ' Suchroutine: Wildcards sind erlaubt (*.*, ?, ect.)
    8. Dim hFile As Long
    9. Dim FileData As WIN32_FIND_DATA
    10. Dim Directories() As String
    11. Dim OnlyDirectories As Boolean
    12. Dim TmpFile As String
    13. Dim i As Integer
    15. DoEvents
    17. ' Evtl. Backslash entfernen
    18. If Right$(StartPath, 1) = "\" Then _
    19. StartPath = Left$(StartPath, Len(StartPath) - 1)
    21. SearchOnlySubfolders:
    23. ' Sucht nach einer Datei, und packt das
    24. ' Ergebnis in FileData
    25. hFile = FindFirstFile(StartPath & "\" & file & _
    26. vbNullChar, FileData)
    28. ' Wenn sie gefunden wurde, dann...
    29. If hFile <> INVALID_HANDLE_VALUE Then
    31. Do
    32. ' Ist es ein Verzeichniss oder eine Datei ?
    33. With FileData
    34. If (.dwFileAttributes And vbDirectory) = 0 Then
    35. ' Datei
    37. ' Nur wenn nicht nur Verzeichinsse gesucht werden
    38. If Not OnlyDirectories Then
    39. ' Array vergrößern und Daten ins Array schreiben
    40. On Local Error GoTo Err_DimFile
    41. ReDim Preserve FileFound(UBound(FileFound) + 1)
    42. On Local Error GoTo 0
    44. DoEvents
    45. UmPacken FileFound(UBound(FileFound)), _
    46. FileData, StartPath & "\" & file
    48. End If
    50. ElseIf SearchSubfolder = True Then
    51. ' Verzeichnis
    53. ' Verzeichnis nur im Array Speichern wenn es
    54. ' über dem jetzigen liegt d.h. ".." "." sind
    55. ' nicht gültig
    56. If Left$(.cFileName, InStr(.cFileName, vbNullChar) - 1) <> "." _
    57. And Left$(.cFileName, InStr(.cFileName, vbNullChar) - 1) <> ".." Then
    59. On Local Error GoTo Err_DimDir
    60. ReDim Preserve Directories(UBound(Directories) + 1)
    61. On Local Error GoTo 0
    63. ' Verzeichnis dem Array hinzufügen
    64. Directories(UBound(Directories)) = _
    65. Left$(.cFileName, InStr(.cFileName, vbNullChar) - 1)
    66. End If
    68. End If
    69. End With
    70. DoEvents
    71. Loop Until FindNextFile(hFile, FileData) = 0
    72. End If
    73. FindClose hFile
    75. ' Unteroder durchsuchen
    76. On Local Error GoTo Err_DimDir
    77. If SearchSubfolder = False Then Exit Function
    78. On Local Error GoTo 0
    80. ' Wenn nach anderen Dateien als *.* gesucht wird,
    81. ' werden keine Ordner gefunden
    82. ' Deshalb noch einmal gezielt nach Ordnern suchen
    83. If Not OnlyDirectories And SearchSubfolder = True And file <> "*.*" Then
    84. OnlyDirectories = True
    85. TmpFile = file
    86. file = "*.*"
    87. GoTo SearchOnlySubfolders
    88. ElseIf TmpFile <> vbNullString Then
    89. file = TmpFile
    90. End If
    92. On Local Error GoTo Err_Exit
    93. For i = 0 To UBound(Directories)
    94. DoEvents
    96. ' Hier ruft die Funktion sich selbst auf - für
    97. ' jeden Unterordner
    98. FindFile StartPath & "\" & Directories(i), _
    99. SearchSubfolder, file, FileFound
    100. Next i
    101. Exit Function
    103. Err_DimFile:
    104. ReDim FileFound(0)
    105. Resume Next
    107. Err_DimDir:
    108. ReDim Directories(0)
    109. Resume Next
    111. Err_Exit:
    112. End Function


    Aufgerufen wird die Suche so:

    Visual Basic-Quellcode

    1. '[...]
    2. Private Const FileExt As String = ".mdf"
    3. '[...]
    4. Public Type Datei
    5. Pfadname As String
    6. DosDateiname As String
    7. Dateiname As String
    8. ErstelltAM As FILETIME
    9. LetzterZugriff As FILETIME
    10. LetzeÄnderung As FILETIME
    11. DateiGröße As Long
    12. Atribute As Long
    13. End Type
    14. '[...]
    15. Dim FileList() As Datei
    16. '[...]
    18. ' SUCHE STARTEN
    19. FindFile AppPath & "MaterialData", False, "*" & FileExt, FileList


    Bei meiner Recherche bin ich auf folgende Seite gestoßen, die aber vmtl. ein ganz anderes Problem bebandelt (oder doch dasselbe?):
    codeguru.com/cpp/w-p/files/art…recated-DOS-Wildcards.htm

    Hat jemand eine Idee? Liegt es an meinem Code oder an der Windows-API?
    Besucht auch mein anderes Forum:
    Das Amateurfilm-Forum

    Ich vermute, dass du genau auf den verlinkten Bug gestoßen bist. Abhilfe steht auch drunter: 8.3-Dateinamen deaktivieren. Falls das nicht geht (weil der Rechner einem Kunden gehört, etc.): Nimm die Dateiliste, wie sie ist und filtere sie nochmal manuell mit dem Like-Operator. Das könntest du in der Funktion "UmPacken" machen, wo die Liste vmtl. sowieso komplett durchlaufen wird.
    Gruß
    hal2000

    Es handelt sich schon um meinen PC, allerdings würde mir das Deaktivieren der 8.3-Dateinamen nichts bringen, weil es dann nur bei mir geht. Das Programm wird aber an andere Personen gehen und dort muss es natürlich auch laufen.

    Aber dein Tipp war gut, ich frage nun das Suchergebnis (die Dateiliste) am Ende, bevor dieses verwendet wird, nochmal erneut ab (Beispiel):

    Visual Basic-Quellcode

    1. For i = 0 To u
    2. If FileList(i).Dateiname Like "*" & FileExt Then ' Dieses IF ist neu!
    3. .AddItem Replace$(FileList(i).Dateiname, FileExt, vbNullString)
    4. .ItemData(.ListCount - 1) = -3
    5. End If
    6. Next i

    Danke! :)
    Besucht auch mein anderes Forum:
    Das Amateurfilm-Forum