FSO系列之六**示例代码之详细代码2

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''
'' GenerateAllFolderInformation
''
'' 目的：
''
'' 生成一个字符串，来描述一个文件夹和所有文件及子文件夹的当前状态。
''
'' 示范下面的内容
''
'' - Folder.Path
'' - Folder.SubFolders
'' - Folders.Count
''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Function GenerateAllFolderInformation(Folder)

    Dim S
    Dim SubFolders
    Dim SubFolder
    Dim Files
    Dim File

    S = "Folder:" & TabStop & Folder.Path & NewLine & NewLine

    Set Files = Folder.Files

    If 1 = Files.Count Then
        S = S & "There is 1 file" & NewLine
    Else
        S = S & "There are " & Files.Count & " files" & NewLine
    End If

    If Files.Count <> 0 Then

        For Each File In Files
            S = S & GenerateFileInformation(File)
        Next

    End If

    Set SubFolders = Folder.SubFolders

    If 1 = SubFolders.Count Then
        S = S & NewLine & "There is 1 sub folder" & NewLine & NewLine
    Else
        S = S & NewLine & "There are " & SubFolders.Count & " sub folders" & NewLine & NewLine
    End If

    If SubFolders.Count <> 0 Then

        For Each SubFolder In SubFolders
            S = S & GenerateFolderInformation(SubFolder)
        Next

        S = S & NewLine

        For Each SubFolder In SubFolders
            S = S & GenerateAllFolderInformation(SubFolder)
        Next

    End If

    GenerateAllFolderInformation = S

End Function

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''
'' GenerateTestInformation
''
'' 目的：
''
'' 生成一个字符串，来描述 C:\Test 文件夹和所有文件及子文件夹的当前状态。
''
'' 示范下面的内容
''
'' - FileSystemObject.DriveExists
'' - FileSystemObject.FolderExists
'' - FileSystemObject.GetFolder
''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Function GenerateTestInformation(FSO)

    Dim TestFolder
    Dim S

    If Not FSO.DriveExists(TestDrive) Then Exit Function
    If Not FSO.FolderExists(TestFilePath) Then Exit Function

    Set TestFolder = FSO.GetFolder(TestFilePath)

    GenerateTestInformation = GenerateAllFolderInformation(TestFolder)

End Function


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''
'' DeleteTestDirectory
''
'' 目的：
''
'' 清理 test 目录。
''
'' 示范下面的内容
''
'' - FileSystemObject.GetFolder
'' - FileSystemObject.DeleteFile
'' - FileSystemObject.DeleteFolder
'' - Folder.Delete
'' - File.Delete
''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Sub DeleteTestDirectory(FSO)

    Dim TestFolder
    Dim SubFolder
    Dim File
    
    '' 有两种方法可用来删除文件：

    FSO.DeleteFile(TestFilePath & "\Beatles\OctopusGarden.txt")

    Set File = FSO.GetFile(TestFilePath & "\Beatles\BathroomWindow.txt")
    File.Delete    



    '' 有两种方法可用来删除文件夹：

    FSO.DeleteFolder(TestFilePath & "\Beatles")

    FSO.DeleteFile(TestFilePath & "\ReadMe.txt")

    Set TestFolder = FSO.GetFolder(TestFilePath)
    TestFolder.Delete

End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''
'' CreateLyrics
''
'' 目的：
''
'' 在文件夹中创建两个文本文件。
''
''
'' 示范下面的内容
''
'' - FileSystemObject.CreateTextFile
'' - TextStream.WriteLine
'' - TextStream.Write
'' - TextStream.WriteBlankLines
'' - TextStream.Close
''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Sub CreateLyrics(Folder)

    Dim TextStream
    
    Set TextStream = Folder.CreateTextFile("OctopusGarden.txt")
    
    TextStream.Write("Octopus'' Garden ") '' 请注意，该语句不添加换行到文件中。
    TextStream.WriteLine("(by 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 = Folder.CreateTextFile("BathroomWindow.txt")
    TextStream.WriteLine("She Came In Through The Bathroom Window (by 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

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''
'' GetLyrics
''
'' 目的：
''
'' 显示 lyrics 文件的内容。
''
''
'' 示范下面的内容
''
'' - FileSystemObject.OpenTextFile
'' - FileSystemObject.GetFile
'' - TextStream.ReadAll
'' - TextStream.Close
'' - File.OpenAsTextStream
'' - TextStream.AtEndOfStream
'' - TextStream.ReadLine
''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Function GetLyrics(FSO)

    Dim TextStream
    Dim S
    Dim File

    '' 有多种方法可用来打开一个文本文件，和多种方法来从文件读取数据。
    '' 这儿用了两种方法来打开文件和读取文件：

    Set TextStream = FSO.OpenTextFile(TestFilePath & "\Beatles\OctopusGarden.txt", OpenFileForReading)
    
    S = TextStream.ReadAll & NewLine & NewLine
    TextStream.Close

    Set File = FSO.GetFile(TestFilePath & "\Beatles\BathroomWindow.txt")
    Set TextStream = File.OpenAsTextStream(OpenFileForReading)
    Do     While Not TextStream.AtEndOfStream
        S = S & TextStream.ReadLine & NewLine
    Loop
    TextStream.Close

    GetLyrics = S
    
End Function


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''
'' BuildTestDirectory
''
'' 目的：
''
'' 创建一个目录分层结构来示范 FileSystemObject。
''
'' 以这样的次序来创建分层结构：
''
'' C:\Test
'' C:\Test\ReadMe.txt
'' C:\Test\Beatles
'' C:\Test\Beatles\OctopusGarden.txt
'' C:\Test\Beatles\BathroomWindow.txt
''
''
'' 示范下面的内容
''
'' - FileSystemObject.DriveExists
'' - FileSystemObject.FolderExists
'' - FileSystemObject.CreateFolder
'' - FileSystemObject.CreateTextFile
'' - Folders.Add
'' - Folder.CreateTextFile
'' - TextStream.WriteLine
'' - TextStream.Close
''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Function BuildTestDirectory(FSO)
    
    Dim TestFolder
    Dim SubFolders
    Dim SubFolder
    Dim TextStream

    '' 排除(a)驱动器不存在，或(b)要创建的目录已经存在的情况。

    If Not FSO.DriveExists(TestDrive) Then
        BuildTestDirectory = False
        Exit Function
    End If

    If FSO.FolderExists(TestFilePath) Then
        BuildTestDirectory = False
        Exit Function
    End If

    Set TestFolder = FSO.CreateFolder(TestFilePath)

    Set TextStream = FSO.CreateTextFile(TestFilePath & "\ReadMe.txt")
    TextStream.WriteLine("My song lyrics collection")
    TextStream.Close

    Set SubFolders = TestFolder.SubFolders

    Set SubFolder = SubFolders.Add("Beatles")

    CreateLyrics SubFolder    

    BuildTestDirectory = True

End Function



''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''
'' 主程序
''
'' 首先，它创建一个 test 目录，以及一些子文件夹和文件。
'' 然后，它转储有关可用磁盘驱动器和 test 目录的某些信息，
'' 最后，清除 test 目录及其所有内容。
''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Sub Main

    Dim FSO

    '' 设立全局变量。
    TabStop = Chr(9)
    NewLine = Chr(10)
    
    Set FSO = CreateObject("Scripting.FileSystemObject")

    If Not BuildTestDirectory(FSO) Then
        Print "Test directory already exists or cannot be created.  Cannot continue."
        Exit Sub
    End If
    
    Print GenerateDriveInformation(FSO) & NewLine & NewLine

    Print GenerateTestInformation(FSO) & NewLine & NewLine

    Print GetLyrics(FSO) & NewLine & NewLine

    DeleteTestDirectory(FSO)
    
End Sub