VB6中FSO具体应用详解(个人实例版).doc

VB 6.0 中FSO对象的具体应用(个人改进版)文前申明:原文为通用版实例代码,本菜鸟在每例之后加入一个简单的实例(均验证通过),供有需要的朋友参考.您正在看的VB教程是:VB入门基础认识VB的文件系统对象FSO。 在 VB 编程中经常需要和文件系统打交道，比如获取硬盘的剩余空间、判断文件夹或文件是否存在等。在VB 推出文件系统对象(File System Object)以前，完成这些功能需要调用 Windows API 函数或者使用一些比较复杂的过程来实现，使编程复杂、可靠性差又容易出错。使用 Windows 提供的的文件系统对象，一切变得简单多了。以下笔者举出一些编程中比较常用的例子，以函数或过程的形式提供给大家，读者可在编程中直接使用，也可以改进后实现更为强大的功能。 要应用 FSO 对象，须要引用一个名为 Scripting 的类型库，方法是，执行 VB6.0 的菜单项“工程/引用”，添加引用列表框中的“Microsoft Scripting Runtime”一项。然后我们在“对象浏览器”中就可以看到 Scripting 类型库下的众多对象及其方法、属性。如果未添加此引用,运行时会出现以下错误:1.判断光驱的盘符 Function GetCDROM() 返回光驱的盘符(字母) Dim Fso As New FileSystemObject 创建 FSO 对象的一个实例 Dim FsoDrive As Drive, FsoDrives As Drives 定义驱动器、驱动器集合对象 Set FsoDrives = Fso.Drives For Each FsoDrive In FsoDrives 遍历所有可用的驱动器 If FsoDrive.DriveType = CDRom Then 如果驱动器的类型为 CDrom GetCDROM = FsoDrive.DriveLetter 输出其盘符 Else GetCDROM = End If Next Set Fso = Nothing Set FsoDrive = Nothing Set FsoDrives = Nothing End Function个人改写实例:用以上代码验证电脑硬盘的盘符类型首先建立窗体, 在设计模式把form的autoredraw设置为trueSub Form_Load()首先在设计模式把form的autoredraw设置为true Dim Fso As New FileSystemObject 创建 FSO 对象的一个实例 Dim FsoDrive As Drive, FsoDrives As Drives 定义驱动器、驱动器集合对象 Set FsoDrives = Fso.Drives For Each FsoDrive In FsoDrives 遍历所有可用的驱动器 If FsoDrive.DriveType = CDRom Then 如果驱动器的类型为 CDrom GetCDROM = FsoDrive.DriveLetter 输出其盘符 Print CDRom 驱动器是: Print GetCDROM ElseIf FsoDrive.DriveType = Fixed Then getfixed = FsoDrive.DriveLetter Print 固定驱动器是: Print getfixed ElseIf FsoDrive.DriveType = Remote Then getremote = FsoDrive.DriveLetter Print 网络驱动器是: Print getremote ElseIf FsoDrive.DriveType = unknown Then getunknown = FsoDrive.DriveLetter Print 未知驱动器是: Print getunknow ElseIf FsoDrive.DriveType = RamDisk Then getramdisk = FsoDrive.DriveLetter Print RAM磁盘是: Print getramdisk End If Next Set Fso = Nothing Set FsoDrive = Nothing Set FsoDrives = NothingEnd Sub2.判断文件、文件夹是否存在： 返回布尔值:True 存在，False 不存在，filername 文件名 Function FileExist(filename As String) Dim Fso As New FileSystemObject If Fso.FileExists(filename) = True Then FileExist = True Else FileExist = False End If Set Fso = NothingEnd Function返回布尔值:True 存在，False 不存在，foldername 文件夹 Function FolderExist(foldername As String) Dim Fso As New FileSystemObject If Fso.FolderExists(foldername) = True Then FolderExist = True Else FolderExist = False End If Set Fso = Nothing End Function个人改进实例:验证文件是否存在首先在form中建立一个文本框和一个按钮.文本框的multiline属性改为true运行时在文本框中输入文件名,格式为D:*.jpg,可以用通配符,或者固定文件名然后单击按钮来验证文件是否存在Sub Command1_Click()Dim fs As New FileSystemObjectfilename = 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) 将字节转换为兆 Else AllSpace = 0 End If Set Fso = Nothing Set Drv = Nothing End Function 返回磁盘可用空间大小(单位：M)，Drive = 盘符 A ,C, D . Function FreeSpace(drive) Dim Fso As New FileSystemObject, drv As drive Set drv = Fso.GetDrive(drive) If drv.IsReady Then FreeSpace = Format(drv.FreeSpace / (2 20), 0.00) End If Set Fso = Nothing Set Drv = Nothing End Function 获取驱动器文件系统类型，Drive = 盘符 A ,C, D . Function FsType(Drive As String) Dim Fso As New FileSystemObject, Drv As Drive Set Drv = Fso.GetDrive(Drive) If Drv.IsReady Then FsType = Drv.FileSystem Else FsType = End If Set Fso = Nothing Set Drv = Nothing End Function个人改进实例:验证c盘空间和文件类型在窗体中画一个文本框和一个按钮,文本框的multiline属性改为trueSub Command1_Click() Dim fso As New FileSystemObject, drv As Drive Set 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.FileSystem Else AllSpace = 0 End If Set fso = Nothing Set drv = NothingText1.Text = C盘空间为 & AllSpace & MB & vbCrLf & c盘空闲空间为 & free & MBText1.Text = Text1.Text & vbCrLf & c盘的文件系统为 & sysEnd Sub4，获取系统文件夹路径： 返回 Windows 文件夹路径 Function GetWindir() Dim Fso As New FileSystemObject GetWindir = Fso.GetSpecialFolder(WindowsFolder) Set Fso = Nothing End Function 返回 WindowsSystem 文件夹路径 Function GetWinSysdir() Dim Fso As New FileSystemObject GetWinSysdir = Fso.GetSpecialFolder(SystemFolder) Set Fso = Nothing End Function个人改进实例:获取系统文件夹同上,在窗体中画文本框和按钮,运行后点按钮来验证,别忘了把文本框的multiline属性改为truePrivate Sub Command1_Click()Dim fso As New FileSystemObject getwin = fso.GetSpecialFolder(windowfolder) getsys = fso.GetSpecialFolder(SystemFolder) Text1.Text = windows文件夹为: & getwin & vbCrLf & system文件夹为: & getsysEnd 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 Long Counter = 0 Do While Counter 6 如果驱动器没准备好，继续检测。共检测 6 秒 Counter = Counter + 1 Call Waitfor(1) 间隔 1 秒Then Exit Do End If Loop If Fso.Drives(Drive).IsReady = False Then 6 秒后目标盘仍未准备就绪，退出 MsgBox 目标驱动器 & Drive & 没有准备好！ , vbCritical Exit Sub End If If Fso.GetDrive(Drive).FreeSpace Fso.GetFile(Filename).Size Then MsgBox 目标驱动器空间太小！, vbCritical 目标驱动器空间不够，退出 Exit Sub End If If Right(Drive, 1) : Then Drive = Drive & : End If If Left(Folder, 1) Then Folder = & Folder End If If Right(Folder, 1) Then Folder = Folder & End If Dest_path = Drive & Folder If Not Fso.FolderExists(Dest_path) Then 如果目标文件夹不存在，创建之 Fso.CreateFolder Dest_path End If Fso.CopyFile Filename, Dest_path & Fso.GetFileName(Filename), True 拷贝，直接覆盖同名文件 MsgBox 文件备份完毕。, vbOKOnly Set Fso = Nothing End Sub Private Sub Waitfor(Delay As Single) 延时过程，Delay 单位约为 1 秒 Dim StartTime As Single StartTime = Timer Do Until (Timer - StartTime) Delay Loop End Sub个人改进实例一:(复杂)首先建立窗体,在窗体下输入以下代码: Private Sub Waitfor(Delay As Single) 延时过程，Delay 单位约为 1 秒 Dim StartTime As Single StartTime = Timer Do Until (Timer - StartTime) Delay Loop End SubPrivate Sub Form_Load() Dim Fso As New FileSystemObject 创建 FSO 对象实例 Dim Dest_path As String, Counter As Long Counter = 0 Do While Counter 6 如果驱动器没准备好，继续检测。共检测 6 秒 Counter = Counter + 1 Call Waitfor(1) 间隔 1 秒 Exit Do Loop If Fso.Drives(d:).IsReady = False Then 6 秒后目标盘仍未准备就绪，退出 MsgBox 目标驱动器 & d: & 没有准备好！ , vbCritical Exit Sub End If Dim sofile sofile = InputBox(请输入要复制的文件名(如C:temp.doc) If Fso.GetDrive(d:).FreeSpace Fso.GetFile(sofile).Size Then MsgBox 目标驱动器空间太小！, vbCritical 目标驱动器空间不够，退出 Exit Sub End If Drive = InputBox(请输入目的驱动器盘符(如D):) If Right(Drive, 1) : Then Drive = Drive & : End If Depath = InputBox(请输入目标文件夹(如temp):) If Left(Depath, 1) Then Folder = & Depath End If If Right(Depath, 1) Then Folder = Depath & End If Dest_path = Drive &