请注意，由于该代码是极一般的，所以要使该代码能够真正在您的机器上运行，可能需要一些其他代码和小小的变更。这些改变之所以必要，是因为在 Active Server Pages 和 Windows Scripting Host 之间，为输入和输出给用户采用了不同的方法。
要在 Active Server Pages 上运行该代码，则采取以下步骤：
创建一个标准的 Web 页，后缀名为 .asp。
把下面的示例代码复制到 ltBODY>.../BODY> 标记之间的文件中。
把所有代码包装器到 %...%> 标记内。
把 Option Explicit 语句从当前位置移动到 HTML 页的最顶部，甚至在 HTML> 开始标记前。
把 %...%> 标记放置在 Option Explicit 语句周围，以保证它在服务器端运行。
把下面的代码添加到示例代码末尾：
Sub Print(x) Response.Write "PRE>ltFONT FACE=""宋体"" SIZE=""1"">" Response.Write x Response.Write "/FONT>/PRE>" End Sub Main 前面的代码增加一个将在服务器端运行，但在客户端显示结果的打印过程。要在 Windows Scripting Host 上运行该代码，则把下面的代码添加到示例代码的末尾： Sub Print(x) WScript.Echo x End Sub Main 下面就是示例代码：
Select Case Drive.DriveType Case DriveTypeRemovable S = "Removable" Case DriveTypeFixed S = "Fixed" Case DriveTypeNetwork S = "Network" Case DriveTypeCDROM S = "CD-ROM" Case DriveTypeRAMDisk S = "RAM Disk" Case Else S = "Unknown" End Select ShowDriveType = SEnd Function'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''
' ShowFileAttr ' 目的： ' 生成一个字符串，来描述文件或文件夹的属性。 ' 示范下面的内容 ' - File.Attributes ' - Folder.Attributes '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ''''Function ShowFileAttr(File) ' File 可以是文件或文件夹 Dim S Dim Attr
Attr = File.Attributes If Attr = 0 Then ShowFileAttr = "Normal" Exit Function End If If Attr And FileAttrDirectory Then S = S "Directory " If Attr And FileAttrReadOnly Then S = S "Read-Only " If Attr And FileAttrHidden Then S = S "Hidden " If Attr And FileAttrSystem Then S = S "System " If Attr And FileAttrVolume Then S = S "Volume " If Attr And FileAttrArchive Then S = S "Archive " If Attr And FileAttrAlias Then S = S "Alias " If Attr And FileAttrCompressed Then S = S "Compressed " ShowFileAttr = SEnd Function'''''''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''' ' GenerateDriveInformation ' 目的： ' 生成一个字符串，来描述可用驱动器的当前状态。 ' 示范下面的内容 ' - FileSystemObject.Drives ' - Iterating the Drives collection ' - 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 GenerateDriveInformation(FSO) Dim Drives Dim Drive Dim S Set Drives = FSO.Drives S = "Number of drives:" TabStop Drives.Count NewLine NewLine ' 构造报告的第一行。 S = S String(2, TabStop) "Drive" S = S String(3, TabStop) "File" S = S TabStop "Total" S = S TabStop "Free" S = S TabStop "Available" S = S TabStop "Serial" NewLine ' 构造报告的第二行。 S = S "Letter" S = S TabStop "Path" S = S TabStop "Type" S = S TabStop "Ready?" S = S TabStop "Name" S = S TabStop "System" S = S TabStop "Space" S = S TabStop "Space" S = S TabStop "Space" S = S TabStop "Number" NewLine ' 分隔行。 S = S String(105, "-") NewLine For Each Drive In Drives S = S Drive.DriveLetter S = S TabStop Drive.Path S = S TabStop ShowDriveType(Drive) S = S TabStop Drive.IsReady If Drive.IsReady Then If DriveTypeNetwork = Drive.DriveType Then S = S TabStop Drive.ShareName Else S = S TabStop Drive.VolumeName End If S = S TabStop Drive.FileSystem S = S TabStop Drive.TotalSize S = S TabStop Drive.FreeSpace S = S TabStop Drive.AvailableSpace S = S TabStop Hex(Drive.SerialNumber) End If S = S NewLine Next GenerateDriveInformation = SEnd Function'''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''
' GenerateFileInformation ' 目的： ' 生成一个字符串，来描述文件的当前状态。 ' 示范下面的内容 ' - File.Path ' - File.Name ' - File.Type ' - File.DateCreated ' - File.DateLastAccessed ' - File.DateLastModified ' - File.Size ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''Function GenerateFileInformation(File) Dim S S = NewLine "Path:" TabStop File.Path S = S NewLine "Name:" TabStop File.Name S = S NewLine "Type:" TabStop File.Type S = S NewLine "Attribs:" TabStop ShowFileAttr(File) S = S NewLine "Created:" TabStop File.DateCreated S = S NewLine "Accessed:" TabStop File.DateLastAccessed S = S NewLine "Modified:" TabStop File.DateLastModified S = S NewLine "Size" TabStop File.Size NewLine GenerateFileInformation = SEnd Function'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' GenerateFolderInformation ' 目的： ' 生成一个字符串，来描述文件夹的当前状态。 ' 示范下面的内容 ' - Folder.Path ' - Folder.Name ' - Folder.DateCreated ' - Folder.DateLastAccessed ' - Folder.DateLastModified ' - Folder.Size ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''Function GenerateFolderInformation(Folder) Dim S S = "Path:" TabStop Folder.Path S = S NewLine "Name:" TabStop Folder.Name S = S NewLine "Attribs:" TabStop ShowFileAttr(Folder) S = S NewLine "Created:" TabStop Folder.DateCreated S = S NewLine "Accessed:" TabStop Folder.DateLastAccessed S = S NewLine "Modified:" TabStop Folder.DateLastModified S = S NewLine "Size:" TabStop Folder.Size NewLine GenerateFolderInformation = SEnd Function'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' 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 = SEnd 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
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.CloseEnd 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 = TrueEnd 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
