Nach unseren beiden Einführungsteilen zum FileSystemObject (kurz FSO), in denen wir die wichtigsten Eigenschaften und Methoden des FSO-Objekts erläutert haben, ist es nun an der Zeit, die gesammelte Theorie in die Praxis umzusetzen. Und was liegt in diesem Fall näher, als einen kleinen Datei-Commander zusammenzustellen - die Geburtsstunde des vb@rchiv Commander hat geschlagen Anforderungen und Formular-Layout Wie am Ende des 2. Teils unserer FSO-Workshop-Reihe angekündigt, wollen wir im 3. Teil die gesammelte Theorie in die Praxis umsetzen und einen kleinen (oder auch größeren) Datei-Commander nach dem Vorbild des bekannten Norton Commander von der Firma Symantec zusammenbauen. Unseren Datei-Commander nennen wir hierbei vb@rchiv Commander. Der vb@rchiv Commander soll mit folgenden Funktionen ausgestattet werden:
Sie sehen schon: Wir werden wirklich alle Funktionen des FSO-Objekts ausschöpfen. Welche Controls benötigen wir alles? Was brauchen wir noch? Ok... let's begin Oberflächen-Gestaltung Starten Sie die Visual Basic Entwicklungsumgebung, erstellen ein neues Projekt vom Typ Standard EXE und fügen dem Projekt folgende ActiveX-Komponenten hinzu (Menü Projekt - Komponenten):
Platzieren Sie nun folgende Controls auf die Form:
Wie und wo Sie die einzelnen Controls auf die Form setzen, spielt keine Rolle. Positionen und Größen legen wir zur Laufzeit fest. Einzig die ScrollBars-Eigenschaft des RichTextBox-Controls legen wir zur Entwurfszeit fest - und zwar auf den Wert 2 - Both. Das ImageList-Control soll alle Symbole für die Toolbar, der Laufwerks-ComboBox (ImageComboBox) und dem ListView-Control zur Verfügung stellen. Diese Symbole werden bereits zur Entwurfszeit eingefügt. Folgende Bildsymbole werden benötigt:
Download der Bildsymbole: fso_icons.zip (7 KB) Nachdem alle Controls auf der Form platziert sind, sollte diese in etwa wie in nachfolgender Abbildung dargestellt aussehen: Mehr brauchen wir nicht - nur diese eine Form! Evtl. werden Sie sich jetzt fragen, warum sich das RichTextBox-Control auf der gleichen Form befindet, wie die anderen Controls, und nicht auf einer 2. Form, die beim Editieren von Dateien angezeigt wird. Genau so handhaben es einige Programme - aber nicht der vb@rchiv Commander Warum auch? Zu Beginn, wenn die beiden Ordner-Listen angezeigt werden, wird das RTF-Feld ausgeblendet (Visible = False). Soll eine Datei editiert werden, setzen wir das RTF-Control einfach über den gesamten Formbereich und blenden es ein. Auf diese Weise können wir sogar ein- und dieselbe Toolbar verwenden Mehr dazu aber später. Initialisieren der Controls Wechseln Sie in das Codefenster der Form. Da der vb@rchiv Commander für seine Funktionalität in erster Linie die Eigenschaften und Methoden des FileSystemObjects benötigt, deklarieren wir im Allgemein-Teil der Form zunächst das FSO-Objekt, auf das wir innerhalb des Projekts zugreifen. Zuvor müssen Sie jedoch noch den Verweis Microsoft Scripting Runtime aktivieren (Menü Projekt - Verweise). Option Explicit ' FileSystemObjekt referenzieren Private oFSO As FileSystemObject ' In diesem Array merken wir uns einen evtl. gesetzten Dateifilter Private sFilter() As String Beim Laden der Anwendung müssen folgende Aufgaben erledigt werden:
Beginnen wir also mit dem Form_Load-Ereignis: Private Sub Form_Load() Dim i As Integer Dim oButton As Button ' FileSystemObjekt instanzieren Set oFSO = New FileSystemObject ' Array für Datei-Filter dimensionieren ReDim sFilter(1) ' &-Zeichen im Label für Pfadanzeige zulassen lblPath(0).UseMnemonic = False lblPath(1).UseMnemonic = False ' Label-Höhe festlegen (2-zeilig) lblPath(0).Height = 480 lblPath(1).Height = 480 ' Toolbar-Buttons erstellen With Toolbar1 ' ImageList zuordnen Set .ImageList = ImageList1 With .Buttons ' Platzhalter links Set oButton = .Add(, , , tbrPlaceholder) oButton.Width = 105 ' Neuer Ordner Set oButton = .Add(, "foldernew", , tbrDefault, "_folder") oButton.ToolTipText = "Neuen Ordner erstellen" ' Aktualisieren Set oButton = .Add(, "refresh", , tbrDefault, "tb_refresh") oButton.ToolTipText = "Aktualisieren" ' Ebene höher Set oButton = .Add(, "folderup", , tbrDefault, "tb_folderup") oButton.ToolTipText = "Aufwärts" ' Filter Set oButton = .Add(, "filter", , tbrDefault, "tb_filter") oButton.ToolTipText = "Filter festlegen" ' Trennlinie Set oButton = .Add(, , , tbrSeparator) ' Eigenschaften Set oButton = .Add(, "properties", , tbrDefault, "tb_properties") oButton.ToolTipText = "Eigenschaften" ' Kopieren Set oButton = .Add(, "copy", , tbrDefault, "tb_copy") oButton.ToolTipText = "Kopieren" ' Verschieben Set oButton = .Add(, "move", , tbrDefault, "tb_move") oButton.ToolTipText = "Verschieben" ' Löschen Set oButton = .Add(, "delete", , tbrDefault, "tb_delete") oButton.ToolTipText = "Löschen" ' Bearbeiten Set oButton = .Add(, "edit", , tbrDefault, "tb_edit") oButton.ToolTipText = "Bearbeiten" ' Trennlinie Set oButton = .Add(, , , tbrSeparator) ' Neue Text-Datei erstellen Set oButton = .Add(, "textnew", , tbrDefault, "tb_textnew") oButton.ToolTipText = "Neue Textdatei erstellen" ' Trennlinie Set oButton = .Add(, , , tbrSeparator) ' Speichern (für EditMode), jedoch zunächst ausblenden Set oButton = .Add(, "save", , tbrDefault, "tb_save") oButton.ToolTipText = "Speichern" oButton.Visible = False ' Trennlinie Set oButton = .Add(, , , tbrSeparator) ' Beenden Set oButton = .Add(, "exit", , tbrDefault, "tb_exit") oButton.ToolTipText = "Beenden" End With End With ' ImageList mit Laufwerkssymbolen zuordnen Set cmbDrive(0).ImageList = ImageList1 Set cmbDrive(1).ImageList = ImageList1 ' Eingabe in der ImageComboBox unterbinden cmbDrive(0).Locked = True cmbDrive(1).Locked = True ' Listview-Eigenschaften festlegen For i = 0 To 1 With lvwFiles(i) ' Detail-Ansicht .View = lvwReport ' AutoEdit deaktivieren .LabelEdit = lvwManual ' Immer gesamte Zeile markieren .FullRowSelect = True ' Auswahl beim Verlassen des Fokus grau darstellen .HideSelection = False ' ImageList zuordnen Set .SmallIcons = ImageList1 End With ' Spalten erstellen With lvwFiles(i).ColumnHeaders .Add , , "Name", 2000 .Add , , "Größe", 1200, lvwColumnRight .Add , , "Datum", 1500 .Add , , "Attribut", 500 End With Next i ' RichTextBox zunächst ausblenden rtfEdit.Text = "" rtfEdit.Visible = False ' PopUp-Menü aktivieren rtfEdit.AutoVerbMenu = True ' Schriftart für das Editieren festlegen rtfEdit.Font.Name = "FixedSys" rtfEdit.Font.Size = 8 ' alle verfügbaren Laufwerke ermitteln ' und den beiden ImageComboBox hinzufügen fso_InitDrives cmbDrive(0) fso_InitDrives cmbDrive(1) ' Die beiden ListView-Controls (lvwFiles) werden autom. ' mit den Ordnern und Dateien des im fso_InitDrives ausgewählten ' Laufwerks gefüllt! cmbDrive_Click 0 cmbDrive_Click 1 End Sub Bevor wir uns an die beiden Funktionen fso_InitDrives und cmbDrive_Click machen, sorgen wir erst einmal dafür, dass die Controls auf der Form entsprechend positioniert und in ihrer Größe an die Formgröße angepasst werden: ' autom. Größenanpassung der Controls Private Sub Form_Resize() Dim nWidth As Single Dim nHeight As Single Dim nDist As Single ' Mindestgröße der Form festlegen Const nMinWidth = 3000 Const nMinHeight = 3000 If Me.WindowState <> vbMinimized Then ' aktuelle Formgröße nWidth = Me.ScaleWidth nHeight = Me.ScaleHeight ' Auf Mindestgröße prüfen If nWidth < nMinWidth Then nWidth = nMinWidth If nHeight < nMinHeight Then nHeight = nMinHeight ' Abstand links, rechts, unten und zwischen den ' linken und rechten Controls nDist = 105 ' linke Controls ausrichten With cmbDrive(0) .Move nDist, Toolbar1.Height + 90 .Width = (nWidth - nDist * 3) / 2 lblPath(0).Move nDist, .Top + .Height + 90 lblPath(0).Width = cmbDrive(0).Width lvwFiles(0).Move nDist, lblPath(0).Top + lblPath(0).Height + 90 lvwFiles(0).Width = cmbDrive(0).Width lvwFiles(0).Height = nHeight - lvwFiles(0).Top - nDist End With ' rechte Controls ausrichten With cmbDrive(1) .Move cmbDrive(0).Left + cmbDrive(0).Width + nDist, cmbDrive(0).Top .Width = cmbDrive(0).Width lblPath(1).Move .Left, lblPath(0).Top lblPath(1).Width = .Width lvwFiles(1).Move .Left, lvwFiles(0).Top lvwFiles(1).Width = .Width lvwFiles(1).Height = lvwFiles(0).Height End With ' Pfadangaben neu anzeigen ShowPath 0, lvwFiles(0).Tag ShowPath 1, lvwFiles(0).Tag ' RichTextBox an Formgröße anpassen rtfEdit.Move nDist, Toolbar1.Height + 90 rtfEdit.Width = Me.ScaleWidth - nDist * 2 rtfEdit.Height = Me.ScaleHeight - rtfEdit.Top - nDist End If End Sub Der vollständige Verzeichnispfad der jeweiligen Datei-Liste soll im Label lblPath(index) angezeigt werden. Da der Pfad bei tiefer Verzeichnisverschachtelung jedoch sehr schnell sehr lang werden kann, würde dieser im Label-Control einfach rechts abgeschnitten werden. Um dies zu verhindern, kürzen wir die Verzeichnisangabe - und zwar nicht hinten, sondern irgendwo dazwischen. Hierfür gibt es nämlich eine "feine" API-Funktion namens PathCompactPath, die diese Aufgabe ohne großes Zutun unsererseits erledigt. Fügen Sie nachfolgende Deklaration in den Allgemein-Teil der Form ein: ' Wird benötigt, um den Pfad ggf. gekürzt im Label anzuzeigen Private Declare Function PathCompactPath Lib "shlwapi" _ Alias "PathCompactPathA" ( _ ByVal hdc As Long, _ ByVal lpszPath As String, _ ByVal dx As Long) As Long Die Anzeige des vollständigen Verzeichnispfades erfolgt in einer eigenen Prozedur ShowPath, die u.a. auch immer dann aufgerufen wird, wenn die Form in ihrer Größe verändert wird. Klar - oder? ' Vollständige Pfadangabe im Label anzeigen, wobei ' dieser autom. gekürzt wird, wenn das Label zu klein ist Private Sub ShowPath(ByVal Index As Integer, _ ByVal sPath As String) Dim nWidth As Long ' Breite des Labels in Pixel nWidth = lblPath(Index).Width / Screen.TwipsPerPixelX ' API-Funktion zum autom. Kürzen des Pfades aufrufen PathCompactPath Me.hdc, sPath, nWidth ' Pfad im Label anzeigen lblPath(Index).Caption = sPath & vbCrLf & _ IIf(sFilter(Index) = "", "alle Dateien", "Filter: " & sFilter(Index)) End Sub So... bevor wir nun ans Eingemachte gehen und die verfügbaren Laufwerke mit deren Ordner und Dateien ermitteln, könnten wir unser Programm schon einmal starten, um zu sehen, ob die Controls auch alle richtig erstellt und positioniert wurden. Kommentieren Sie hierzu testweise die Aufrufe fso_InitDrives, sowie cmbrive_Click 0 und cmbDrive_Click 1 aus und starten das Projekt. Die Controls sollten sich alle schön der Formgröße anpassen - natürlich auch dann, wenn das Fenster während der Laufzeit vergrößert/verkleinert wird. Beenden Sie den ersten Test und nehmen die vorgenommenen Auskommentierungen von fso_InitDrives ... und cmbDrive_Click ... wieder zurück. Ermitteln aller Laufwerke Beginnen wir zunächst mit dem Ermitteln aller verfügbaren Laufwerke. Hierzu zählen Festplatten, Disketten- und Wechsellaufwerke, CDROM-Laufwerke und auch verbundene Netzlaufwerke. Beide ComboBoxen sollen hierbei mit allenverfügbaren Laufwerken gefüllt werden. Vor den einzelnen Einträgen soll das jeweilige Laufwerks-Symbol angezeigt werden, das wir anhand des Laufwerkstyps aus der ImageBox "nehmen". Hinter dem Laufwerksbuchstaben soll die Datenträgerbezeichnung stehen bzw. der Server-Name, falls es sich um ein verbundenes Netzlaufwerk handelt. Nachdem alle Laufwerke ermittelt und in die ComboBox eingetragen sind, soll das aktuelle Laufwerk (CurDir) ausgewählt werden. ' alle verfügbaren Laufwerke ermitteln ' und in der ImageComboBox anzeigen Private Sub fso_InitDrives(oCombo As ImageCombo) Dim oDrive As Scripting.Drive Dim oItem As ComboItem Dim sVolume As String ' alle Laufwerke durchlaufen For Each oDrive In oFSO.Drives With oDrive Set oItem = oCombo.ComboItems.Add(, .DriveLetter & ":") ' Laufwerksbuchstabe + Volume-Name sVolume = .DriveLetter & ":" If .IsReady Then ' Falls es sich um ein Netzlaufwerk handelt, soll ' der ShareName angezeigt werden If .DriveType = Remote Then sVolume = sVolume & "[" & .ShareName & "]" Else ' andernfalls der VolumeName (Datenträgerbezeichnung) sVolume = sVolume & " [" & .VolumeName & "]" End If End If oItem.Text = sVolume ' Symbol zuordnen Select Case .DriveType Case Fixed ' Festplatte oItem.Image = "_harddisk" oItem.SelImage = "_harddisk" Case Removable ' Wechsel-Datenträger oItem.Image = "_disk" oItem.SelImage = "_disk" Case CDRom ' CD-Laufwerk oItem.Image = "_cdrom" oItem.SelImage = "_cdrom" Case Remote ' Netzlaufwerk oItem.Image = "_remote" oItem.SelImage = "_remote" End Select End With Next ' aktuelles Laufwerk selektieren On Error Resume Next Set oCombo.SelectedItem = oCombo.ComboItems(Left$(CurDir$, 2)) If Err.Number <> 0 Then ' Bei Fehler, 1. Lafwerk der Liste selektieren Set oCombo.SelectedItem = oCombo.ComboItems(0) End If On Error GoTo 0 End Sub An dieser Stelle können Sie das Projekt wieder starten und prüfen, ob alle Laufwerke in den beiden ComboBoxen angezeigt werden. Zuvor müssen Sie aber nochmals die beiden cmbDrive_Click ...-Aufrufe im Form_Load Ereignis auskommentieren. Beenden Sie den zweiten Test und nehmen die Auskommentierung im Form_Load Ereignis wieder zurück. Ermitteln aller Ordner und Dateien Kommen wir nun zum dem Teil, in dem wir alle Ordner und Dateien eines Laufwerks / Verzeichnisses ermitteln und im ListView-Control anzeigen wollen. Hierbei sollen zunächst alle Ordner angezeigt werden - und zwar in Großbuchstaben, so dass diese sich von den Dateien ein wenig abheben. Vor dem Ordnernamen soll ein Ordnersymbol angezeigt werden, das ja bereits im ImageList-Control vorhanden ist. In der Spalte "Größe" zeigen wir den Text [SUB-DIR] an. Ja, ja, genau wie der Norton Commander eben In der nächsten Spalte wird das Änderungsdatum und in der letzten Spaltewerden die Attribute angezeigt. Befinden wir uns nicht im Stammverzeichnis des Laufwerks, soll der erste Eintrag im ListView dies verdeutlichen, indem wir einen [UP-DIR]-Eintrag anzeigen. Ja, ja - genau wie der Norton Commander Als Symbol verwenden wir in diesem Fall aber keinen Ordner, sondern ein Pfeil-Symbol, das ebenfalls im ImageList-Control vorhanden ist. ' alle Ordner ermitteln und im ListView anzeigen Private Sub fso_InitFolders(ByVal Index As Integer, ByVal sPath As String) Dim oFolder As Scripting.Folder Dim oSubFolder As Scripting.Folder Dim oDrive As Drive Dim sDrive As String Dim oItem As ListItem ' Laufwerk und Pfad trennen sDrive = oFSO.GetDriveName(sPath) ' Laufwerk Set oDrive = oFSO.Drives(sDrive) With lvwFiles(Index) ' zunächst ListView löschen .ListItems.Clear ' Ist das Laufwerk bereit? If oDrive.IsReady Then ' Toolbar-Button "Neuer Ordner" aktivieren Toolbar1.Buttons("foldernew").Enabled = True ' Handelt es sich bei "sPath" nicht um einen Root-Ordner, ' Eintrag mit der Möglichkeit in eine Ebene höher zu wechseln ' hinzufügen Set oFolder = oFSO.GetFolder(sPath) If Not oFolder.IsRootFolder And InStr(oFolder.Path, "\") > 0 Then Set oItem = .ListItems.Add(, oFolder.ParentFolder.Path, "..", , "_up") oItem.SubItems(1) = "[UP-DIR]" oItem.SubItems(2) = "" oItem.SubItems(3) = "" ' Toolbar-Button "Aufwärts" aktivieren Toolbar1.Buttons("folderup").Enabled = True Else ' Toolbar-Button "Aufwärts" deaktivieren Toolbar1.Buttons("folderup").Enabled = False End If ' alle Ordner durchlaufen For Each oSubFolder In oFolder.SubFolders With oSubFolder Set oItem = lvwFiles(Index).ListItems.Add(, LCase$(.Path), _ UCase$(.Name), , "_folder") oItem.SubItems(1) = "[SUB-DIR]" oItem.SubItems(2) = .DateLastModified oItem.SubItems(3) = fso_GetAttrStr(.Attributes) End With Next ' aktuellen Pfad in der Tag-Eigenschaft "merken" .Tag = oFolder.Path Else ' aktuelles Laufwerk in der Tag-Eigenschaft "merken" .Tag = oDrive.DriveLetter & ":\" ' Toolbar-Button "Neuer Ordner" und "Aufwärts" deaktivieren Toolbar1.Buttons("foldernew").Enabled = False Toolbar1.Buttons("folderup").Enabled = False End If End With End Sub Das Ermitteln aller Dateien eines Laufwerks/Verzeichnisses geht ähnlich vonstatten. Da wirvon Vornherein aber nicht wissen, welche Dateien der Ordner enthält, aber gerne hätten, dass jede Datei "ihr" Symbol bekommt, haben wir jetzt ein Problem: wie ermitteln wir das Dateisymbol und zeigen dieses dann vor dem jeweiligen Datei-Eintrag im ListView-Control an? Mal eben kurz die vb@rchiv Suchmaschine befragt und folgenden Tipp gefunden Diesen Tipp vereinfachen wir ein wenig und fügen nachfolgenden Code in den Allgemein-Teilunseres Form-Codefensters ein: ' Wird benötigt, um das Icon einer Datei zu ermitteln ' und der ImageList hinzuzufügen Private Type TPictDesc cbSizeofStruct As Long PicType As Long hImage As Long xExt As Long yExt As Long End Type Private Type TGUID Data1 As Long Data2 As Integer Data3 As Integer Data4(0 To 7) As Byte End Type Private Declare Function ExtractAssociatedIcon Lib "shell32.dll" _ Alias "ExtractAssociatedIconA" ( _ ByVal hInst As Long, _ ByVal lpIconPath As String, _ lpiIcon As Long) As Long Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" ( _ ByRef lpPictDesc As TPictDesc, _ ByRef RIID As TGUID, _ ByVal fPictureOwnsHandle As Long, _ ByRef IPic As IPicture) As Long ' Icon einer Datei ermitteln und der ImageList hinzufügen Private Function AddIconToImageList(imgList As ImageList, _ sFile As String) As Long Dim Index As Long Dim imgX As ListImage Dim oPic As Picture Dim PicDes As TPictDesc Dim IID_IDispatch As TGUID Dim nHandle As Long ' Icon-Handle ermitteln nHandle = ExtractAssociatedIcon(App.hInstance, sFile, 0) If nHandle = 0 Then Exit Function ' Struktur füllen With PicDes .cbSizeofStruct = Len(PicDes) .PicType = vbPicTypeIcon .hImage = nHandle End With ' Icon in oPic erstellen With IID_IDispatch .Data1 = &H20400 .Data4(0) = &HC0 .Data4(7) = &H46 End With Call OleCreatePictureIndirect(PicDes, IID_IDispatch, True, oPic) ' Icon der ImageList hinzufügen With imgList.ListImages Index = .Count + 1 Call .Add(Index, UCase$(oFSO.GetExtensionName(sFile)), oPic) End With ' Index des Icons zurückgeben AddIconToImageList = Index End Function Wir brauchen jetzt lediglich der Funktion AddIconToImageList den Dateinamen zu übergeben und schon fügt die Funktion das dazugehörige Icon der Icons-Auflistung des ImageList-Controls hinzu. Und damit wir keine doppelten Icons in unserer ImageList aufnehmen, speichern wir zu jedem neu hinzugefügten Icon die Dateierweiterung (Extension) als Key. Bevor wir also die AddIconToImageList-Funktion aufrufen, prüfen wir zunächst, ob in der ImageList für die besagte Dateierweiterung bereits ein Symbol vorhanden ist. Wenn ja - gut. Wenn nein - Hinzufügen. Hier nun der Code, der alle Dateien eines Ordners ermittelt, die jeweiligen Daten (Namen, Größe, Geändert am und Attribute) in das ListView-Control überträgt und natürlich auch das entsprechende Datei-Symbol vor dem Eintrag anzeigt. ' alle Dateien ermitteln und im ListView anzeigen Private Sub fso_InitFiles(ByVal Index As Integer, ByVal sPath As String) Dim oFolder As Scripting.Folder Dim oFile As Scripting.File Dim oDrive As Drive Dim sDrive As String Dim oItem As ListItem Dim sExt As String Dim nImage As Integer ' Laufwerk und Pfad trennen sDrive = oFSO.GetDriveName(sPath) ' Laufwerk Set oDrive = oFSO.Drives(sDrive) With lvwFiles(Index) ' Ist das Laufwerk bereit? If oDrive.IsReady Then ' alle Dateien durchlaufen For Each oFile In oFSO.GetFolder(sPath).Files With oFile ' Datei Filter gesetzt? If sFilter(Index) = "" Or LCase$(.Name) Like sFilter(Index) Then Set oItem = lvwFiles(Index).ListItems.Add(, LCase$(.Path), .Name) oItem.SubItems(1) = CStr(.Size) oItem.SubItems(2) = .DateLastModified oItem.SubItems(3) = fso_GetAttrStr(.Attributes) ' Extension der Datei ermitteln sExt = UCase$(oFSO.GetExtensionName(.Path)) ' Ist schon ein Bildsymbol für diese Dateierweiterung vorhanden? On Error Resume Next nImage = 0 nImage = ImageList1.ListImages(sExt).Index If nImage = 0 Then ' Nein! Jetzt Bildsymbol ermitteln und der ImageList hinzufügen nImage = AddIconToImageList(ImageList1, .Path) If nImage = 0 Then nImage = ImageList1.ListImages("_unknown").Index End If ' Bildsymbol dem File-Eintrag zuordnen oItem.SmallIcon = nImage On Error GoTo 0 End If End With Next End If End With End Sub Beim Abfragen der Attributes-Eigenschaft des Folder- bzw. File-Objekts bekommen wir eine Zahl geliefert. Wir möchten jedoch evtl. gesetzte Attribute wie folgt im ListView anzeigen: A: Archiv (Datei/Ordner hat sich seit der letzten Sicherung geändert) Also schreiben wir uns eine kleine Funktion, der wir als Parameter die Attributes-Eigenschaft übergeben und als Rückgabewert einen String mit den gewünschten "Kürzeln" erhalten: ' Attribute eines Ordners/einer Datei ermitteln und ' als String zurückgeben: ' ' A = Archiv (Datei/Ordner hat sich seit der letzten Sicherung geändert) ' R = ReadOnly ' H = Hidden ' S = System ' C = Compressed Private Function fso_GetAttrStr(ByVal nAttr As Long) Dim sAttr As String sAttr = "" If nAttr And ReadOnly Then sAttr = sAttr & "R" If nAttr And Hidden Then sAttr = sAttr & "H" If nAttr And System Then sAttr = sAttr & "S" If nAttr And Archive Then sAttr = sAttr & "A" If nAttr And Compressed Then sAttr = sAttr & "C" fso_GetAttrStr = sAttr End Function So, jetzt könnten wir unseren vb@rchiv Commander zum dritten Mal testen Aber stopp: Wir haben ja immer noch nicht das Click-Event der ComboBoxen erstellt. Bei der Auswahl eines Laufwerks aus der ComboBox sollen alle Ordner/Dateien des Laufwerks im jeweiligen ListView-Control angezeigt werden. Wir könnten jetzt in das Click-Ereignis die beiden Prozeduraufrufe fso_InitFolder und fso_InitFiles reinsetzen. Machen wir aber nicht Sondern: Wir erstellen eine neue Prozedur namens RefreshList, die wir im Click-Ereignis der ComboBoxen aufrufen. Warum? Aus folgendem Grund: Nicht nur bei der Laufwerksauswahl müssen wir alle Ordner und Dateien ermitteln, sondern auch dann, wenn der Anwender:
Sie merken also: es rentiert sich, den gesamten Code in eine extra Prozedur zu setzen: RefreshList ' Datei-Liste neu aufbauen Private Sub RefreshList(ByVal Index As Integer, _ Optional ByVal sPath As String = "") ' Mauszeiger auf Sanduhr setzen Screen.MousePointer = vbHourglass ' Falls kein Pfad angegeben wurde, aktuellen ' Pfad aus der Tag-Eigenschaft des ListView- ' Controls auslesen If sPath = "" Then sPath = lvwFiles(Index).Tag ' ComboBox deaktivieren, solange bis die ' Verzeichnisliste erstellt ist cmbDrive(Index).Enabled = False If Me.Visible Then lvwFiles(Index).SetFocus DoEvents End If ' zunächst alle Ordner anzeigen fso_InitFolders Index, sPath ' danach alle Dateien anzeigen fso_InitFiles Index, sPath ' Pfad im Label anzeigen ShowPath Index, lvwFiles(Index).Tag ' Ersten Eintrag im ListView markieren With lvwFiles(Index) If .ListItems.Count > 0 Then SetListItem Index, 1 Else ' Toolbar-Buttons disablen Toolbar1.Buttons("properties").Enabled = False Toolbar1.Buttons("copy").Enabled = False Toolbar1.Buttons("move").Enabled = False Toolbar1.Buttons("delete").Enabled = False Toolbar1.Buttons("edit").Enabled = False End If End With ' Mauszeiger wieder normal setzen cmbDrive(Index).Enabled = True Screen.MousePointer = vbNormal End Sub So... jetzt aber: Das lang ersehnte cmbDrive_Click Ereignis: ' Ordner und Dateiliste anzeigen Private Sub cmbDrive_Click(Index As Integer) RefreshList Index, cmbDrive(Index).SelectedItem.Key End Sub Um einen bestimmten Ordner- oder Datei-Eintrag im ListView-Control per Code zu selektieren, verwenden wir nachfolgende Prozedur. Als Parameter wird der Index des ListView-Controls erwartet, sowie entweder der Key-Wert oder der Index des Eintrags, der selektiert werden soll. ' Bestimmten Eintrag im ListView markieren und anzeigen Private Sub SetListItem(ByVal Index As Integer, ByVal vKey As Variant) ' Index oder Key angegeben? If VarType(vKey) = vbString Then ' in kleine Schreibweise umwandeln vKey = LCase$(vKey) End If With lvwFiles(Index) Set .SelectedItem = .ListItems(vKey) .SelectedItem.EnsureVisible ' muss aufgerufen werden, weil im ItemClick-Ereignis ' die Toolbar aktualisiert wird lvwFiles_ItemClick Index, .SelectedItem End With End Sub Auf zum dritten Test, wobei Sie vor dem Starten des Projekts noch folgende Codezeile in der SetListItem-Prozedur auskommentieren müssen: ' lvwFiles_ItemClick Index, .SelectedItem
Und: Zufrieden? Mit diesem Code haben wir jetzt schon einmal einen "Navigator", der es ermöglicht sich durch alle Verzeichnisse aller vorhandenen Laufwerke zu wühlen Ordner-Funktionen, Dateien ausführen Kommen wir nun zu folgenden Ordner- und Datei-Funktionen:
Das Wechseln in einen Unterordner soll per Doppelklick auf den jeweiligen Ordner im ListView-Control möglich sein, ebenso das Wechselnauf eine Ebene höher, wenn der Anwender auf den Eintrag ".. [UP-DIR]" doppelklickt. Wie gehen wir hierbei vor? Fügen Sie zunächst nachfolgende Deklarationen in den Allgemein-Teil der Form ein: ' Wird benötigt, um Dateien per Doppelklick auszuführen Private Declare Function ShellExecute Lib "shell32.dll" _ Alias "ShellExecuteA" ( _ ByVal hWnd As Long, _ ByVal lpOperation As String, _ ByVal lpFile As String, _ ByVal lpParameters As String, _ ByVal lpDirectory As String, _ ByVal nShowCmd As Long) As Long Private Const SE_ERR_NOASSOC = 31 Und hier der Code des DblClick-Ereignisses: ' Bei Doppelklick: Ordner öffnen bzw. Datei ausführen Private Sub lvwFiles_DblClick(Index As Integer) Dim sPath As String Dim nResult As Long With lvwFiles(Index) ' Ist ein Eintrag markiert? If Not .SelectedItem Is Nothing Then With .SelectedItem If .SubItems(1) = "[UP-DIR]" Or .SubItems(1) = "[SUB-DIR]" Then ' Doppelklick auf Ordner bzw. Verzeichnisebene nach oben sPath = .Key RefreshList Index, sPath Else ' Doppelklick auf Datei: Datei jetzt ausführen nResult = ShellExecute(Me.hWnd, "open", .Key, "", "", 1) If nResult = SE_ERR_NOASSOC Then ' Wenn die Dateierweiterung noch nicht bekannt ist... ' wird der "Öffnen mit..."-Dialog angezeigt. Call ShellExecute(Me.hWnd, vbNullString, "RUNDLL32.EXE", _ "shell32.dll,OpenAs_RunDLL " & .Key, "", 1) End If End If End With End If End With End Sub Das war's dann auch schon War gar nicht viel - oder? Starten Sie das Projekt und testen die neuen Funktionen. Bevor wir uns jetzt mit den weiteren Funktion beschäftigen, noch ein Gedanke vorweg: Alle Funktionen kann der Anwender sowohl im linken Listenfenster, als auch im rechten Listenfenster aufrufen. D.h. wir müssen wissen, in welchem Listenfenster sich der Anwender befindet, bevorer eine Funktion aufruft. Am Einfachsten merken wir uns hierzu den Index des aktiven ListView-Conrols in einer Variable. Fügen Sie folgende Deklaration in den Allgemein-Teil der Form ein: ' Diese Variable speichert den Index des aktiven ListViews Private nList As lvwCurrent Private Enum lvwCurrent ListLeft = 0 ListRight = 1 End Enum Erhält ein ListView den Fokus, müssen wir jetzt lediglich der Variable nList den Index des ListView-Controls zuweisen: Private Sub lvwFiles_GotFocus(Index As Integer) ' Index des aktiven ListViews merken nList = Index End Sub Jetzt können wir jederzeit im Programm abfragen, welches der beiden ListViews gerade das aktive Control ist. Neuen Ordner erstellen Selbstverständlich soll der Anwender unseres vb@rchiv Commander die Möglichkeit haben, auch neue Ordner im aktuellen Verzeichnis zu erstellen. Für die Eingabe des Ordnernamens verwenden wir schlicht und ergreifend die Standard InputBox von Visual Basic. Das Erstellen des Ordners erfolgt über die CreateFolder-Methode des FSO-Objekts. Hier ist es jedoch wichtig eine Fehlerbehandlung einzubauen, für den Fall, dass der Ordner nicht erstellt werden kann, weil es beispielsweise bereits einen Ordner mit der angegebenen Bezeichnung gibt. ' Neuen Ordner erstellen Private Sub CreateNewFolder() Dim sFolder As String Dim sPath As String ' Ordner-Name über InputBox eingeben sFolder = InputBox("Bitte geben Sie jetzt den Namen des neuen Odners ein:", _ "Neuer Ordner") If sFolder <> "" Then ' Fehlerbehandlung aktivieren, falls Ordner nicht ' erstellt werden kann On Error Resume Next sPath = AppendSlash(lvwFiles(nList).Tag) & sFolder oFSO.CreateFolder sPath If Err.Number <> 0 Then ' Fehlermeldung ausgeben MsgBox "Fehler beim Erstellen des Ordners!" & vbCrLf & _ CStr(Err.Number) & " - " & Err.Description, _ vbCritical + vbOKOnly, "Fehler" Else ' Dateiliste aktualisieren RefreshList nList ' erstellten Ordner im ListView markieren SetListItem nList, sPath End If On Error GoTo 0 End If End Sub Um sicherzustellen, dass eine Verzeichnisangabe immer mit einem Backslash endet, fügen wir noch nachfolgende Funktion ein: ' Pfadangabe: ggf. abschließenden Backslash anfügen Private Function AppendSlash(ByVal sPath As String) As String If Right$(sPath, 1) <> "\" Then sPath = sPath & "\" AppendSlash = sPath End Function Wenn Sie möchten, können Sie auch diese neue Funktion gleich einmal austesten. Der Aufruf der neuen Funktion erfolgt über die Toolbar: Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button) ' Befehl ausführen Select Case Button.Key Case "foldernew" ' Neuen Ordner erstellen CreateNewFolder End Select End Sub Refresh-Funktion und Verzeichnisebene nach oben wechseln Gleich neben dem Ordner-Symbol in der Toolbar befinden sich die beiden Symbole Aktualisieren und Aufwärts. Klickt der Anwender auf das 2. Symbol brauchen wir lediglich die RefreshList-Funktion aufrufen. Klickt der Anwender auf das 3. Symbol simulieren wir einfach einen Doppelklick auf den ersten Eintrag im ListView-Control (.. [UP-DIR]). Erweitern Sie das Toolbar1_ButtonClick-Ereignis wie folgt: Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button) ... Case "refresh" ' Aktualisieren RefreshList nList Case "folderup" ' eine Ebene höher With lvwFiles(nList) ' Hierzu markieren wir den ersten Eintrag im ListView... SetListItem nList, 1 ' ... und lösen das DblClick-Ereignis per Code aus lvwFiles_DblClick CInt(nList) End With ... End Sub Dateifilter festlegen Sollen nicht immer alle Dateien im ListView-Control angezeigt werden, sondern nur Dateien mit einer bestimmten Dateierweiterung, ist das für unseren vb@rchiv Commander ebenfalls kein Problem. Über die Standard InputBox von Visual Basic soll der Anwender die Möglichkeit haben, eine beliebige Dateimaske festzulegen, die dann als Filter für das aktive ListView-Control verwendet wird. Die festgelegte Dateimaske soll hierbei im Label lblPath oberhalb des ListViews angezeigt werden - und zwar direkt unterhalb der Pfad-Anzeige. ' Datei-Filter setzen Private Sub SetFilter() Dim sMask As String ' Datei-Filter über INPUTBOX eingeben sMask = InputBox("Geben Sie hier einen Datei-Filter ein." & vbCrLf & _ "(Beispiel: *.TXT um nur TXT-Dateien anzuzeigen)" & vbCrLf & vbCrLf & _ "Lassen Sie das Eingabefeld leer, um einen festlegten Filter aufzuheben.", _ "Dateifilter") sMask = LCase$(sMask) If sMask = "*.*" Then sMask = "" If sMask <> sFilter(nList) Then ' Datei-Filter setzen und Liste aktualisieren sFilter(nList) = sMask RefreshList nList End If End Sub Die SetFilter-Funktion wird über den 4. Button der Toolbar aufgerufen. Erweitern wir das Toolbar1_ButtonClick-Ereignis also um folgenden Code: Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button) ... Case "filter" ' Datei-Filter setzen SetFilter ... End Sub Anzeige des Standard-Dialogs für Ordner- und Datei-Eigenschaften Über das 5. Symbol unserer Toolbar soll der Anwender die Möglichkeit haben, den Standard-Dialog für Ordner- und Datei-Eigenschaften aufzurufen. Alles, was wir hierfür brauchen, finden Sie hier: Datei-Eigenschaften Dialog anzeigen Fügen Sie folglich folgende Deklarationen in den Allgemein-Teil der Form ein: ' Wird benötigt, um den Datei-Eigenschaften-Dialog aufzurufen Private Declare Function ShellExecuteEx Lib "shell32.dll" ( _ LPSHELLEXECUTEINFO As SHELLEXECUTEINFO) As Long Private Type SHELLEXECUTEINFO cbSize As Long fMask As Long hWnd As Long lpVerb As String lpFile As String lpParameters As String lpDirectory As String nShow As Long hInstApp As Long lpIDList As Long lpClass As String hkeyClass As Long dwHotKey As Long hIcon As Long hProcess As Long End Type Private Const SEE_MASK_FLAG_NO_UI = &H400 Private Const SEE_MASK_INVOKEIDLIST = &HC Private Const SEE_MASK_NOCLOSEPROCESS = &H40 Beim Klick auf das "Eigenschaften"-Symbol in der Toolbar brauchen wir dann nur noch nachfolgende Prozedur aufzurufen und schon wird der Standard-Eigenschaften-Dialog angezeigt. ' Datei-Eigenschaften Dialog anzeigen Private Sub ShowFileInfoDlg(ByVal sFile As String) Dim FILEINFO As SHELLEXECUTEINFO ' Struktur füllen With FILEINFO .cbSize = Len(FILEINFO) .fMask = SEE_MASK_FLAG_NO_UI Or _ SEE_MASK_INVOKEIDLIST Or _ SEE_MASK_NOCLOSEPROCESS .hWnd = hWnd .lpVerb = "properties" .lpFile = sFile End With Call ShellExecuteEx(FILEINFO) End Sub Erweitern Sie das Toolbar1_ButtonClick-Ereignis um folgende Codezeilen: Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button) ... Case "properties" ' Datei/Ordner-Eigenschaften-Dialog anzeigen Screen.MousePointer = vbHourglass ShowFileInfoDlg lvwFiles(nList).SelectedItem.Key Screen.MousePointer = vbNormal ... End Sub Jetzt wäre es mal wieder an der Zeit, den aktuellen Stand zu testen Ordner/Dateien kopieren, verschieben und löschen Beginnen wir zunächst mit dem Löschen von Dateien und Ordnern. Die Löschfunktion selbst wird über das "Löschen"-Symbol in der Toolbar aufgerufen. Hierbei soll dann der im aktuellen ListView selektierte Eintrag gelöscht werden - egal ob Ordner oder Datei. Selbstverständlich blenden wir vor dem Löschen eine zusätzliche Sicherheitsabfrage ein, so dass nicht aus Versehen ein Ordner oder eine Datei gelöscht wird. War der Löschvorgang erfolgreich, muss das aktuelle ListView aktualisiert werden - andernfalls bekommt der Anwender den Fehler in einer MessageBox angezeigt. Erweitern Sie zunächst das Toolbar1_ButtonClick-Ereignis um folgende Codezeilen: Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button) ... Case "delete" ' Datei/Ordner löschen DeleteFileFolder ... End Sub In der DeleteFileFolder-Prozdur prüfen wir als Erstes, ob es sich bei dem zu löschenden Eintrag um einen Ordner oder um eine Datei handelt, da wir im Falle eines Ordners die Delete-Anweisung der GetFolder-Methode des FSO-Objekts aufrufen müssen, im Falle einer Datei jedoch die Delete-Anweisung der GetFile-Methode. ' Handelt es sich um eine Datei oder einen Ordner? Private Function IsFolder(ByVal sPath As String) As Boolean IsFolder = ((GetAttr(sPath) And vbDirectory) = vbDirectory) End Function ' Ordner/Datei löschen Private Sub DeleteFileFolder() Dim bFolder As Boolean Dim sPath As String Dim Index As Integer ' Ausgangsliste merken Index = nList ' Ordner oder Datei? sPath = lvwFiles(nList).SelectedItem.Key If IsFolder(sPath) Then ' Ordner löschen ' Sicherheitsabfrage If MsgBox("Beim Löschen des Ordners werden auch alle darin " & _ "enthaltenen Unterordner und Dateien gelöscht." & vbCrLf & vbCrLf & _ "Ordner jetzt löschen?", _ vbQuestion + vbYesNo + vbDefaultButton2, "Löschen") = vbYes Then ' Ordner mitsamt Unterordner und Dateien löschen On Error Resume Next oFSO.GetFolder(sPath).Delete True If Err.Number <> 0 Then ' Fehlerausgabe MsgBox "Fehler beim Löschen des Ordners!" & vbCrLf & _ CStr(Err.Number) & " - " & Err.Description, _ vbCritical + vbOKOnly, "Fehler" Else ' Refresh RefreshList nList End If End If Else ' Datei löschen ' Sicherheitsabfrage If MsgBox("Datei '" & lvwFiles(nList).SelectedItem.Text & _ "' wirklich löschen?", _ vbQuestion + vbYesNo + vbDefaultButton2, "Löschen") = vbYes Then ' Datei löschen On Error Resume Next oFSO.GetFile(sPath).Delete True If Err.Number <> 0 Then ' Fehlerausgabe MsgBox "Fehler beim Löschen der Datei!" & vbCrLf & _ CStr(Err.Number) & " - " & Err.Description, _ vbCritical + vbOKOnly, "Fehler" Else ' Refresh RefreshList nList End If End If End If ' Fokus auf Quellverzeichnis-Liste setzen nList = Index lvwFiles(nList).SetFocus End Sub Ordner/Dateien kopieren oder verschieben Machen wir weiter mit der Funktion "Ordner/Datei kopieren", lehnen uns aber erst einmal zurück und denken kurz nach: Was ist eigentlich der Unterschied zwischen "Ordner/Datei kopieren" und "Ordner/Datei verschieben"? Eigentlich doch nur der, dass beim Verschieben von Ordner/Dateien diese nach dem "Verschiebe-Vorgang" im Ausgangsverzeichnis gelöscht werden müssen. Es würde sich also anbieten für den Kopieren/Verschieben-Vorgang ein und dieselbe Prozedur zu verwenden - gesteuert von einem optionalen Parameter, der angibt, ob der Eintrag kopiert oder verschoben werden soll. Ok... nennen wir die Prozedur CopyFileFolder und deklarieren diese wie folgt: ' Datei/Ordner kopieren/verschieben Private Sub CopyFileFolder(Optional ByVal bMove As Boolean = False) End Sub Wird die Prozedur ohne Parameter aufgerufen, soll der Ordner/die Datei kopiert werden. Wird als Parameter der Wert True angegeben, soll der Ordner/die Datei verschoben werden. Erweitern wir zunächst wieder das Toolbar1_ButtonClick-Ereignis um folgenden Code: Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button) ... Case "copy" ' Datei/Ordner kopieren CopyFileFolder Case "move" ' Datei/Ordner verschieben CopyFileFolder True ... End Sub Beim Aufruf der CopyFileFolder-Prozedur legen wir zunächst den "Begriff" fest, der in den diversen Meldungsfenstern erscheinen soll: Kopieren oder Verschieben. Somit können wir für beide Aktionen ein und dieselbe Message verwenden - gesteuert von einer Variable. Als nächstes müssen wir ermitteln, von welchem Verzeichnis in welches Verzeichnis der Ordner/die Datei kopiert oder verschoben werden soll. Hierbei müssen wir prüfen, dass es sich um zwei unterschiedliche Verzeichnisse handelt, da das Kopieren/Verschieben innerhalb ein und demselben Verzeichnis nicht möglich ist. Das Kopieren des Ordners bzw. der Datei erfolgt über die Copy-Anweisung der GetFolder- bzw. GetFile-Methode des FSO-Objekts. Soll der Eintrag verschoben werden, rufen wir im Anschluss einfach die Delete-Methode auf - natürlich aber nur dann, wenn der Kopiervorgang erfolgreich war. Weiterhin sollte man dem Anwender eine entsprechende Möglichkeit geben, den Vorgang abzubrechen, falls sich im Ziel-Verzeichnis bereits ein Ordner oder eine Datei mit dem gleichen Namen befindet. ' Datei/Ordner kopieren/verschieben Private Sub CopyFileFolder(Optional ByVal bMove As Boolean = False) Dim bFolder As Boolean Dim sPath As String Dim sFolder As String Dim sDestPath As String Dim sTitle As String Dim sText As String Dim Index As Integer ' Ausgangsliste merken Index = nList ' Ziel-Ordner If nList = ListLeft Then sDestPath = lvwFiles(ListRight).Tag Else sDestPath = lvwFiles(ListLeft).Tag End If ' Titel/Text für MsgBox sTitle = IIf(bMove, "Verschieben", "Kopieren") sText = IIf(bMove, "verschieben", "kopieren") ' Falls in beiden ListViews der gleiche Ordner angezeigt ' wird, Meldung bringen, dass kein Kopieren möglich ist If sDestPath = lvwFiles(nList).Tag Then MsgBox "Fehler!" & vbCrLf & "Quell- und Zielordner sind identisch." & _ vbCrLf & vbCrLf & sTitle & " nicht möglich!", _ vbCritical + vbOKOnly, sTitle ' Prozedur verlassen Exit Sub End If ' Ordner oder Datei? sPath = lvwFiles(nList).SelectedItem.Key sFolder = lvwFiles(nList).SelectedItem.Text If IsFolder(sPath) Then ' Ordner kopieren/verschieben ' Zunächst prüfen, ob es im Zielverzeichnis ' bereits einen Ordner mit diesem Namen gibt If oFSO.FolderExists(sDestPath & sFolder) Then If MsgBox("Im Zielverzeichnis existiert bereits ein Ordner " & _ "mit dem Namen '" & sFolder & "'." & vbCrLf & vbCrLf & _ "Sollen evtl. vorhandene Dateien überschrieben werden?", _ vbCritical + vbYesNo + vbDefaultButton2, sTitle & "...") = vbNo Then ' Prozedur verlassen Exit Sub End If End If ' Sicherheitsabfrage If MsgBox("Ordner wirklich nach '" & sDestPath & "' " & sText & "?" & _ vbCrLf & vbCrLf, vbQuestion + vbYesNo + vbDefaultButton2, _ sTitle) = vbYes Then ' Ordner mitsamt Unterordner und Dateien kopieren On Error Resume Next Screen.MousePointer = vbHourglass oFSO.GetFolder(sPath).Copy sDestPath, True If Err.Number <> 0 Then ' Fehlerausgabe MsgBox "Fehler beim " & sTitle & " des Ordners!" & vbCrLf & _ CStr(Err.Number) & " - " & Err.Description, _ vbCritical + vbOKOnly, "Fehler" Else ' Falls Ordner verschoben wurde, Ordner ' jetzt im Quellverzeichnis löschen If bMove Then oFSO.GetFolder(sPath).Delete True If Err.Number <> 0 Then MsgBox "Fehler beim Löschen des Ordners!" & vbCrLf & _ CStr(Err.Number) & " - " & Err.Description, _ vbCritical + vbOKOnly, "Fehler" End If End If End If ' Refresh If bMove Then RefreshList nList RefreshList IIf(nList = ListLeft, ListRight, ListLeft) Screen.MousePointer = vbNormal End If Else ' Datei kopieren/verschieben ' Zunächst prüfen, ob es im Zielverzeichnis ' bereits eine Datei mit diesem Namen gibt If oFSO.FileExists(sDestPath & sFolder) Then If MsgBox("Im Zielverzeichnis existiert bereits eine Datei " & _ "mit dem Namen '" & sFolder & "'." & vbCrLf & vbCrLf & _ "Sollen die vorhandene Datei überschrieben werden?", _ vbCritical + vbYesNo + vbDefaultButton2, sTitle & "...") = vbNo Then ' Prozedur verlassen Exit Sub End If End If ' Sicherheitsabfrage If MsgBox("Datei wirklich nach '" & sDestPath & "' " & sText & "?", _ vbQuestion + vbYesNo + vbDefaultButton2, sTitle & "...") = vbYes Then ' Datei kopieren On Error Resume Next oFSO.GetFile(sPath).Copy sDestPath, True If Err.Number <> 0 Then ' Fehlerausgabe MsgBox "Fehler beim " & sTitle & " der Datei!" & vbCrLf & _ CStr(Err.Number) & " - " & Err.Description, _ vbCritical + vbOKOnly, "Fehler" Else ' Falls Datei verschoben wurde, Datei ' jetzt im Quellverzeichnis löschen If bMove Then oFSO.GetFile(sPath).Delete True If Err.Number <> 0 Then MsgBox "Fehler beim Löschen der Datei!" & vbCrLf & _ CStr(Err.Number) & " - " & Err.Description, _ vbCritical + vbOKOnly, "Fehler" End If End If End If ' Refresh If bMove Then RefreshList nList RefreshList IIf(nList = ListLeft, ListRight, ListLeft) End If End If ' Fokus auf Quellverzeichnis-Liste setzen nList = Index lvwFiles(nList).SetFocus End Sub Und wieder ist es an der Zeit die neuen Funktionen "Kopieren", "Verschieben" und "Löschen" zu testen Editieren und Erstellen von Textdateien Was fehlt jetzt noch? Genau: Die Möglichkeit eine Textdatei (oder auch andere Dateien) direkt im vb@rchiv Commander zu bearbeiten und auch die Möglichkeit eine neue Textdatei zu erstellen. Beginnen wir mit dem Bearbeiten einer bestehenden Datei. ' Dateien, die vom Anwender NICHT editiert werden dürfen ' Wichtig: immer in |...| setzen! Private Const sNoEditableFiles = "|EXE|DLL|COM|TLB|LIB|SRC|" In der String-Konstante sNoEditableFiles speichern wir alle Dateitypen (Extensions) in Großbuchstaben zwischen zwei PIPE-Zeichen (|), die vom Anwender nicht bearbeitet werden dürfen. Diese Liste können Sie natürlich beliebig erweitern. Das Bildsymbol in der Toolbar zum Bearbeiten einer Datei sollte immer autom. disabled/enabled dargestellt werden, je nachdem welcher Dateityp gerade im ListView markiert ist. Hierzu rufen wir im ItemClick-Ereignis des ListView-Controls unsere neue Funktion CanEdit auf: Private Sub lvwFiles_ItemClick(Index As Integer, ByVal Item As MSComctlLib.ListItem) Toolbar1.Buttons("edit").Enabled = CanEdit(Item.Key) End Sub ' Darf der Anwender die angegebene Datei editieren? Private Function CanEdit(ByVal sPath As String) As Boolean ' Editieren nur, wenn es kein Ordner ist... If Not IsFolder(sPath) Then ' ... und die Datei-Erweiterung nicht in der Liste der ' nicht editierbaren Dateien enthalten ist CanEdit = (InStr(sNoEditableFiles, _ "|" & UCase$(oFSO.GetExtensionName(sPath)) & "|") = 0) End If End Function Anmerkung: Private Sub lvwFiles_ItemClick(Index As Integer, ByVal Item As MSComctlLib.ListItem) ' Toolbar aktualisieren Dim bIsFileOrFolder As Boolean bIsFileOrFolder = (Item.SubItems(1) <> "[UP-DIR]") With Toolbar1 .Buttons("properties").Enabled = bIsFileOrFolder .Buttons("copy").Enabled = bIsFileOrFolder .Buttons("move").Enabled = bIsFileOrFolder .Buttons("delete").Enabled = bIsFileOrFolder .Buttons("edit").Enabled = CanEdit(Item.Key) End With End Sub Klickt der Anwender nun auf einen Eintrag im ListView-Control wird autom. das ItemClick-Ereignis ausgelöst und somit die Toolbar entsprechend aktualisiert. Manchmal wird ein Eintrag im ListView aber auch durch "uns" selektiert. In diesem Fall sollte die Toolbar aber ebenfalls aktualisiert werden. Entfernen Sie also die auskommentierte Anweisung in der SetListItem-Prozedur: ... ' muss aufgerufen werden, weil im ItemClick-Ereignis ' die Toolbar aktualisiert wird lvwFiles_ItemClick Index, .SelectedItem ... Vorhandene Datei editieren Kommen wir nun zum Bearbeiten einer bereits vorhandenen Datei. Beim Klick auf das "Bearbeiten"-Symbol in der Toolbar soll wie bereits erwähnt die aktuell selektierte Datei in die RichTextBox geladen werden. Danach blenden wir die RichTextBox ein, entfernen alle unnötigen Symbole aus der Toolbar und zeigen stattdessen ein neues Symbol der Toolbar an: das "Speichern"-Symbol. Erweitern Sie zunächst das Toolbar1_ButtonClick-Ereignis um folgende Codezeilen: Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button) ... Case "edit" ' Datei editieren FileEdit ... End Sub In der Prozedur FileEdit merken wir uns zunächst den Pfad+Dateinamen der zu bearbeitenden Datei. Weiterhin soll beim Beenden des Edit-Modus geprüft werden, ob der Text verändert wurde, um somit dem Anwender die Möglichkeit zu geben, die Änderung noch speichern zu können. Hierfür brauchen wir zwei neue Variablen, die im Allgemein-Teil der Form deklariert werden: ' Flag, ob Text im integrierten Editor verändert wurde Private bTextChanged As Boolean ' Name der Datei merken, die gerade editiert wird Private sEditFile As String Noch ein Gedanke, bevor wir loslegen: Da wir ja das RichTextBox-Control verwenden, sollten wir deren"Spezial-Funktion" auch auszunutzen und einen RTF-Text nicht als "Plain-Text", sondern eben als rtf-formatierten Text anzeigen. Hierzu prüfen wir die Dateierweiterungder zu bearbeiten Datei. Handelt es sich um eine RTF-Datei, öffnen wir diese mit dem Flag rtfRTF, andernfalls mit dem Flag rtfText. ' Textdatei editieren Private Sub FileEdit() Dim nFormat As RichTextLib.LoadSaveConstants Dim i As Integer Dim oControl As Control ' TXT oder RTF? sEditFile = lvwFiles(nList).SelectedItem.Key If UCase$(oFSO.GetExtensionName(sEditFile)) = "RTF" Then nFormat = rtfRTF Else nFormat = rtfText End If ' Text in RichTextBox laden On Error Resume Next rtfEdit.LoadFile sEditFile, nFormat If Err.Number <> 0 Then ' Fehler! MsgBox "Fehler beim Öffnen von '" & sEditFile & "'" & vbCrLf & _ CStr(Err.Number) & " - " & Err.Description, _ vbCritical + vbOKOnly, "Editieren..." ' Prozedur verlassen Exit Sub End If ' RichTextBox einblenden rtfEdit.Visible = True rtfEdit.SetFocus ' Toolbar: alle Buttons bis auf Speichern und Beenden ausblenden With Toolbar1 For i = 2 To .Buttons.Count If .Buttons(i).Key = "save" Then .Buttons(i).Visible = True Exit For Else .Buttons(i).Visible = False End If Next i End With ' alle Controls bis auf RichTextBox und Toolbar disablen ' (wegen TAB-Taste!) For Each oControl In Me.Controls Select Case TypeName(oControl) Case "RichTextBox", "Toolbar", "ImageList" Case Else oControl.Enabled = False End Select Next ' Titelzeile ändern Me.Caption = Me.Caption & " - Edit [" & sEditFile & "]" ' Flag, ob Text verändert wurde auf FALSE setzen bTextChanged = False End Sub Sobald der Anwender den Text verändert, setzen wir die Variable bTextChanged auf den Wert True: Private Sub rtfEdit_Change() ' Text wurde verändert: Flag setzen bTextChanged = True End Sub Über das "neue" Speichern-Symbol in der Toolbar soll der aktuelle Text gespeichert werden - entweder im RTF-Format, falls es sich um eine RTF-Datei handelt, oder im TXT-Format: ' Text speichern Private Function FileSave() As Boolean Dim nFormat As RichTextLib.LoadSaveConstants ' TXT oder RTF? If UCase$(oFSO.GetExtensionName(sEditFile)) = "RTF" Then nFormat = rtfRTF Else nFormat = rtfText End If ' Text in RichTextBox laden On Error Resume Next rtfEdit.SaveFile sEditFile, nFormat If Err.Number <> 0 Then ' Fehler! MsgBox "Fehler beim Speichern von '" & sEditFile & "'" & vbCrLf & _ CStr(Err.Number) & " - " & Err.Description, _ vbCritical + vbOKOnly, "Editieren..." ' Prozedur verlassen FileSave = False Else FileSave = True ' Dateigröße im ListView aktualisieren With lvwFiles(nList).SelectedItem ' neue Dateigröße anzeigen .SubItems(1) = oFSO.GetFile(sEditFile).Size End With End If On Error GoTo 0 End Function Erweitern wir das Toolbar1_ButtonClick-Ereignis demnach um folgende Anweisung: Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button) ... Case "save" ' Datei im Editor speichern If FileSave() Then bTextChanged = False ... End Sub Fehlt jetzt nur noch der Code, um den Edit-Modus zu verlassen. Hierzu muss der Anwender auf das Schließen-Symbol in der Toolbar klicken, das in diesem Fall zwei Funktionen hat:
Diese Unterscheidung lässt sich leicht abfragen: Wir brauchen lediglich zu prüfen, ob das RichTextBox-Control sichtbar auf der Form angezeigt wird. Erweitern wir das Toolbar1_ButtonClick-Ereignis demnach um folgende Anweisung: Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button) ... Case "exit" ' Falls EditMode -> Editor beenden If rtfEdit.Visible Then FileEditExit Else ' Anwendung beenden Unload Me End If ... End Sub Die Prozedur FileEditExit macht folgendes:
' Editor beenden (ggf. vorher speichern) Private Sub FileEditExit() Dim bClose As Boolean Dim i As Integer Dim oControl As Control bClose = True ' Speichern? If bTextChanged Then Select Case MsgBox("Änderungen am Text speichern?", _ vbInformation + vbYesNoCancel, "Beenden") Case vbYes ' Speichern und Editor schließen bClose = FileSave() Case vbNo ' Editor schließen Case Else ' Abbrechen: Editor geöffnet lassen bClose = False End Select End If If bClose Then rtfEdit.Text = "" rtfEdit.Visible = False ' Toolbar aktualisieren With Toolbar1 For i = 2 To .Buttons.Count If .Buttons(i).Key = "save" Then .Buttons(i).Visible = False Exit For Else .Buttons(i).Visible = True End If Next i End With ' alle Controls wieder enablen For Each oControl In Me.Controls Select Case TypeName(oControl) Case "RichTextBox", "Toolbar", "ImageList" Case Else oControl.Enabled = True End Select Next ' Titelzeile wieder zurücksetzen Me.Caption = Left$(Me.Caption, InStr(Me.Caption, " - Edit") - 1) ' Fokus auf ListView setzen lvwFiles(nList).SetFocus End If End Sub Wenn Sie möchten, testen Sie die neue "Edit-Funktion" gleich aus, bevor wir uns der letzten Funktion, dem Erstellen und Bearbeiten einer neuen Textdatei widmen. Neue Textdatei erstellen und editieren Ja, wie wird das wohl gehen? Da die neue Datei sofort physikalisch auf dem Datenträger erstellt wird, ist diese logischerweise dann auch vorhanden - und zwar mit der Größe: 0 Bytes. Und wie man eine vorhandene Datei editiert, das haben wir ja soeben ausführlich erörtert. Erweitern Sie zunächst das Toolbar1_ButtonClick-Ereignis um folgende Codezeilen: Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button) ... Case "textnew" ' Neue Textdatei erstellen FileCreateNew ... End Sub Beim Aufruf der FileCreateNewFileEdit-Prozedur wird die Standard InputBox aufgerufen. ' Neue Textdatei erstellen Private Sub FileCreateNew() Dim sFile As String Dim sPath As String Dim F As Integer ' Dateiname über INPUTBOX eingeben sFile = InputBox("Bitte geben Sie jetzt den Dateinamen der neu " & _ "zu erstellenden Datei ein." & vbCrLf & "(Beispiel: meintext.txt)", _ "Neue Datei erstellen") If sFile <> "" Then ' Prüfen, ob Datei schon existiert sPath = AppendSlash(lvwFiles(nList).Tag) If oFSO.FileExists(sPath & sFile) Then If MsgBox("Es existiert bereits eine Datei '" & sFile & "'." & vbCrLf & _ "Möchten Sie die vorhandene Datei jetzt bearbeiten?", _ vbQuestion + vbYesNo, "Datei erstellen") = vbYes Then ' Datei im ListView selektieren und Editor öffnen SetListItem nList, sPath & sFile FileEdit ' Prozedur verlassen Exit Sub End If End If ' Datei erstellen und Editor starten On Error Resume Next F = FreeFile Open sPath & sFile For Output As #F If Err.Number <> 0 Then ' Fehler! MsgBox "Fehler beim Versuch die Datei '" & sFile & "' " & _ "zu erstellen." & vbCrLf & _ CStr(Err.Number) & " - " & Err.Description, _ vbCritical + vbOKOnly, "Datei erstellen" Else ' Datei schließen Close #F ' Liste aktualisieren RefreshList nList ' Datei im ListView selektieren und Editor öffnen SetListItem nList, sPath & sFile FileEdit End If End If End Sub Nachdem nun auch das Erstellen von neuen Textdateien möglich ist, starten Sie das Projekt und probieren es aus. Schlusswort Hiermit hätten wir alle eingangs im Workshop geforderten und gewünschten Funktionen realisiert. Selbstverständlich lässt sich der vb@rchiv Commander noch um zahlreiche Funktionen erweitern, was aber leider den Rahmen dieses Workshops sprengen würde. Nachfolgend eine kleine Liste mit Funktionen, die Sie ja vielleicht selbst noch realisieren möchten:
Dieser Workshop wurde bereits 59.619 mal aufgerufen.
Anzeige
Diesen und auch alle anderen Workshops 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! sevDTA 3.0 Pro SEPA mit Kontonummernprüfung Erstellen von SEPA-Dateien mit integriertem BIC-Verzeichnis und Konto- nummern-Prüfverfahren, so dass ungültige Bankdaten bereits im Vorfeld ermittelt werden können. Tipp des Monats September 2024 Dieter Otter Übergabeparameter: String oder Array? Mit der IsArray-Funktion lässt sich prüfen, ob es sich bei einem Übergabeparameter an eine Prozedur um ein Array oder einer "einfachen" Variable handelt. 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. |