'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' ' FileSystemObject-Beispielcode ' ' Copyright 1998 Microsoft Corporation. Alle Rechte vorbehalten. ' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Option Explicit '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' ' Informationen zur Codequalität: ' ' 1) Der folgende Code führt eine Anzahl von Zeichenfolgenmanipulationen ' aus. Dabei werden kurze Zeichenfolgen mit dem Operator "&" verkettet. ' Da Zeichenfolgenverkettungen lange dauern, ist dieser Code nicht sehr ' effizient. Es ist jedoch ein sehr gängiger Weg zum Schreiben von Code. ' Dieser Weg wird hier verwendet, da dieses Programm intensive Fest- ' plattenoperationen ausführt und diese Operationen wesentlich langsamer ' als die Operationen zum Verketten der Zeichenfolgen im Speicher sind. ' Beachten Sie auch, dass dieser Code zu Demonstrationszwecken geschrieben ' wurde. ' ' 2) Es wird "Option Explicit" verwendet, da der Zugriff auf deklarierte ' Variablen etwas schneller als der Zugriff auf undeklarierte Variablen ' ist. Außerdem wird so das Entstehen von Fehlern im Code verhindert, ' wie z. B. durch den Schreibfehler DriveTypeCDORM statt DriveTypeCDROM. ' ' 3) In diesem Code wurde keine Fehlerbehandlung vorgesehen. Der Code ist ' so besser lesbar. Obwohl Vorkehrungen zum Verhindern von Fehlern in ' normalen Fällen getroffen wurden, können sich Dateisysteme eventuell ' unvorhersehbar verhalten. In kommerziellem Code sollten Sie "On Error ' Resume Next" und das Err-Objekt verwenden, um mögliche Fehler abzufangen. ' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' ' Einige hilfreiche globale Variablen ' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Dim Tabulator Dim NeueZeile Const TestLW = "C" Const TestDateiPfad = "C:\Test" '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' ' Von Drive.DriveType zurückgegebene Konstanten ' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Const DriveTypeWechselbar = 1 Const DriveTypeFest = 2 Const DriveTypeNetzwerk = 3 Const DriveTypeCDROM = 4 Const DriveTypeRAMLW = 5 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' ' Von File.Attributes zurückgegebene Konstanten ' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Const AttributNormal = 0 Const AttributSchreibgesch = 1 Const AttributVersteckt = 2 Const AttributSystem = 4 Const AttributDatentr = 8 Const AttributVerzeichnis = 16 Const AttributArchiv = 32 Const AttributAlias = 64 Const AttributKomprimiert = 128 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' ' Konstanten zum Öffnen von Dateien ' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Const DateiOeffnenZumLesen = 1 Const DateiOeffnenZumSchreiben = 2 Const DateiOeffnenZumAnfuegen = 8 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' ' ZeigeLWTyp ' ' Zweck: ' ' Erstellt eine Zeichenfolge, die den Laufwerktyp eines angegebenen Drive-Objekts beschreibt. ' ' Zeigt Folgendes ' ' - Drive.DriveType ' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Function ZeigeLWTyp(LW) Dim S Select Case LW.DriveType Case DriveTypeWechselbar S = "Wechselmedium" Case DriveTypeFest S = "Fest" Case DriveTypeNetzwerk S = "Netzwerk" Case DriveTypeCDROM S = "CD-ROM" Case DriveTypeRAMLW S = "RAM-Laufwerk" Case Else S = "Unbekannt" End Select ZeigeLWTyp = S End Function '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' ' ZeigeDateiAttribute ' ' Zweck: ' ' Erstellt eine Zeichenfolge, die Datei- oder Ordnerattribute beschreibt. ' ' Zeigt Folgendes ' ' - File.Attributes ' - Folder.Attributes ' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Function ZeigeDateiAttribute(Datei) ' Datei kann Datei oder Ordner sein Dim S Dim Attr Attr = Datei.Attributes If Attr = 0 Then ZeigeDateiAttribute = "Normal" Exit Function End If If Attr And AttributVerzeichnis Then S = S & "Verzeichnis " If Attr And AttributSchreibgesch Then S = S & "Schreibgeschützt " If Attr And AttributVersteckt Then S = S & "Versteckt " If Attr And AttributSystem Then S = S & "System " If Attr And AttributDatentr Then S = S & "Datenträger " If Attr And AttributArchiv Then S = S & "Archiv " If Attr And AttributAlias Then S = S & "Alias " If Attr And AttributKomprimiert Then S = S & "Komprimiert " ZeigeDateiAttribute = S End Function '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' ' ErzeugeLWInformation ' ' Zweck: ' ' Erstellt eine Zeichenfolge, die den aktuellen Status der verfügbaren Laufwerke beschreibt. ' ' Zeigt Folgendes ' ' - FileSystemObject.Drives ' - Iteration der Drives-Auflistung ' - Drives.Count ' - Drive.AvailableSpace ' - Drive.DriveLetter ' - Drive.DriveType ' - Drive.FileSystem ' - Drive.FreeSpace ' - Drive.IsReady ' - Drive.Path ' - Drive.SerialNumber ' - Drive.ShareName ' - Drive.TotalSize ' - Drive.VolumeName ' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Function ErzeugeLWInformation(FSO) Dim LWs Dim LW Dim S Set LWs = FSO.Drives S = "Anzahl der Laufwerke:" & Tabulator & LWs.Count & NeueZeile & NeueZeile ' Erstellt die erste Zeile des Berichts. S = S & String(2, Tabulator) & "Laufwerk" S = S & String(3, Tabulator) & "Datei" S = S & Tabulator & "Gesamt" S = S & Tabulator & "Frei" S = S & Tabulator & "Verfügbar" S = S & Tabulator & "Seriennummer" & NeueZeile ' Erstellt die zweite Zeile des Berichts. S = S & "Laufwerkbuchstabe" S = S & Tabulator & "Pfad" S = S & Tabulator & "Typ" S = S & Tabulator & "Bereit?" S = S & Tabulator & "Name" S = S & Tabulator & "System" S = S & Tabulator & "Speicherplatz" S = S & Tabulator & "Speicherplatz" S = S & Tabulator & "Speicherplatz" S = S & Tabulator & "Nummer" & NeueZeile ' Trennlinie. S = S & String(105, "-") & NeueZeile For Each LW In LWs S = S & LW.DriveLetter S = S & Tabulator & LW.Path S = S & Tabulator & ZeigeLWTyp(LW) S = S & Tabulator & LW.IsReady If LW.IsReady Then If DriveTypeNetzwerk = LW.DriveType Then S = S & Tabulator & LW.ShareName Else S = S & Tabulator & LW.VolumeName End If S = S & Tabulator & LW.FileSystem S = S & Tabulator & LW.TotalSize S = S & Tabulator & LW.FreeSpace S = S & Tabulator & LW.AvailableSpace S = S & Tabulator & Hex(LW.SerialNumber) End If S = S & NeueZeile Next ErzeugeLWInformation = S End Function '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' ' ErzeugeDateiInformation ' ' Zweck: ' ' Erstellt eine Zeichenfolge, die den aktuellen Status einer Datei beschreibt. ' ' Zeigt Folgendes ' ' - File.Path ' - File.Name ' - File.Type ' - File.DateCreated ' - File.DateLastAccessed ' - File.DateLastModified ' - File.Size ' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Function ErzeugeDateiInformation(Datei) Dim S S = NeueZeile & "Pfad:" & Tabulator & Datei.Path S = S & NeueZeile & "Name:" & Tabulator & Datei.Name S = S & NeueZeile & "Typ:" & Tabulator & Datei.Type S = S & NeueZeile & "Attribute:" & Tabulator & ZeigeDateiAttribute(Datei) S = S & NeueZeile & "Erstellt:" & Tabulator & Datei.DateCreated S = S & NeueZeile & "Letzter Zugriff:" & Tabulator & Datei.DateLastAccessed S = S & NeueZeile & "Letzte Änderung:" & Tabulator & Datei.DateLastModified S = S & NeueZeile & "Größe" & Tabulator & Datei.Size & NeueZeile ErzeugeDateiInformation = S End Function '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' ' ErzeugeOrdnerInformation ' ' Zweck: ' ' Erstellt eine Zeichenfolge, die den aktuellen Status eines Ordners beschreibt. ' ' Zeigt Folgendes ' ' - Folder.Path ' - Folder.Name ' - Folder.DateCreated ' - Folder.DateLastAccessed ' - Folder.DateLastModified ' - Folder.Size ' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Function ErzeugeOrdnerInformation(Ordner) Dim S S = "Pfad:" & Tabulator & Ordner.Path S = S & NeueZeile & "Name:" & Tabulator & Ordner.Name S = S & NeueZeile & "Attribute:" & Tabulator & ZeigeDateiAttribute(Ordner) S = S & NeueZeile & "Erstellt:" & Tabulator & Ordner.DateCreated S = S & NeueZeile & "Letzter Zugriff:" & Tabulator & Ordner.DateLastAccessed S = S & NeueZeile & "Letzte Änderung:" & Tabulator & Ordner.DateLastModified S = S & NeueZeile & "Größe:" & Tabulator & Ordner.Size & NeueZeile ErzeugeOrdnerInformation = S End Function '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' ' ErzeugeAlleOrdnerInformationen ' ' Zweck: ' ' Erstellt eine Zeichenfolge, die den aktuellen Status eines Ordners ' und all seiner Dateien und untergeordneten Ordner beschreibt. ' ' Zeigt Folgendes ' ' - Folder.Path ' - Folder.SubFolders ' - Folders.Count ' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Function ErzeugeAlleOrdnerInformationen(Ordner) Dim S Dim UnterOrdnerAuflistung Dim UnterOrdner Dim Dateien Dim Datei S = "Ordner:" & Tabulator & Ordner.Path & NeueZeile & NeueZeile Set Dateien = Ordner.Files If 1 = Dateien.Count Then S = S & "Es ist 1 Datei vorhanden" & NeueZeile Else S = S & "Es sind " & Dateien.Count & "Dateien vorhanden" & NeueZeile End If If Dateien.Count <> 0 Then For Each Datei In Dateien S = S & ErzeugeDateiInformation(Datei) Next End If Set UnterOrdnerAuflistung = Ordner.SubFolders If 1 = UnterOrdnerAuflistung.Count Then S = S & NeueZeile & "Es ist 1 Unterordner vorhanden" & NeueZeile & NeueZeile Else S = S & NeueZeile & "Es sind" & UnterOrdnerAuflistung.Count & "Unterordner vorhanden" & NeueZeile & NeueZeile End If If UnterOrdnerAuflistung.Count <> 0 Then For Each UnterOrdner In UnterOrdnerAuflistung S = S & ErzeugeOrdnerInformation(UnterOrdner) Next S = S & NeueZeile For Each UnterOrdner In UnterOrdnerAuflistung S = S & ErzeugeAlleOrdnerInformationen(UnterOrdner) Next End If ErzeugeAlleOrdnerInformationen = S End Function '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' ' ErzeugeTestInformation ' ' Zweck: ' ' Erstellt eine Zeichenfolge, die den aktuellen Status des Ordners C:\Test ' und all seiner Dateien und untergeordneten Ordner beschreibt. ' ' Zeigt Folgendes ' ' - FileSystemObject.DriveExists ' - FileSystemObject.FolderExists ' - FileSystemObject.GetFolder ' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Function ErzeugeTestInformation(FSO) Dim TestOrdner Dim S If Not FSO.DriveExists(TestLW) Then Exit Function If Not FSO.FolderExists(TestDateiPfad) Then Exit Function Set TestOrdner = FSO.GetFolder(TestDateiPfad) ErzeugeTestInformation = ErzeugeAlleOrdnerInformationen(TestOrdner) End Function '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' ' LoescheTestVerzeichnis ' ' Zweck: ' ' Bereinigt das Testverzeichnis. ' ' Zeigt Folgendes ' ' - FileSystemObject.GetFolder ' - FileSystemObject.DeleteFile ' - FileSystemObject.DeleteFolder ' - Folder.Delete ' - File.Delete ' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Sub LoescheTestVerzeichnis(FSO) Dim TestOrdner Dim UnterOrdner Dim Datei ' Zwei Möglichkeiten, eine Datei zu löschen: FSO.DeleteFile(TestDateiPfad & "\Beatles\OctopusGarden.txt") Set Datei = FSO.GetFile(TestDateiPfad & "\Beatles\BathroomWindow.txt") Datei.Delete ' Zwei Möglichkeiten, einen Ordner zu löschen: FSO.DeleteFolder(TestDateiPfad & "\Beatles") FSO.DeleteFile(TestDateiPfad & "\Liesmich.txt") Set TestOrdner = FSO.GetFolder(TestDateiPfad) TestOrdner.Delete End Sub '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' ' ErzeugeLiedText ' ' Zweck: ' ' Erstellt mehrere Textdateien in einem Ordner. ' ' ' Zeigt Folgendes ' ' - FileSystemObject.CreateTextFile ' - TextStream.writeLine ' - TextStream.write ' - TextStream.writeBlankLines ' - TextStream.Close ' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Sub ErzeugeLiedText(Ordner) Dim TextStream Set TextStream = Ordner.CreateTextFile("OctopusGarden.txt") TextStream.write("Octopus' Garden") ' Beachten Sie, dass der Datei kein Zeilenvorschub hinzugefügt wird. TextStream.WriteLine("(von Ringo Starr)") TextStream.writeBlankLines(1) TextStream.writeLine("I'd like to be under the sea, in an octopus' garden in the shade,") TextStream.writeLine("He'd let us in, knows where we've been - in his octopus' garden in the shade.") TextStream.writeBlankLines(2) TextStream.Close Set TextStream = Ordner.CreateTextFile("BathroomWindow.txt") TextStream.writeLine("She Came In Through The Bathroom Window (von Lennon/McCartney)") TextStream.writeLine("") TextStream.writeLine("She came in through the bathroom window, protected by a silver spoon") TextStream.writeLine("But now she sucks her thumb and wanders by the banks of her own lagoon") TextStream.writeBlankLines(2) TextStream.Close End Sub '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' ' HoleLiedText ' ' Zweck: ' ' Zeigt den Inhalt der Liedtexte an. ' ' ' Zeigt Folgendes ' ' - FileSystemObject.OpenTextFile ' - FileSystemObject.GetFile ' - TextStream.ReadAll ' - TextStream.Close ' - File.OpenAsTextStream ' - TextStream.AtEndOfStream ' - TextStream.ReadLine ' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Function HoleLiedText(FSO) Dim TextStream Dim S Dim Datei ' Es gibt verschiedene Möglichkeiten, eine Textdatei zu öffnen und die ' Daten dieser Datei zu lesen. Hier sind zwei Möglichkeiten: Set TextStream = FSO.OpenTextFile(TestDateiPfad & "\Beatles\OctopusGarden.txt", DateiOeffnenZumLesen) S = TextStream.ReadAll & NeueZeile & NeueZeile TextStream.Close Set Datei = FSO.GetFile(TestDateiPfad & "\Beatles\BathroomWindow.txt") Set TextStream = Datei.OpenAsTextStream(DateiOeffnenZumLesen) Do While Not TextStream.AtEndOfStream S = S & TextStream.ReadLine & NeueZeile Loop TextStream.Close HoleLiedText = S End Function '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' ' ErzeugeTestVerzeichnis ' ' Zweck: ' ' Erstellt eine Verzeichnishierarchie, um das FileSystemObject-Objekt zu beschreiben. ' ' Die Hierarchie wird in dieser Reihenfolge erstellt: ' ' C:\Test ' C:\Test\Liesmich.txt ' C:\Test\Beatles ' C:\Test\Beatles\OctopusGarden.txt ' C:\Test\Beatles\BathroomWindow.txt ' ' ' Zeigt Folgendes ' ' - FileSystemObject.DriveExists ' - FileSystemObject.FolderExists ' - FileSystemObject.CreateFolder ' - FileSystemObject.CreateTextFile ' - Folders.Add ' - Folder.CreateTextFile ' - TextStream.writeLine ' - TextStream.Close ' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Function ErzeugeTestVerzeichnis(FSO) Dim TestOrdner Dim UnterOrdnerAuflistung Dim UnterOrdner Dim TextStream ' Bricht ab, wenn (a) das Laufwerk nicht vorhanden oder (b) das zu erstellende Verzeichnis bereits ' vorhanden ist. If Not FSO.DriveExists(TestLW) Then ErzeugeTestVerzeichnis = False Exit Function End If If FSO.FolderExists(TestDateiPfad) Then ErzeugeTestVerzeichnis = False Exit Function End If Set TestOrdner = FSO.CreateFolder(TestDateiPfad) Set TextStream = FSO.CreateTextFile(TestDateiPfad & "\Liesmich.txt") TextStream.writeLine("Meine Liedtextsammlung") TextStream.Close Set UnterOrdnerAuflistung = TestOrdner.SubFolders Set UnterOrdner = UnterOrdnerAuflistung.Add("Beatles") ErzeugeLiedText UnterOrdner ErzeugeTestVerzeichnis = True End Function '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' ' Die Hauptroutine ' ' Zunächst wird ein Testverzeichnis mit einigen Unterordnern und Dateien erstellt. ' Anschließend werden Informationen über die verfügbaren Festplattenlaufwerke und ' über das Testverzeichnis ausgegeben und danach alles wieder entfernt. ' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Sub Main Dim FSO ' Einrichten globaler Daten. Tabulator = Chr(9) NeueZeile = Chr(10) Set FSO = CreateObject("Scripting.FileSystemObject") If Not ErzeugeTestVerzeichnis(FSO) Then Ausgabe "Testverzeichnis ist bereits vorhanden oder kann nicht erstellt werden. Fortsetzung nicht möglich." Exit Sub End If Ausgabe ErzeugeLWInformation(FSO) & NeueZeile & NeueZeile Ausgabe ErzeugeTestInformation(FSO) & NeueZeile & NeueZeile Ausgabe HoleLiedText(FSO) & NeueZeile & NeueZeile LoescheTestVerzeichnis(FSO) End Sub