'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 

' 

' 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