Klasse für Dateisuche

Option Compare Text

Imports System.IO
Imports System.Text
Imports System.Security.Cryptography

''' <summary>
''' Mit dieser Klasse können Sie auf einem lokalen Computer nach Dateien suchen.
''' Dazu stehen Ihnen eine Vielzahl an Filtern mit der man die Suche präzise an seine Bedürfnisse anpassen kann.
''' </summary>
''' <remarks>
''' Sie können diese Klasse frei verwenden auch in kommerziellen Programmen.
''' Ich bitte Sie lediglich um einen Hinweis über diese Klasse und dem Autor in Ihrem Programm (z.B. Info-Dialog)
''' Kontakt: khartak@freenet.de
''' Copyright © 2006 Tim Hartwig
''' </remarks>
Public Class FileSearch
    Private FolderSize As Long = 0
    Private ErrorLog As New System.Text.StringBuilder
    Private CRC32Table() As Integer
    Private AbortProgress As Boolean

    Private mRaiseErrors As Boolean

#Region "Properties"
    ''' <summary>
    ''' Gibt an ob das Event für Fehlermeldungen bei einem Fehler aufgerufen werden soll.
    ''' In den meisten fällen tritt ein Fehler auf wenn versucht wird z.B.
    ''' den Ordner "System Volume Information" zu öffnen etc.
    ''' </summary>
    Public Property RaiseErrors() As Boolean
        Get
            RaiseErrors = mRaiseErrors
        End Get
        Set(ByVal Value As Boolean)
            mRaiseErrors = Value
        End Set
    End Property
#End Region

#Region "Events"
    ''' <summary>
    ''' Wird aufgerufen wenn eine Datei gültige gefunden wurde.
    ''' </summary>
    ''' <param name="FileName">Der Dateiname mit kompletten Pfad</param>
    Public Event MatchFound(ByVal sender As Object, ByVal FileName As String)

    ''' <summary>
    ''' Wird aufgerufen wenn ein Fehler auftritt z.B. ein verweigerter Zugriff auf einen Ordner etc.
    ''' </summary>
    ''' <param name="ErrorMessage">Die Fehlernachricht</param>
    Public Event RaiseError(ByVal sender As Object, ByVal ErrorMessage As String)

    ''' <summary>
    ''' Wird aufgerufen wenn der Suchvorgang vollständig ist
    ''' </summary>
    ''' <remarks></remarks>
    Public Event SearchComplete(ByVal sender As Object)
#End Region

#Region "Public Methods"
#Region "[Search] = SUCHFUNKTION -> Dateisuche mit Filter"
    ''' <summary>
    ''' Diese Funktion sucht nach bestimmten Dateien
    ''' </summary>
    ''' <param name="Root">Der Ordner in dem gesucht werden soll</param>
    ''' <param name="SearchWord">Ein Optionales Suchwort</param>
    ''' <param name="Filter">Der Filter für die Suche</param>
    ''' <param name="FileArray">Das Array in der die gefundenen Dateien und/oder Ordner kommen</param>
    Public Sub Search(ByVal Root As String, ByVal SearchWord As String, ByVal Filter As SearchFilter, ByRef FileArray As List(Of String))
        ErrorLog.Remove(0, ErrorLog.Length)
        AbortProgress = False
        DoSearch(Root, SearchWord, Filter, FileArray)
        AbortProgress = False
        RaiseEvent SearchComplete(Me)
    End Sub

    Private Sub DoSearch(ByVal Root As String, ByVal SearchWord As String, ByVal Filter As SearchFilter, ByRef FileArray As List(Of String))
        Try
            If AbortProgress = True Then Exit Sub
            My.Application.DoEvents()

            Dim Files() As String = System.IO.Directory.GetFiles(Root)
            Dim Folders() As String = System.IO.Directory.GetDirectories(Root)
            Dim Recurse As Boolean = True

            If Filter.Listing = SearchFilter.LO.BOTH Or Filter.Listing = SearchFilter.LO.FILES_ONLY Then
                For i As Integer = 0 To UBound(Files)
                    If FileFilter(Files(i).ToString, SearchWord, Filter) = True Then
                        FileArray.Add(Files(i).ToString)
                        RaiseEvent MatchFound(Me, Files(i))
                    End If
                Next
            End If

            For i As Integer = 0 To UBound(Folders)
                'Es wird schon hier geprüft ob der Ordner erlaubt ist, denn wenn der Filter
                'auf(FILES_ONLY) gestellt ist, wird der ausgeschlossene Ordner trotzdem geöffnet
                If AllowedFolder(Folders(i), Filter.ExcludeFolders) = False Then Recurse = False
                If Filter.Listing = SearchFilter.LO.BOTH Or Filter.Listing = SearchFilter.LO.FOLDERS_ONLY Then
                    If Recurse = True Then
                        FileArray.Add(Folders(i).ToString)
                        RaiseEvent MatchFound(Me, Folders(i))
                    End If
                End If
                If Recurse = True And Filter.NoSubFolders = False Then DoSearch(Folders(i), SearchWord, Filter, FileArray)
                Recurse = True
            Next
        Catch Ex As Exception
            'Hier werden die Fehler aufgefangen und in einem String geschrieben
            If mRaiseErrors = True Then
                ErrorLog.Append(Ex.Message & vbNewLine)
                RaiseEvent RaiseError(Me, Ex.Message)
            End If
        End Try
    End Sub
#End Region

#Region "[ListAll] = AUFLISTUNGSFUNKTION -> Auflistung von Dateien und Ordnern"
    ''' <summary>
    ''' Diese Funktion listet alle Dateien und/oder Ordner inklusive Unterordner auf und speichert diese in einem Array
    ''' </summary>
    ''' <param name="Root">Der Ordner in dem gesucht werden soll</param>
    ''' <param name="FileArray">Ein 0-basiertes Array in welchem die Suchergebnisse gespeichert werden sollen</param>
    ''' <param name="FFBFilter">Angabe ob nur alle Dateien oder nur alle Ordner oder beides aufgelistet werden soll</param>
    Public Sub ListAll(ByVal Root As String, ByRef FileArray As List(Of String), Optional ByVal FFBFilter As SearchFilter.LO = SearchFilter.LO.BOTH)
        ErrorLog.Remove(0, ErrorLog.Length)
        AbortProgress = False
        DoListAll(Root, FileArray, FFBFilter)
        AbortProgress = False
        RaiseEvent SearchComplete(Me)
    End Sub
    Private Sub DoListAll(ByVal Root As String, ByRef FileArray As List(Of String), Optional ByVal ListingOption As SearchFilter.LO = SearchFilter.LO.BOTH)
        Try
            If AbortProgress = True Then Exit Sub
            My.Application.DoEvents()
            Dim Files() As String = System.IO.Directory.GetFiles(Root)
            Dim Folders() As String = System.IO.Directory.GetDirectories(Root)

            If ListingOption = SearchFilter.LO.BOTH Or ListingOption = SearchFilter.LO.FILES_ONLY Then
                For i As Integer = 0 To UBound(Files)
                    FileArray.Add(Files(i).ToString)
                    RaiseEvent MatchFound(Me, Files(i))
                Next
            End If

            For i As Integer = 0 To UBound(Folders)
                If ListingOption = SearchFilter.LO.BOTH Or ListingOption = SearchFilter.LO.FOLDERS_ONLY Then
                    FileArray.Add(Folders(i).ToString)
                    RaiseEvent MatchFound(Me, Folders(i))
                End If
                DoListAll(Folders(i), FileArray, ListingOption)
            Next
        Catch Ex As Exception
            If mRaiseErrors = True Then
                ErrorLog.Append(Ex.Message & vbNewLine)
                RaiseEvent RaiseError(Me, Ex.Message)
            End If
        End Try
    End Sub
#End Region

#Region "[GetFolderSize] = Ordnergröße ermitteln"
    ''' <summary>
    ''' Diese Funktion berechnet die Größe eines Ordners
    ''' </summary>
    ''' <param name="Root">Der Ordner wessen größe berechnet werden soll</param>
    ''' <param name="SizeFormat">Angabe in welchem Format die Gesamtgröße zurückgegeben werden soll: GB,MB,KB,B</param>
    Public Function GetFolderSize(ByVal Root As String, ByVal SizeFormat As SearchFilter.ST) As Long
        Dim TmpSize As Long = 0
        FolderSize = 0
        ErrorLog.Remove(0, ErrorLog.Length)
        DoGetFolderSize(Root, SizeFormat)

        Select Case SizeFormat
            Case SearchFilter.ST.BYTES : FolderSize /= 1
            Case SearchFilter.ST.KILO_BYTES : FolderSize /= 1024
            Case SearchFilter.ST.MEGA_BYTES : FolderSize /= 1048576
            Case SearchFilter.ST.GIGA_BYTES : FolderSize /= 1073741824
        End Select

        Return FolderSize
    End Function
    Private Function DoGetFolderSize(ByVal Root As String, ByVal SizeFormat As SearchFilter.ST) As Long
        Try
            Dim Files() As String = System.IO.Directory.GetFiles(Root)
            Dim Folders() As String = System.IO.Directory.GetDirectories(Root)

            For i As Integer = 0 To UBound(Files)
                FolderSize += FileLen(Files(i))
            Next

            For i As Integer = 0 To UBound(Folders)
                DoGetFolderSize(Folders(i), SizeFormat)
            Next
        Catch Ex As Exception
            ErrorLog.Append(Ex.Message & vbNewLine)
            RaiseEvent RaiseError(Me, Ex.Message)
        End Try
    End Function
#End Region

    ''' <summary>
    ''' Bricht den Suchvorgang ab
    ''' </summary>
    ''' <remarks></remarks>
    Public Sub Abort()
        AbortProgress = True
    End Sub

    ''' <summary>
    ''' Diese Funktion gibt alle bei der Suche aufgetretenen Fehlermeldungen zurück
    ''' </summary>
    Public Function GetErrorLog() As String
        Return ErrorLog.ToString
    End Function

    ''' <summary>
    ''' Diese Funktion berechnet den CRC32 Hash einer Datei
    ''' </summary>
    Public Function GetCRC32(ByVal FileName As String) As String
        Dim FS As FileStream = New FileStream(FileName, FileMode.Open, FileAccess.Read, FileShare.Read, 8192)
        Dim CRC32Result As Integer = &HFFFFFFFF
        Dim Buffer(4096) As Byte
        Dim ReadSize As Integer = 4096
        Dim Count As Integer = FS.Read(Buffer, 0, ReadSize)
        Dim i As Integer, iLookup As Integer

        If CRC32Table.Length = 0 Then
            'CRC32 Tabelle erstellen
            CreateCRC32Table()
        End If

        Do While (Count > 0)
            For i = 0 To Count - 1
                iLookup = (CRC32Result And &HFF) Xor Buffer(i)
                CRC32Result = ((CRC32Result And &HFFFFFF00)  &H100) And &HFFFFFF
                CRC32Result = CRC32Result Xor CRC32Table(iLookup)
            Next i
            Count = FS.Read(Buffer, 0, ReadSize)
        Loop
        Return Hex(Not (CRC32Result))
    End Function

    ''' <summary>
    ''' Diese Funktion berechnet den MD5 Hash einer Datei
    ''' </summary>
    Public Function GetMD5(ByVal File As String) As String
        Dim FN As New FileStream(File, FileMode.Open, FileAccess.Read, FileShare.Read, 8192)
        Dim HashValue(0) As Byte
        Dim Result As String = ""
        Dim Tmp As String = ""

        Dim MD5 As New MD5CryptoServiceProvider
        MD5.ComputeHash(FN)
        HashValue = MD5.Hash

        FN.Close()

        For i As Integer = 0 To HashValue.Length - 1
            Tmp = Hex(HashValue(i))
            If Len(Tmp) = 1 Then Tmp = "0" & Tmp
            Result += Tmp
        Next
        Return Result
    End Function

    ''' <summary>
    ''' Diese Funktion berechnet den SHA1 Hash einer Datei
    ''' </summary>
    Public Function GetSHA(ByVal File As String) As String
        Dim FN As New FileStream(File, FileMode.Open, FileAccess.Read, FileShare.Read, 8192)
        Dim HashValue(0) As Byte
        Dim Result As String = ""
        Dim Tmp As String = ""

        Dim SHA1 As New SHA1CryptoServiceProvider
        SHA1.ComputeHash(FN)
        HashValue = SHA1.Hash

        FN.Close()

        For i As Integer = 0 To HashValue.Length - 1
            Tmp = Hex(HashValue(i))
            If Len(Tmp) = 1 Then Tmp = "0" & Tmp
            Result += Tmp
        Next
        Return Result
    End Function
#End Region

#Region "Private Methods"
    Private Function FileFilter(ByVal FileName As String, ByVal SearchWord As String, ByVal Filter As SearchFilter) As Boolean
        'Fastest First Slowest Last!
        Dim IsFileValid As Boolean = True
        Dim Extensions() As String
        Dim FileArray() As String

        If AbortProgress = True Then Exit Function

        'Wenn eine Suchwort angegeben wurde dann wird geguckt ob es sich überhaupt in der Datei
        'befindet, falls nicht wird direkt abgebrochen um nicht unnötig die Filter zu durchlaufen
        If SearchWord <> "" Then
            If InStr(FileName, SearchWord) = 0 Then Exit Function
        End If

        'ExcludeFiles
        If IsFileValid Then
            If Filter.ExcludeFiles <> "" Then
                FileArray = Split(Filter.ExcludeFiles, ",")
                For i As Integer = 0 To UBound(FileArray)
                    If InStr(FileArray(i), "") > 0 Then

Alte URL: /snippet/klasse-fuer-dateisuche/369