Tipp-Upload: VB.NET 0285: Erweiterte Informationen über Verzeichnisse
von ChristianM
Hinweis zum Tippvorschlag
Dieser Vorschlag wurde noch nicht auf Sinn und Inhalt überprüft und die Zip-Datei wurde noch nicht auf schädlichen Inhalt hin untersucht.
Bitte haben Sie ein wenig Geduld, bis die Freigabe erfolgt.
Über den Tipp
Dieser Tippvorschlag ist noch unbewertet.
Der Vorschlag ist in den folgenden Kategorien zu finden:
- Algorithmen
- Dateien und Laufwerke
Dem Tippvorschlag wurden folgende Schlüsselwörter zugeordnet:
Verzeichniss, Rekursion, Größe, Datei, file, dir
Der Vorschlag wurde erstellt am: 26.06.2008 16:56.
Die letzte Aktualisierung erfolgte am 15.07.2008 16:04.
Beschreibung
Mit den Objekten DirectoryInfo und FileInfo kann man viele wichtige Informationen auslesen.
Drei nicht so unwichtige Dinge fehlen aber, die der Windows Explorer anbietet:
- Anzahl aller Ordner eines Verzeichnisses (und Unterordner)
- Anzahl aller Dateien in einen Verzeichnis (und Unterordner)
- Größe eines Verzeichnisses
Merkmale:
1) Anwendung, die genau diese Informationen ermittelt.
2) die Zusatzinformationen werden in einem eigen Thread ermittelt
3) auf Wunsch werden die Fehler ausgegeben
4) Format: Die Byte Anzahl wird passend umgerechnet (KB, MB, GB, TB) und als String ausgegeben.
5) Ausführliche XML-Kommentare, die daher auch im Objektbrowser sichtbar sind.
|
Schwierigkeitsgrad
|
Verwendete API-Aufrufe: |
Download: |
' Dieser Source stammt von http://www.activevb.de ' und kann frei verwendet werden. Für eventuelle Schäden ' wird nicht gehaftet. ' Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum. ' Ansonsten viel Spaß und Erfolg mit diesem Source! ' ' Beachten Sie, das vom Designer generierter Code hier ausgeblendet wird. ' In den Zip-Dateien ist er jedoch zu finden. ' ----------- Anfang Projektdatei DirInfoW.vbproj ----------- ' ---------- Anfang Datei DirectoryInfoExtended.vb ---------- Imports System.IO ''' <summary> ''' Mit dieser Klasse können sie Informationen ''' zu einem Ordner ermittelen, die sie über ''' ein DirectoryInfo Objekt nicht abrufen können. ''' </summary> ''' <remarks></remarks> Public Class DirectoryInfoExtended ' Interne Variablen zur Speicherung ' Rufen sie den Wert über die ' entsprechende Eigenschaft ab. Private m_Directory As DirectoryInfo Private m_Initalized As Boolean Private m_ThrowErrors As Boolean Private m_DirCount As Long Private m_FileCount As Long Private m_FullSize As Long ''' <summary> ''' Gibt den zu verarbeitenden Ordner als ''' Directory-Info Objekt zurück. ''' </summary> Public ReadOnly Property Directory() As DirectoryInfo Get Return m_Directory End Get End Property ''' <summary> ''' Diese Eigenschaft gibt an, ob die zusätzlichen ''' Informationen bereit ermittelt wurden. ''' </summary> Public ReadOnly Property Initalized() As Boolean Get Return m_Initalized End Get End Property ''' <summary> ''' Diese Eigenschaft gibt an, ob auftretende ''' Exception abgefeuert werden sollen oder nicht. ''' </summary> ''' <remarks>UnauthorizedAccessException werden ''' immer abgefangen.</remarks> Public ReadOnly Property ThrowErrors() As Boolean Get Return m_ThrowErrors End Get End Property ''' <summary> ''' Diese Eigenschaft gibt an, wie viele Ordner, der ''' in Directory angebene Ordner enthält. ''' </summary> ''' <remarks>Liegen die Informationen noch nicht vor ''' gibt die Eigenschaft '-1' zurück.</remarks> Public ReadOnly Property DirCount() As Long Get Return m_DirCount End Get End Property ''' <summary> ''' Diese Eigenschaft gibt an, wie viele Dateien, der ''' in Directory angebene Ordner enthält. ''' </summary> ''' <remarks>Liegen die Informationen noch nicht vor ''' gibt die Eigenschaft '-1' zurück.</remarks> ReadOnly Property FileCount() As Long Get Return m_FileCount End Get End Property ''' <summary> ''' Diese Eigenschaft gibt an, wie groß alle Dateien ''' sind, die der in Directory angebene Ordner enthält. ''' </summary> ''' <remarks>Liegen die Informationen noch nicht vor ''' gibt die Eigenschaft '-1' zurück. Die Funktion ''' addiert die Dateigrößen, der tatsächliche Speicherbedarf ''' kann allerdings größer oder kleiner sein.</remarks> Public ReadOnly Property FullSize() As Long Get Return m_FullSize End Get End Property ''' <summary> ''' Erstellt eine neue Instanz, die Informationen ''' zu einem Ordner ermittelen, welche sie über ''' ein DirectoryInfo Objekt nicht abrufen können. ''' </summary> ''' <param name="Dir">Der zu verarbeitende Ordner</param> ''' <param name="Synchron">Gibt an, ob die Informationen ''' im gleichen Thread (synchron) oder in einem eigenen ''' Thread (asynchron) ermittelt werden sollen.</param> ''' <param name="ThrowErr">Gibt an, ob auftretende ''' Exception abgefeuert werden sollen oder nicht.</param> ''' <remarks>Sollten sie einen asynchronen Aufruf wählen, ''' können sie über die Eigenschaft Initalized prüfen, ''' ob die Informationen bereits vorliegen.</remarks> Public Sub New(ByVal Dir As String, _ ByVal Synchron As Boolean, ByVal ThrowErr As Boolean) m_ThrowErrors = ThrowErr m_Directory = New DirectoryInfo(Dir) ' Ermittelt die erweiterten Informationen GetInfo(Synchron) End Sub ''' <summary> ''' Erstellt eine neue Instanz, die Informationen ''' zu einem Ordner ermittelen, welche sie über ''' ein DirectoryInfo Objekt nicht abrufen können. ''' </summary> ''' <param name="Dir">Der zu verarbeitende Ordner</param> ''' <param name="Synchron">Gibt an, ob die Informationen ''' im gleichen Thread (synchron) oder in einem eigenen ''' Thread (asynchron) ermittelt werden sollen.</param> ''' <param name="ThrowErr">Gibt an, ob auftretende ''' Exception abgefeuert werden sollen oder nicht.</param> ''' <remarks>Sollten sie einen asynchronen Aufruf wählen, ''' können sie über die Eigenschaft Initalized prüfen, ''' ob die Informationen bereits vorliegen.</remarks> Public Sub New(ByVal Dir As DirectoryInfo, _ ByVal Synchron As Boolean, ByVal ThrowErr As Boolean) m_ThrowErrors = ThrowErr m_Directory = Dir ' Ermittelt die erweiterten Informationen GetInfo(Synchron) End Sub ' Ermittelt Informationen zu einem Ordner, ' welche sie über ein DirectoryInfo Objekt nicht ' abrufen können. Private Sub GetInfo(ByVal Synchron As Boolean) ' Initalisierungsarbeiten m_DirCount = -1 m_FileCount = -1 m_FullSize = -1 m_Initalized = False ' Eine Delegate der die Funktion aufruft Dim caller As New AsyncFunctionCaller(AddressOf Calc) If Synchron Then ' Normaler Aufruf mittles Delegate ' Rückgabe der Funktion wird gespeichert Dim result As Info = caller.Invoke(m_Directory, True) ' Informationen eintragen m_DirCount = result.DirCount m_FileCount = result.FileCount m_FullSize = result.FullSize Else ' Asynchroner Aufruf mit Speicherung der Rückgabe ' Übergabe der Parameter für die eigentliche Funktion ' Übergabe einer Rückrufmethode caller.BeginInvoke(m_Directory, True, AddressOf CallbackMethod, caller) End If End Sub ''' <summary> ''' Dieser Delegate dient zum Aufruf (synchron / ''' asynchron) der Informationsermittlung. ''' </summary> ''' <param name="Start">Der zu verarbeitende Ordner</param> ''' <param name="SubDirs">Gibt an, ob Unterordner ''' berücksichtigt werden sollen.</param> Private Delegate Function AsyncFunctionCaller(ByVal Start As IO.DirectoryInfo, ByVal _ SubDirs As Boolean) As Info ''' <summary> ''' Dieses Ereignis tritt auf, sobald die erweiterten ''' Informationen ermittelt wurden. Initalized gibt daher ''' True zurück. ''' </summary> ''' <param name="ExtDirInfo">Der Ordner zu dem die ''' erweiterten Informationen ermittelt wurden.</param> ''' <remarks><paramref name="ExtDirInfo"/> verweist auf ''' die Instanz für die die erweiterten Informationen ''' ermittelt wurden. Das ist vor allem bei mehreren ''' Instanzen hilfreich. Das Ereignis wird nur bei ''' Beendigung nach einem asynchronen Aufruf ausgelöst. ''' </remarks> Public Event InitalizingFinished(ByVal ExtDirInfo As DirectoryInfoExtended) ''' <summary> ''' Diese Funktion wird automatisch aufgerufen ''' nachdem der Aufruf zur Informationsermittlung ''' abgeschlossen wurde und dient zur Auswertung ''' der Informationen und dem Auslösen der Ereignisse. ''' </summary> ''' <param name="ar">Standardmäßiger Parameter einer ''' so genannten CallBack-Funktion</param> Private Sub CallbackMethod(ByVal ar As IAsyncResult) ' Notwendig damit der asynchrone Aufruf ' beendet wird und das Ergebnis abgerufen ' werden kann Dim caller As AsyncFunctionCaller = CType(ar.AsyncState, AsyncFunctionCaller) Dim result As Info = caller.EndInvoke(ar) ' Informationen eintragen m_DirCount = result.DirCount m_FileCount = result.FileCount m_FullSize = result.FullSize ' Arbeit beendet ' Das dem Benutzer mitteilen m_Initalized = True RaiseEvent InitalizingFinished(Me) End Sub ' Interne Funktion zur Informationsermittlung ' zu einem Ordner (erledigt die eigentliche Arbeit). ' Funktion ist rekursiv um die erweiterten ' Informationen gegenfalls über Unterordner zu ermitteln. Private Function Calc(ByVal Start As IO.DirectoryInfo, _ Optional ByVal SubDirs As Boolean = True) As Info Try ' Zum For ... Each aller Ordner ' Funktion 'GetDirectories' muss nur einmal ' aufgerufen werden Dim dirs() As IO.DirectoryInfo = Start.GetDirectories Dim dir As IO.DirectoryInfo ' Zum For ... Each aller Dateien ' Funktion 'GetFiles' muss nur einmal ' aufgerufen werden Dim files() As IO.FileInfo = Start.GetFiles Dim file As IO.FileInfo ' Anzahl der Unterordner ermitteln und speichern Dim c_Dir As Long = dirs.GetLength(0) ' Anzahl der Dateien ermitteln und speichern Dim c_File As Long = files.GetLength(0) ' Die Größe aller Dateien speichern Dim c_Size As Long For Each file In files c_Size += file.Length Next ' Temporäre Speicherung um Unterordner ' addieren zu können Dim temp As Info = New Info(c_Dir, c_File, c_Size) ' Eventuell Unterordner berücksichtigen If SubDirs Then For Each dir In dirs ' Jeden Unterordner durchlaufen und ' ebenfalls enumerieren (Rekursion !) temp += Calc(dir, SubDirs) Next End If ' Rückgabe Return temp Catch ex As System.UnauthorizedAccessException ' Dieser Error soll abgefangen werden Catch ex As System.IO.DirectoryNotFoundException ' Der Error wird abgefangen aber bei Bedarf ' gefeuert. If m_ThrowErrors Then Throw ex Catch ex As System.IO.DriveNotFoundException ' Der Error wird abgefangen aber bei Bedarf ' gefeuert. If m_ThrowErrors Then Throw ex Catch ex As System.IO.FileNotFoundException ' Der Error wird abgefangen aber bei Bedarf ' gefeuert. If m_ThrowErrors Then Throw ex End Try End Function ' Mit dieser Struktur können alle erweiterten ' Informationen an die aufrufende Funktion ' zurückgegeben werden. Da die Struktur nur ' internen Zwecken dient, wurde verzichtet ' Variablen als Privat zu deklarieren und ' durch eine Eigenschaft zugägnlich zu machen. Private Structure Info ' Die Anzahl der enthaltenen Ordner Public DirCount As Long ' Die Anzahl der enthaltenen Dateien Public FileCount As Long ' Die Größe der enthaltenen Dateien Public FullSize As Long ' Hiermit können sie eine neue ' Instanz der Struktur erstellen und sofort ' alle Informationen initalisieren. Sub New(ByVal p_DirCount As Long, _ ByVal p_FileCount As Long, _ ByVal p_FullSize As Long) Me.DirCount = p_DirCount Me.FileCount = p_FileCount Me.FullSize = p_FullSize End Sub ''' <summary> ''' Diese Funktion addiert zwei Strukturen ''' und gibt die Summe aus <paramref name="d1"/> ''' und <paramref name=" d2"/> zurück. ''' </summary> ''' <param name="d1">Die erste Struktur ''' des Additionsvorgangs</param> ''' <param name="d2">Die zweite Struktur ''' des Additionsvorgangs</param> ''' <remarks>Diese Funktion dient dem so ''' genannten Operator Overloading. Somit ''' können mehrere Ordner ohne größere ''' Umwege direkt zusammengefasst werden.</remarks> Shared Operator +(ByVal d1 As Info, ByVal d2 As Info) As Info Return New Info(d1.DirCount + d2.DirCount, d1.FileCount + d2.FileCount, _ d1.FullSize + d2.FullSize) End Operator End Structure End Class ' ----------- Ende Datei DirectoryInfoExtended.vb ----------- ' ------------------ Anfang Datei Format.vb ------------------ ''' <summary> ''' Diese Klasse enthält Methoden zur ''' Formatierung von Verzeichnisinformationen. ''' </summary> ''' <remarks>Diese Klasse enthält nur Shared-Member.</remarks> Public Class Format ''' <summary> ''' Diese Funktion wandelt eine Byteangabe in eine ''' geeignete Einheit um und formatiert sie. ''' </summary> ''' <param name="Bytes">Die Anzahl der Bytes</param> ''' <returns>Ein String der <paramref name="Bytes"/> ''' in die passende Einheit umgewandelt hat.</returns> ''' <remarks>Die Angabe erfolgt auf 2 Dezimalstellen ''' genau. Die ursprüngliche Anzahl an Bytes wird ''' zusätzlich in Klammern zurückgegeben.</remarks> Shared Function FormatSize(ByVal Bytes As Long) As String Dim tmp As Double = Bytes If tmp >= 1000 Then tmp = tmp / 1024 If tmp >= 1000 Then tmp = tmp / 1024 If tmp >= 1000 Then tmp = tmp / 1024 If tmp >= 1000 Then tmp = tmp / 1024 Return tmp.ToString("#,##0.00") & " TB (" & Bytes.ToString( _ "#,###") & " Bytes)" Else Return tmp.ToString("#,##0.00") & " GB (" & Bytes.ToString( _ "#,###") & " Bytes)" End If Else Return tmp.ToString("#,##0.00") & " MB (" & Bytes.ToString("#,###") & " Bytes)" End If Else Return tmp.ToString("#,##0.00") & " KB (" & Bytes.ToString("#,###") & " Bytes)" End If Else Return Bytes.ToString("#,### Bytes") End If End Function End Class ' ------------------- Ende Datei Format.vb ------------------- ' ---------------- Anfang Datei frmDirInfo.vb ---------------- Public Class frmDirInfo ' Damit Informationen zu einem Ordner nicht ' mehrmals ermittelt werden Private DirList As List(Of String) Private Sub frmDirInfo_Load(ByVal sender As Object, ByVal e As EventArgs) Handles Me.Load ' Initalisierungsarbeiten rtfDirInfo.Clear() lbStatus.Items.Clear() lbStatus.Items.Add("Bereit") DirList = New List(Of String) End Sub Private Sub lbStatus_SelectedIndexChanged(ByVal sender As Object, ByVal e As EventArgs) _ Handles lbStatus.SelectedIndexChanged ' Die aktuelle Auswahl abrufen Dim Str As String = lbStatus.Items.Item(lbStatus.SelectedIndex) ' Die Positionen für den Ordnerpfad abrufen ' Dieser ist in '"' eingeschlossen Dim f As Integer = Str.IndexOf(""""c) Dim l As Integer = Str.LastIndexOf(""""c) ' Wird eine Funktion nicht fündig --> beenden If f = -1 Or l = -1 Then Exit Sub ' Ordnerpfad extrahieren Str = Str.Substring(f + 1, l - f - 1) With rtfDirInfo ' Ordnerpfad in der RFF finden Dim start As Integer = .Find("Ordner: """ & Str & """") ' Und Markierung darauf setzten .Select(start, Str.Length + 10) .ScrollToCaret() .Focus() End With End Sub Private Sub cmdClear_Click(ByVal sender As Object, ByVal e As EventArgs) Handles cmdClear.Click ' Alles Zurücksetzen ' Informationen zu Ordner können damit ' wieder neu ermittelt werden rtfDirInfo.Clear() lbStatus.Items.Clear() lbStatus.Items.Add("Bereit") DirList.Clear() End Sub Private Sub cmdDir_Click(ByVal sender As Object, ByVal e As EventArgs) Handles cmdDir.Click ' Ordnerauswahl anzeigen Dim folderBrowserDLG As FolderBrowserDialog = Me.FolderBrowserDLG ' Klickt der Benutzer auf OK If (folderBrowserDLG.ShowDialog = DialogResult.OK) Then ' Auftrag verarbeiten NewDir(folderBrowserDLG.SelectedPath) End If End Sub Private Sub cmdEnd_Click(ByVal sender As Object, ByVal e As EventArgs) Handles cmdEnd.Click ' Programm beenden Me.Close() End Sub Private Sub NewDir(ByVal str As String) ' Existiert der Ordner If Directory.Exists(str) Then ' Wurden Informationen zum Ordner schon ermittelt If Not Me.DirList.Contains(str) Then ' Informationssammlung starten (asynchron !) Dim newItem As New DirectoryInfoExtended(str, False, False) ' Einen Ereignishandler für die Callback-Prozedur hinzufügen AddHandler newItem.InitalizingFinished, AddressOf EventFinished ' Der Hilfsliste hinzufügen DirList.Add(str) ' Den Ordnerpfad und normale Informationen ' ermitteln und in RTF eintragen Dim info As String info = "Attribute: " & newItem.Directory.Attributes.ToString & vbNewLine & _ "Erstellt am: " & newItem.Directory.CreationTime & vbNewLine & _ "Letzter Zugriff am: " & newItem.Directory.LastAccessTime & vbNewLine & _ "Letzte Änderug am: " & newItem.Directory.LastWriteTime AddText(str, info) ' Status setzen auf 'laden' lbStatus.Items.Add("Lade """ & str & """ ...") Else ' Schon einmal ausgewählt With rtfDirInfo ' Ordnerpfad in der RFF finden Dim start As Integer = .Find("Ordner: """ & str & """") ' Und Markierung darauf setzten .Select(start, str.Length + 10) .ScrollToCaret() .Focus() End With End If Else ' Status setzen auf 'nicht vorhanden' lbStatus.Items.Add("""" & str & """ ungültig") End If End Sub ' Fügt der RTF einen Ordner hinzu ' dir: der Ordner ' str: die Informationen Private Sub AddText(ByVal dir As String, ByVal str As String) ' Zur späteren Formatierung muss der Text ' markiert werden ' Beginn der Markierung (aktuelles Ende der RTF) Dim textLength As Integer = rtfDirInfo.TextLength ' Länge der Markierung Dim length As Integer = dir.Length + 11 With rtfDirInfo ' Ordner einfügen .AppendText("Ordner: """ & dir & """" & vbNewLine) ' Markierung setzen .Select(textLength, length) ' Schriftart und Schriftfarbe setzen .SelectionFont = New Font(Me.rtfDirInfo.Font, FontStyle.Bold) .SelectionColor = Color.Red ' keine Aufzählung .SelectionBullet = False .SelectionIndent = 0 ' Markierung entfernen ' Einstellungen gelten sonst für weiteren Text! .Select(0, 0) ' Markierungsdaten aktualisieren textLength = rtfDirInfo.TextLength length = str.Length ' Informationen einfügen .AppendText(str & vbNewLine) ' Markierung setzen .Select(textLength, length) ' Schriftart und Schriftfarbe setzen .SelectionFont = New Font(Me.rtfDirInfo.Font, FontStyle.Regular) .SelectionColor = Color.Black ' keine Aufzählung .SelectionBullet = True .SelectionIndent = 10 ' Markierung entfernen ' Einstellungen gelten sonst für weiteren Text! .Select(0, 0) End With End Sub ' Fügt der RTF Informationen zu einem Ordner hinzu ' dir: der Ordner ' str: die Informationen Private Sub InsertText(ByVal dir As String, ByVal str As String) With rtfDirInfo ' Sucht den Ordner Dim start As Integer = ((.Find("""" & dir & """") + dir.Length) + 3) ' Markiert das Zeilenendzeichen .Select(start, 0) ' Ersetzt es durch die zusätzlichen Informationen .SelectedText = (str & vbNewLine) ' Schriftart und Schriftfarbe setzen .SelectionFont = New Font(Me.rtfDirInfo.Font, FontStyle.Regular) .SelectionColor = Color.Black ' Aufzählungseigenschaften setzen .SelectionBullet = True .SelectionIndent = 10 ' Markierung entfernen ' Einstellungen gelten sonst für weiteren Text! .Select(0, 0) End With End Sub Private Delegate Sub EventDelegate(ByVal ExtDirInfo As DirectoryInfoExtended) ' Eventhandler für das Ereignis der Klasse ' wenn alle Informationen ermittelt wurden Private Sub EventFinished(ByVal ExtDirInfo As DirectoryInfoExtended) ' Kommt aus anderem Thread daher Invoke nötig ' Prüfung If rtfDirInfo.InvokeRequired Then ' Invoke --> Funktion gelangt in anderen Thread rtfDirInfo.Invoke(New EventDelegate(AddressOf Me.EventFinished), ExtDirInfo) Else ' Eigentlicher Code ' Erweiterte Informationen ermitteln und in RTF eintragen Dim str As String = "Enthaltene Ordner: " & ExtDirInfo.DirCount & vbNewLine & _ "Enthaltene Dateien: " & ExtDirInfo.FileCount & vbNewLine & "Größe: " & _ Format.FormatSize(ExtDirInfo.FullSize) InsertText(ExtDirInfo.Directory.FullName, str) ' Status setzen auf 'geladen' lbStatus.Items.Add("Fertig """ & ExtDirInfo.Directory.FullName & """") End If End Sub End Class ' ----------------- Ende Datei frmDirInfo.vb ----------------- ' ------------ Ende Projektdatei DirInfoW.vbproj ------------
Diskussion
Diese Funktion ermöglicht es, Fragen, die die Veröffentlichung des Tipps betreffen, zu klären, oder Anregungen und Verbesserungsvorschläge einzubringen. Nach der Veröffentlichung des Tipps werden diese Beiträge nicht weiter verlinkt. Allgemeine Fragen zum Inhalt sollten daher hier nicht geklärt werden.
Folgende Diskussionen existieren bereits
Um eine Diskussion eröffnen zu können, müssen sie angemeldet sein.