.NET bietet zahlreiche Optionen zum Kopieren, Verschieben und Löschen von Dateien und Ordner. Das häufig zeitaufwändige Operationen, die das eigene Programm blockieren. Diese Klasse nimmt solche Aufträge entgegen und verarbeitet sie asynchron. Die Verwaltung folgt ähnlich einer List-Klasse. Klasse clsFileSystemQueue Option Compare Text Option Explicit On Option Strict On Imports System.Collections Imports System.IO Public Class clsFileSystemQueue ' ************************************************************************ ' Die gespeicherten Kopieraufträge und deren Verwaltung ' ************************************************************************ Private m_List As New List(Of FSOrder) Private m_ActualOrder As FSOrder Public ReadOnly Property ActualOrder() As FSOrder Get Return m_ActualOrder End Get End Property Public Sub Clear() SyncLock CType(m_List, Collections.ICollection).SyncRoot m_List.Clear() End SyncLock End Sub Public Function Contains(ByVal item As FSOrder) As Boolean SyncLock CType(m_List, Collections.ICollection).SyncRoot Return m_List.Contains(item) End SyncLock End Function Public Function Remove(ByVal item As FSOrder) As Boolean SyncLock CType(m_List, Collections.ICollection).SyncRoot Return m_List.Remove(item) End SyncLock End Function Public Function RemoveAt(ByVal index As Integer) As Boolean Try SyncLock CType(m_List, Collections.ICollection).SyncRoot m_List.RemoveAt(index) End SyncLock Return True Catch ex As Exception Return False End Try End Function Public ReadOnly Property Count() As Integer Get SyncLock CType(m_List, Collections.ICollection).SyncRoot Return m_List.Count End SyncLock End Get End Property Public Function IndexOf(ByVal item As FSOrder) As Integer SyncLock CType(m_List, Collections.ICollection).SyncRoot Return m_List.IndexOf(item) End SyncLock End Function Public Property Item(ByVal index As Integer) As FSOrder Get Try SyncLock CType(m_List, Collections.ICollection).SyncRoot Return m_List.Item(index) End SyncLock Catch ex As Exception Return Nothing End Try End Get Set(ByVal value As FSOrder) Try SyncLock CType(m_List, Collections.ICollection).SyncRoot m_List.Item(index) = value End SyncLock Catch ex As Exception End Try End Set End Property ' ************************************************************************ ' Die Funktionen, die einen FileSystemOrder (Klasse) oder eine ' Auflistung davon entgegennimmt. ' ************************************************************************ Public Function Add(ByVal item As FSOrder) As FSOrder If item.IsInitalized Then SyncLock CType(m_List, Collections.ICollection).SyncRoot m_List.Add(item) End SyncLock Add = item If Not (m_IsWorking) And Not (m_IsCanceling) Then Work() Else Add = Nothing End If End Function Public Function AddRange(ByVal collection _ As Collections.Generic.IEnumerable(Of FSOrder) _ ) As Collections.Generic.IEnumerable(Of FSOrder) Dim Item As FSOrder Dim Range As New List(Of FSOrder) For Each Item In collection If Item.IsInitalized Then Range.Add(Item) End If Next SyncLock CType(m_List, Collections.ICollection).SyncRoot m_List.AddRange(Range) End SyncLock AddRange = Range If Not (m_IsWorking) And Not (m_IsCanceling) Then Work() End Function Public Function Insert(ByVal index As Integer, _ ByVal item As FSOrder) As FSOrder If item.IsInitalized Then Try SyncLock CType(m_List, Collections.ICollection).SyncRoot m_List.Insert(index, item) End SyncLock Return item Catch ex As Exception Return Nothing End Try Else Return Nothing End If End Function Public Function InsertRange(ByVal index As Integer, _ ByVal collection As Collections.Generic.IEnumerable(Of FSOrder) _ ) As Collections.Generic.IEnumerable(Of FSOrder) Dim Item As FSOrder Dim Range As New List(Of FSOrder) For Each Item In collection If Item.IsInitalized Then Range.Add(Item) End If Next Try SyncLock CType(m_List, Collections.ICollection).SyncRoot m_List.InsertRange(index, collection) End SyncLock Return Range Catch ex As Exception Return Nothing End Try End Function ' ************************************************************************ ' Die Einstellungen für das Überschreiben von vorhandenen Dateien ' ************************************************************************ Private m_Overwrite As Boolean = True Public Property OverWrite() As Boolean Get Return m_Overwrite End Get Set(ByVal value As Boolean) m_Overwrite = value End Set End Property ' ************************************************************************ ' Der Status ' ************************************************************************ Private m_IsWorking As Boolean = False Public ReadOnly Property IsWorking() As Boolean Get Return m_IsWorking End Get End Property ' ************************************************************************ ' Die Property für einen Abbruch ' ************************************************************************ Private m_IsCanceling As Boolean = False Public Property IsCanceling() As Boolean Get Return m_IsCanceling End Get Set(ByVal value As Boolean) ' Nur wenn gearbeitet wird und ein Abbruch erwünscht ist, ausführen! If m_IsWorking = True And value = True Then ' Cancel-Flag zur Sicherheit setzten m_IsCanceling = True End If End Set End Property Public Sub StartCanceling(ByVal Wait As Boolean) ' Abbruch-Flag setzen IsCanceling = True ' Auf Wunsh warten If Wait = True Then Me.WaitForFinish() End Sub ' ************************************************************************ ' Die Methode bietet ein Waithandle, um auf den Abschluss der Auträge ' zu warten ' ************************************************************************ Public Sub WaitForFinish() m_Waiter.WaitOne() End Sub ' ************************************************************************ ' Die Methoden zur Verarbeitung der Kopieraufträge und Überprüfung auf ' einen Abbruch bzw. Fehler. ' ************************************************************************ Private m_Waiter As Threading.ManualResetEvent Private Sub Work() 'Ein Abbruchbedingungs-Test mit dem Cancel-Flag If m_IsCanceling = True Then ' Aufräumarbeiten FinishWork() Else ' Prüfen, ob schon gearbeit wird If Not (m_IsWorking) Then ' Arbeit beginnen m_IsWorking = True m_Waiter.Reset() End If ' Arbeit fortsetzen ' Prüfen, ob noch Auträge vorhanden sind Dim t_Count As Integer SyncLock CType(m_List, Collections.ICollection).SyncRoot t_Count = m_List.Count End SyncLock ' Wenn ja Auftrag befinnen If t_Count > 0 Then AddOrder() Else ' Aufräumarbeiten FinishWork() End If End If End Sub Private Sub FinishWork() SyncLock CType(m_List, Collections.ICollection).SyncRoot m_List.Clear() End SyncLock m_ActualOrder = Nothing m_IsCanceling = False m_IsWorking = False m_Waiter.Set() End Sub ' ************************************************************************ ' Die Methode, die versucht einen Auftrag aus der Liste zu extrahieren ' und die passende Funktion asynchron aufzurufen. ' ************************************************************************ Private Sub AddOrder() Try Dim t_Result As IAsyncResult Dim t_Worker As ASyncCall ' Neuen Autrag holen und Property Setzen SyncLock CType(m_List, Collections.ICollection).SyncRoot m_ActualOrder = New FSOrder(m_List.Item(0), True) m_List.RemoveAt(0) End SyncLock ' Auftragstyp auswerten und Delegaten erzeugen Select Case m_ActualOrder.OrderType Case FSOrder.TypeOfOrder.Copy t_Worker = New ASyncCall(AddressOf Copy) Case FSOrder.TypeOfOrder.Move t_Worker = New ASyncCall(AddressOf Move) Case FSOrder.TypeOfOrder.Delete t_Worker = New ASyncCall(AddressOf Delete) Case Else t_Worker = Nothing End Select ' Ereigniss aufrufen Dim t_Status As FSOrder.OrderResultType If (Not IsNothing(m_frm)) AndAlso m_frm.InvokeRequired Then ' Invoking erforderlich? ' Delegat und Argument weitergeben m_frm.Invoke(New CallEventStart(AddressOf CallEventStartingOrder), _ m_ActualOrder, t_Status) Else ' sonst ' Delegat direkt ausführen RaiseEvent StartingOrder(m_ActualOrder, t_Status) End If ' Asynchron Aufrufen t_Result = t_Worker.BeginInvoke(t_Status, _ AddressOf Callback, t_Worker) Catch ex As Exception ' Fehler! m_IsCanceling = True End Try End Sub Private Sub Callback(ByVal ar As IAsyncResult) Dim t_Worker As ASyncCall = CType(ar.AsyncState, ASyncCall) ' Ergebniss abrufen Dim t_Result As FSOrder.OrderResultType = t_Worker.EndInvoke(ar) 'Ereignis auflösen If (Not IsNothing(m_frm)) AndAlso m_frm.InvokeRequired Then ' Invoking erforderlich? ' Delegat und Argument weitergeben m_frm.Invoke(New CallEventFinished(AddressOf CallEventFinishedOrder), _ m_ActualOrder, t_Result) Else ' sonst ' Delegat direkt ausführen RaiseEvent FinishedOrder(m_ActualOrder, t_Result) End If ' Fortfahren Work() End Sub ' ************************************************************************ ' Die Ereignisse, die vor und nach dem Bearbeiten einer Datei bzw. ' eines Ordners auftreten. Hier kann der Vorgang eventuelle abgebrochen ' bzw. das Ergebniss abegrufen werden. Außerdem die Delegaten und eine ' Funktion, die das Ereignis aufruft. ' ************************************************************************ Public Event StartingOrder(ByVal Item As FSOrder, _ ByRef Cancel As FSOrder.OrderResultType) Public Delegate Sub CallEventStart(ByVal Item As FSOrder, _ ByRef e As FSOrder.OrderResultType) Private Sub CallEventStartingOrder(ByVal Item As FSOrder, _ ByRef Cancel As FSOrder.OrderResultType) RaiseEvent StartingOrder(Item, Cancel) End Sub Public Event FinishedOrder(ByVal Item As FSOrder, _ ByVal Result As FSOrder.OrderResultType) Public Delegate Sub CallEventFinished(ByVal Item As FSOrder, _ ByVal e As FSOrder.OrderResultType) Private Sub CallEventFinishedOrder(ByVal Item As FSOrder, _ ByVal Result As FSOrder.OrderResultType) RaiseEvent FinishedOrder(Item, Result) End Sub ' ************************************************************************ ' Der Delegate ' ************************************************************************ Private Delegate Function ASyncCall(ByVal Status As FSOrder.OrderResultType) _ As FSOrder.OrderResultType ' ************************************************************************ ' Die Funktion für den eigentlichen Kopiervorgang ' ************************************************************************ Private Function Copy(ByVal Status As FSOrder.OrderResultType) As FSOrder.OrderResultType Try If Status = FSOrder.OrderResultType.Success Then Select Case m_ActualOrder.FileSystemType Case FSOrder.TypeOfFileSystem.Dir My.Computer.FileSystem.CopyDirectory(m_ActualOrder.Source, _ m_ActualOrder.Destination, m_Overwrite) Case FSOrder.TypeOfFileSystem.File My.Computer.FileSystem.CopyFile(m_ActualOrder.Source, _ m_ActualOrder.Destination, m_Overwrite) End Select End If Catch ex As Exception Status = FSOrder.OrderResultType.Error End Try Return Status End Function ' ************************************************************************ ' Die Funktion für den eigentlichen Verschiebevorgang ' ************************************************************************ Private Function Move(ByVal Status As FSOrder.OrderResultType) As FSOrder.OrderResultType Try If Status = FSOrder.OrderResultType.Success Then Select Case m_ActualOrder.FileSystemType Case FSOrder.TypeOfFileSystem.Dir My.Computer.FileSystem.MoveDirectory(m_ActualOrder.Source, _ m_ActualOrder.Destination, m_Overwrite) Case FSOrder.TypeOfFileSystem.File My.Computer.FileSystem.MoveFile(m_ActualOrder.Source, _ m_ActualOrder.Destination, m_Overwrite) End Select End If Catch ex As Exception Status = FSOrder.OrderResultType.Error End Try Return Status End Function ' ************************************************************************ ' Die Funktion für den eigentlichen Löschvorgang ' ************************************************************************ Private Function Delete(ByVal Status As FSOrder.OrderResultType) As FSOrder.OrderResultType Try If Status = FSOrder.OrderResultType.Success Then Select Case m_ActualOrder.FileSystemType Case FSOrder.TypeOfFileSystem.Dir My.Computer.FileSystem.DeleteDirectory(m_ActualOrder.Source, _ FileIO.UIOption.OnlyErrorDialogs, _ FileIO.RecycleOption.SendToRecycleBin) Case FSOrder.TypeOfFileSystem.File My.Computer.FileSystem.DeleteFile(m_ActualOrder.Source, _ FileIO.UIOption.OnlyErrorDialogs, _ FileIO.RecycleOption.SendToRecycleBin) End Select End If Catch ex As Exception Status = FSOrder.OrderResultType.Error End Try Return Status End Function Private m_frm As Windows.Forms.Form Public Sub New(ByVal frm As Windows.Forms.Form) m_frm = frm m_Waiter = New Threading.ManualResetEvent(True) End Sub End Class Modul FSOrder Public Structure FSOrder ' ************************************************************************ ' Die Funktionen, die einen Kopierauftrag einer Datei bzw. eines Ordners ' auftreten entgegennehmen. ' ************************************************************************ Public Shared Function CreateDirForCopy(ByVal Source As String, _ ByVal Destination As String) As FSOrder Dim Item As New FSOrder(Source, Destination, _ FSOrder.TypeOfOrder.Copy, FSOrder.TypeOfFileSystem.Dir) Return Item End Function Public Shared Function CreateFileForCopy(ByVal Source As String, _ ByVal Destination As String) As FSOrder Dim Item As New FSOrder(Source, Destination, _ FSOrder.TypeOfOrder.Copy, FSOrder.TypeOfFileSystem.File) Return Item End Function ' ************************************************************************ ' Die Funktionen, die einen Verschiebeauftrag einer Datei bzw. eines ' Ordners auftreten entgegennehmen. ' ************************************************************************ Public Shared Function CreateDirForMove(ByVal Source As String, _ ByVal Destination As String) As FSOrder Dim Item As New FSOrder(Source, Destination, _ FSOrder.TypeOfOrder.Move, FSOrder.TypeOfFileSystem.Dir) Return Item End Function Public Shared Function CreateFileForMove(ByVal Source As String, _ ByVal Destination As String) As FSOrder Dim Item As New FSOrder(Source, Destination, _ FSOrder.TypeOfOrder.Move, FSOrder.TypeOfFileSystem.File) Return Item End Function ' ************************************************************************ ' Die Funktionen, die einen Löschauftrag einer Datei bzw. eines Ordners ' auftreten entgegennehmen. ' ************************************************************************ Public Shared Function CreateDirForDelete(ByVal Source As String) As FSOrder Dim Item As New FSOrder(Source, "", _ FSOrder.TypeOfOrder.Delete, FSOrder.TypeOfFileSystem.Dir) Return Item End Function Public Shared Function CreateFileForDelete(ByVal Source As String) As FSOrder Dim Item As New FSOrder(Source, "", _ FSOrder.TypeOfOrder.Delete, FSOrder.TypeOfFileSystem.File) Return Item End Function ' ************************************************************************ ' Die Eigenschaften ' ************************************************************************ Private m_Source As String Public Property Source() As String Get Return m_Source End Get Set(ByVal value As String) ' Prüft den Read/Write-Wrapper If Not (m_ReadOnlyWrapper) Then m_Source = value Else Throw New NotSupportedException End If End Set End Property Private m_Destination As String Public Property Destination() As String Get Return m_Destination End Get Set(ByVal value As String) ' Prüft den Read/Write-Wrapper If Not (m_ReadOnlyWrapper) Then ' Bei Delete ist diese Property unwichtig! If m_OrderType = TypeOfOrder.Delete Then Exit Property Else m_Destination = value End If Else Throw New NotSupportedException End If End Set End Property Public Enum TypeOfOrder Copy = 1 Move = 2 Delete = 3 End Enum Private m_OrderType As TypeOfOrder Public Property OrderType() As TypeOfOrder Get Return m_OrderType End Get Set(ByVal value As TypeOfOrder) ' Prüft den Read/Write-Wrapper If Not (m_ReadOnlyWrapper) Then m_OrderType = value If value = TypeOfOrder.Delete Then ' Bei Delete ist diese Property unwichtig! m_Destination = "" End If Else Throw New NotSupportedException End If End Set End Property Public Enum TypeOfFileSystem Dir = 1 File = 2 End Enum Private m_FileSystemType As TypeOfFileSystem Public Property FileSystemType() As TypeOfFileSystem Get Return m_FileSystemType End Get Set(ByVal value As TypeOfFileSystem) ' Prüft den Read/Write-Wrapper If Not (m_ReadOnlyWrapper) Then m_FileSystemType = value Else Throw New NotSupportedException End If End Set End Property Public ReadOnly Property IsInitalized() As Boolean Get Dim Result(1) As Boolean Select Case m_FileSystemType ' Überprüft, ob die Quelle existiert Case TypeOfFileSystem.Dir Result(0) = IO.Directory.Exists(m_Source) Case TypeOfFileSystem.File Result(0) = IO.File.Exists(m_Source) End Select If m_OrderType <> TypeOfOrder.Delete Then Select Case m_FileSystemType ' Überprüft, ob das Ziel existiert Case TypeOfFileSystem.Dir Result(1) = IO.Directory.Exists(m_Destination) Case TypeOfFileSystem.File Result(1) = IO.File.Exists(m_Destination) End Select If Not (Result(1)) Then Try Select Case m_FileSystemType ' Überprüft, ob sich das Element erstellen lässt ' wenn es noch nicht existiert Case TypeOfFileSystem.Dir Call IO.Directory.CreateDirectory(m_Destination) Result(1) = IO.Directory.Exists(m_Destination) Case TypeOfFileSystem.File Call IO.Directory.CreateDirectory( _ IO.Path.GetDirectoryName(m_Destination)) Call IO.File.Create(m_Destination).Close() Result(1) = IO.File.Exists(m_Destination) End Select Catch ex As Exception End Try End If Else ' Bei Delete ist Destination unwichtig! Result(1) = True End If Return Result(0) And Result(1) End Get End Property Public Enum OrderResultType Success = 0 [Error] = 1 Canceled = -1 End Enum Private m_ReadOnlyWrapper As Boolean Public Property ReadOnlyWrapper() As Boolean Get Return m_ReadOnlyWrapper End Get Private Set(ByVal value As Boolean) m_ReadOnlyWrapper = value End Set End Property Public Sub New(ByVal Source As String, ByVal Destination As String, _ ByVal OrderType As TypeOfOrder, ByVal FileSystemType As TypeOfFileSystem, _ Optional ByVal ReadOnlyWrapper As Boolean = False) Me.OrderType = OrderType Me.FileSystemType = FileSystemType Me.Source = Source Me.Destination = Destination Me.ReadOnlyWrapper = ReadOnlyWrapper End Sub Public Sub New(ByVal OrderType As TypeOfOrder, _ ByVal FileSystemType As TypeOfFileSystem, _ Optional ByVal ReadOnlyWrapper As Boolean = False) Me.OrderType = OrderType Me.FileSystemType = FileSystemType Me.Source = "" Me.Destination = "" Me.ReadOnlyWrapper = ReadOnlyWrapper End Sub Public Sub New(ByVal Order As FSOrder, ByVal ReadOnlyWrapper As Boolean) Me.OrderType = Order.OrderType Me.FileSystemType = Order.FileSystemType Me.Source = Order.Source Me.Destination = Order.Destination Me.ReadOnlyWrapper = ReadOnlyWrapper End Sub End Structure Aufrufbeispiel: Private WithEvents X As New clsFileSystemQueue(Me) ' 2 Ordner kopieren X.Add(FSOrder.CreateDirForCopy("F:\VS\VisualStudio\Setup", "H:\C\Setup")) X.Add(FSOrder.CreateDirForCopy("F:\VS\VisualStudio\Windows", "H:\C\Windows")) ' Ordner und Dateien verschieben X.Add(FSOrder.CreateDirForMove("H:\C\Setup", "F:\A\Setup")) X.Add(FSOrder.CreateFileForMove("H:\C\fi\vs_setup.msi", "F:\A\vs_setup.msi")) Anmerkung: Dieser Tipp wurde bereits 12.867 mal aufgerufen. Voriger Tipp | Zufälliger Tipp | Nächster Tipp
Anzeige
Diesen und auch alle anderen Tipps & Tricks finden Sie auch auf unserer aktuellen vb@rchiv Vol.6 (einschl. Beispielprojekt!) Ein absolutes Muss - Geballtes Wissen aus mehr als 8 Jahren vb@rchiv! - nahezu alle Tipps & Tricks und Workshops mit Beispielprojekten - Symbol-Galerie mit mehr als 3.200 Icons im modernen Look Weitere Infos - 4 Entwickler-Vollversionen (u.a. sevFTP für .NET), Online-Update-Funktion u.v.m. |
Neu! sevEingabe 3.0 Einfach stark! Ein einziges Eingabe-Control für alle benötigten Eingabetypen und -formate, inkl. Kalender-, Taschenrechner und Floskelfunktion, mehrspaltige ComboBox mit DB-Anbindung, ImageComboBox u.v.m. Tipp des Monats März 2024 Dieter Otter UTF-8 Konvertierung von Dateien und Strings VB6 selbst verfügt über keine Funktionen zur UTF-8 Konvertierung von Daten. Mit Hilfe des ADODB.Stream-Objekts lassen sich diese fehlenden Funktionen aber schnell nachrüsten. TOP Entwickler-Paket TOP-Preis!! Mit der Developer CD erhalten Sie insgesamt 24 Entwickler- komponenten und Windows-DLLs. Die Einzelkomponenten haben einen Gesamtwert von 1605.50 EUR... |
||||||||||||||||
Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein. |