VB6中FSO具体应用详解

VB 6.0 中 FSO 对象的具体应用（个人改进版）文前申明:原文为通用版实例代码,本菜鸟在每例之后加入一个简单的实例（均验证通过）,供有 需要的朋友参考.您正在看的VB教程是:VB入门基础认识VB的文件系统对象FSO。在 VB 编程中经常需要和文件系统打交道，比如获取硬盘的剩余空间、判断文件夹或文 件是否存在等。在VB推出文件系统对象（File System Object）以前，完成这些功能需要调 用 Windows API 函数或者使用一些比较复杂的过程来实现，使编程复杂、可靠性差又容易 出错。使用 Windows 提供的的文件系统对象，一切变得简单多了。以下笔者举出一些编 程中比较常用的例子，以函数或过程的形式提供给大家，读者可在编程中直接使用，也可以 改进后实现更为强大的功能。要应用 FSO 对象，须要引用一个名为 Scripting 的类型库，方法是，执行 VB6.0 的菜 单项工程/引用”，添加引用列表框中的Microsoft Script ing Run time” 一项。然后我们在对 象浏览器”中就可以看到 Scripting 类型库下的众多对象及其方法、属性。如果未添加此引用,运行时会出现以下错误:1. 判断光驱的盘符Function GetCDROM()返回光驱的盘符(字母)Dim Fso As New FileSystemObject创建 FSO 对象的一个实例Dim FsoDrive As Drive, FsoDrives As Drives 定义驱动器、驱动器集合对象 Set FsoDrives = Fso.DrivesFor Each FsoDrive In FsoDrives遍历所有可用的驱动器If FsoDrive.DriveType = CDRom Then如果驱动器的类型为 CDromGetCDROM = FsoDrive.DriveLetter 输出其盘符ElseGetCDROM = End IfNextSet Fso = NothingSet FsoDrive = NothingSet FsoDrives = NothingEnd Function个人改写实例:用以上代码验证电脑硬盘的盘符类型首先建立窗体, 在设计模式把 form 的 autoredraw 设置为 trueSub Form_Load() 首先在设计模式把 form 的 autoredraw 设置为 trueDim Fso As New FileSystemObject创建 FSO 对象的一个实例Dim FsoDrive As Drive, FsoDrives As Drives 定 义驱动器、驱动器集合对象 Set FsoDrives = Fso.DrivesFor Each FsoDrive In FsoDrives遍历所有可用的驱动器If FsoDrive.DriveType = CDRom Then如果驱动器的类型为 CDromGetCDROM = FsoDrive.DriveLetter 输出其盘符Print CDRom 驱动器是:Print GetCDROMElseIf FsoDrive.DriveType = Fixed Thengetfixed = FsoDrive.DriveLetterPrint 固定驱动器是:Print getfixedElseIf FsoDrive.DriveType = Remote Thengetremote = FsoDrive.DriveLetterPrint 网络驱动器是:Print getremoteElseIf FsoDrive.DriveType = unknown Thengetunknown = FsoDrive.DriveLetterPrint 未知驱动器是:Print getunknowElseIf FsoDrive.DriveType = RamDisk Thengetramdisk = FsoDrive.DriveLetterPrint RAM 磁盘是:Print getramdiskEnd IfNextSet Fso = NothingSet FsoDrive = NothingSet FsoDrives = NothingEnd Sub2. 判断文件、文件夹是否存在：返回布尔值:True存在，False不存在，filer name文件名Function FileExist(filename As String)Dim Fso As New FileSystemObjectIf Fso.FileExists(filename) = True ThenFileExist = TrueElseFileExist = FalseEnd IfSet Fso = NothingEnd Function返回布尔值:True存在，False不存在，folder name文件夹Function FolderExist(foldername As String)Dim Fso As New FileSystemObjectIf Fso.FolderExists(foldername) = True ThenFolderExist = TrueElseFolderExist = FalseEnd IfSet Fso = NothingEnd Function个人改进实例:验证文件是否存在首先在 form 中建立一个文本框和一个按钮.文本框的 multiline 属性改为 true运行时在文本框中输入文件名,格式为D:*.jpg,可以用通配符，或者固定文件名 然后单击按钮来验证文件是否存在Sub Command1_Click()Dim fs As New FileSystemObject filename = Text1.TextIf fs.FileExists(filename) ThenText1.Text = 存在ElseText1.Text = 不存在End IfEnd SubPrivate Sub Form_Load()Command1.Caption = 验证End Sub3、获取驱动器参数:返回磁盘总空间大小(单位：M), Drive =盘符A ,C, D .Function AllSpace(Drive As String)Dim Fso As New FileSystemObject, Drv As DriveSet Drv = Fso.GetDrive(Drive) 得到 Drv 对象的实例If Drv.IsReady Then 如果该驱动器存在(软驱或光驱里有盘片,硬盘存取正常)AllSpace = Format(Drv.TotalSize / (2 人 20), 0.00)将字节转换为兆ElseAllSpace = 0End IfSet Fso = NothingSet Drv = NothingEnd Function返回磁盘可用空间大小(单位：M), Drive =盘符A ,C, D .Function FreeSpace(drive)Dim Fso As New FileSystemObject, drv As driveSet drv = Fso.GetDrive(drive)If drv.IsReady ThenFreeSpace = Format(drv.FreeSpace / (2 人 20), 0.00)End IfSet Fso = NothingSet Drv = NothingEnd Function获取驱动器文件系统类型, Drive = 盘符 A ,C, D .Function FsType(Drive As String)Dim Fso As New FileSystemObject, Drv As DriveSet Drv = Fso.GetDrive(Drive)If Drv.IsReady ThenFsType = Drv.FileSystemElseFsType = End IfSet Fso = NothingSet Drv = NothingEnd Function个人改进实例:验证C盘空间和文件类型在窗体中画一个文本框和一个按钮,文本框的 multiline 属性改为 trueSub Command1_Click()Dim fso As New FileSystemObject, drv As DriveSet drv = fso.GetDrive(fso.GetDriveName(c:)得到 Drv 对象的实例If drv.IsReady Then如果该驱动器存在(软驱或光驱里有盘片，硬盘存取正常)AllSpace = Format(drv.TotalSize / (2 人 20), 0.00)将字节转换为兆free = Format(drv.FreeSpace / (2 人 20), 0.00)sys = drv.FileSystemElseAllSpace = 0End IfSet fso = NothingSet drv = NothingText1.Text = C 盘空间为& AllSpace & MB & vbCrLf & c 盘空闲空间为& free & MB Text1.Text = Text1.Text & vbCrLf & c 盘的文件系统为& sysEnd Sub4，获取系统文件夹路径：返回 Windows 文件夹路径Function GetWindir()Dim Fso As New FileSystemObjectGetWindir = Fso.GetSpecialFolder(WindowsFolder) Set Fso = NothingEnd Function返回 WindowsSystem 文件夹路径Function GetWinSysdir()Dim Fso As New FileSystemObjectGetWinSysdir = Fso.GetSpecialFolder(SystemFolder)Set Fso = NothingEnd Function个人改进实例:获取系统文件夹同上,在窗体中画文本框和按钮,运行后点按钮来验证,别忘了把文本框的 multiline 属性改为 truePrivate Sub Command1_Click()Dim fso As New FileSystemObjectgetwin = fso.GetSpecialFolder(windowfolder)getsys = fso.GetSpecialFolder(SystemFolder)Textl.Text = wi ndows 文件夹为:& getwin & vbCrLf & system 文件夹为:& getsys End Sub5，综合运用：一个文件备份通用过程：Filename =文件名，Drive =驱动器，Folder =文件夹(一层)Sub BackupFile(Filename As String, Drive As String, Folder As String)Dim Fso As New FileSystemObject 创建 FSO 对象实例Dim Dest_path As String, Counter As LongCounter = 0Do While Counter 6 如果驱动器没准备好，继续检测。共检测 6 秒Counter = Counter + 1Call Waitfor(1) 间隔 1 秒ThenExit DoEnd IfLoopIf Fso.Drives(Drive).IsReady = False Then 6 秒后目标盘仍未准备就绪，退出MsgBox 目标驱动器 & Drive & 没有准备好！ , vbCriticalExit SubEnd IfIf Fso.GetDrive(Drive).FreeSpace Fso.GetFile(Filename).Size ThenMsgBox 目标驱动器空间太小！, vbCritical 目标驱动器空间不够，退出Exit SubEnd IfIf Right(Drive, 1) : ThenDrive = Drive & :End IfIf Left(Folder, 1) ThenFolder = & FolderEnd IfIf Right(Folder, 1) ThenFolder = Folder & End IfDest_path = Drive & FolderIf Not Fso.FolderExists(Dest_path) Then 如果目标文件夹不存在，创建之 Fso.CreateFolder Dest_pathEnd IfFso.CopyFile Filename, Dest_path & Fso.GetFileName(Filename), True 拷贝，直接覆盖同名文件MsgBox 文件备份完毕。, vbOKOnlySet Fso = NothingEnd SubPrivate Sub Waitfor(Delay As Single)延时过程，Delay 单位约为 1 秒Dim StartTime As SingleStartTime = TimerDo Until (Timer - StartTime) DelayLoopEnd Sub个人改进实例一:（复杂）首先建立窗体,在窗体下输入以下代码:Private Sub Waitfor(Delay As Single)延时过程，Delay 单位约为 1 秒 Dim StartTime As SingleStartTime = TimerDo Until (Timer - StartTime) DelayLoopEnd SubPrivate Sub Form_Load()Dim Fso As New FileSystemObject 创建 FSO 对象实例Dim Dest_path As String, Counter As LongCounter = 0Do While Counter 6 如果驱动器没准备好，继续检测。共检测 6 秒Counter = Counter + 1Call Waitfor(1) 间隔 1 秒Exit DoLoopIf Fso.Drives(d:).IsReady = False Then 6 秒后目标盘仍未准备就绪，退出MsgBox 目标驱动器 & d: & 没有准备好！ , vbCriticalExit SubEnd IfDim sofilesofile = InputBox(请输入要复制的文件名(女口 C:temp.doc)If Fso.GetDrive(d:).FreeSpace Fso.GetFile(sofile).Size ThenMsgBox 目标驱动器空间太小！, vbCritical 目标驱动器空间不够，退出Exit SubEnd IfDrive = InputBox(请输入目的驱动器盘符(如D):)If Right(Drive, 1) : ThenDrive = Drive & :End IfDepath = InputBox(请输入目标文件夹(女口 temp):)If Left(Depath, 1) ThenFolder = & DepathEnd IfIf Right(Depath, 1) ThenFolder = Depath & End IfDest_path = Drive & FolderMsgBox 目标文件为 & Dest_pathIf Not Fso.FolderExists(Dest_path) Then 如果目标文件夹不存在，创建之Fso.CreateFolder (Dest_path)End IfFso.CopyFile sofile, Dest_path, True拷贝，直接覆盖同名文件MsgBox 文件备份完毕。, vbOKOnlySet Fso = NothingEnd Sub个人改进实例二:(精简)先建立窗体,在窗体下输入以下代码:Private Sub Form_Load()Dim Fso As New FileSystemObject 创建 FSO 对象实例Dim Depath As StringDim sofilesofile = InputBox(请输入要复制的文件名(女口 C:temp.doc)MsgBox 要复制的文件名为 & sofileDepath = InputBox(请输入目的文件夹(女口 D:temp):) MsgBox 目标文件夹为 & DepathIf Not Fso.FolderExists(Depath) Then 如果目标文件夹不存在，创建之Fso.CreateFolder (Depath)End IfFso.CopyFile sofile, Depath, True拷贝，直接覆盖同名文件MsgBox 文件备份完毕。, vbOKOnlySet Fso = NothingEnd Sub原作者信息：张庆 Email:zhangking at QQ: 9365822 改进作者信息:Email :liupipiwang