认识 VB 的文件系统对象 FSO

<script type="text/javascript"> </script> <script type="text/javascript" src="http://pagead2.googlesyndication.com/pagead/show_ads.js"> </script>
<script type="text/javascript"> </script><script type="text/javascript" src="http://pagead2.googlesyndication.com/pagead/show_ads.js"> </script>

    在 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
  2、判断文件、文件夹是否存在:
   '返回布尔值: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 = Nothing
   End 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
  3、获取驱动器参数:
   '返回磁盘总空间大小(单位:M),Drive = 盘符 A ,C, D ...
   Function AllSpace(Drive As String)
   Dim FSO As New FileSystemObject, Drv As Drive
   Set 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
  4,获取系统文件夹路径:
   '返回 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
  5,综合运用:一个文件备份通用过程:
   '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 秒
   If FSO.Drives(Drive).IsReady = True 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
                             张庆   Email:zhangking at 263.net  QQ: 9365822 
                                   http://www.why100000.com

<script type="text/javascript"> </script> <script type="text/javascript" src="http://pagead2.googlesyndication.com/pagead/show_ads.js"> </script>
<script type="text/javascript"> </script><script type="text/javascript" src="http://pagead2.googlesyndication.com/pagead/show_ads.js"> </script>
  • 0
    点赞
  • 0
    收藏
    觉得还不错? 一键收藏
  • 0
    评论

“相关推荐”对你有帮助么?

  • 非常没帮助
  • 没帮助
  • 一般
  • 有帮助
  • 非常有帮助
提交
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值