科技行者

行者学院 转型私董会 科技行者专题报道 网红大战科技行者

知识库

知识库 安全导航

至顶网软件频道基础软件VB基础:认识VB的文件系统对象FSO

VB基础:认识VB的文件系统对象FSO

  • 扫一扫
    分享文章到微信

  • 扫一扫
    关注官方公众号
    至顶头条

在 VB 编程中经常需要和文件系统打交道,比如获取硬盘的剩余空间、判断文件夹或文件是否存在等。

作者:zhangking 来源:soft6 2008年5月15日

关键字: 对象 系统 VB vb.net Windows

  • 评论
  • 分享微博
  • 分享邮件
在 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
  ''返回 Windows\System 文件夹路径
  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

 

    • 评论
    • 分享微博
    • 分享邮件
    邮件订阅

    如果您非常迫切的想了解IT领域最新产品与技术信息,那么订阅至顶网技术邮件将是您的最佳途径之一。

    重磅专题
    往期文章
    最新文章