上一篇
下一篇
认识 VB 的文件系统对象 FSO
作者:JiaJia 日期:2007-12-14
在 VB 编程中经常需要和文件系统打交道, 比如获取硬盘的剩余空间, 判断文件夹或文件是否存在等. 在 VB 推出文件系统对象 (File System Object) 以前, 完成这些功能需要调用 Windows API 函数或者使用一些比较复杂的过程来实现, 使编程复杂, 可靠性差又容易出错. 使用 Windows 提供的的文件系统对象, 一切变得简单多了.
以下笔者举出一些编程中比较常用的例子, 以函数或过程的形式提供给大家, 读者可在编程中直接使用, 也可以改进后实现更为强大的功能.
要应用 FSO 对象, 须要引用一个名为 Scripting 的类型库, 方法是执行 VB 的菜单项"工程/引用", 添加引用列表框中的"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. 判断文件、文件夹是否存在
引用内容
Function FileExist(filename As String) '返回布尔值:True 存在，False 不存在，filername 文件名
Dim Fso As New FileSystemObject
If Fso.FileExists(filename) = True Then
FileExist = True
Else
FileExist = False
End If
Set Fso = Nothing
End Function
Function FolderExist(foldername As String) '返回布尔值:True 存在，False 不存在，foldername 文件夹
Dim Fso As New FileSystemObject
If Fso.FolderExists(foldername) = True Then
FolderExist = True
Else
FolderExist = False
End If
Set Fso = Nothing
End Function
3. 获取驱动器参数
引用内容
Function AllSpace(Drive As String) '返回磁盘总空间大小(单位：M)，Drive = 盘符 A ,C, D ...
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
Function FreeSpace(drive) '返回磁盘可用空间大小(单位：M)，Drive = 盘符 A ,C, D ...
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
Function FsType(Drive As String) '获取驱动器文件系统类型，Drive = 盘符 A ,C, D ...
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. 获取系统文件夹路径
引用内容
Function GetWindir() '返回 Windows 文件夹路径
Dim Fso As New FileSystemObject
GetWindir = Fso.GetSpecialFolder(WindowsFolder)
Set Fso = Nothing
End Function
Function GetWinSysdir() '返回 Windows\System 文件夹路径
Dim Fso As New FileSystemObject
GetWinSysdir = Fso.GetSpecialFolder(SystemFolder)
Set Fso = Nothing
End Function
5. 综合运用, 一个文件备份通用过程
引用内容
Sub BackupFile(Filename As String, Drive As String, Folder As String) 'Filename = 文件名，Drive = 驱动器，Folder = 文件夹(一层)
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
以下笔者举出一些编程中比较常用的例子, 以函数或过程的形式提供给大家, 读者可在编程中直接使用, 也可以改进后实现更为强大的功能.
要应用 FSO 对象, 须要引用一个名为 Scripting 的类型库, 方法是执行 VB 的菜单项"工程/引用", 添加引用列表框中的"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. 判断文件、文件夹是否存在
引用内容Function FileExist(filename As String) '返回布尔值:True 存在，False 不存在，filername 文件名
Dim Fso As New FileSystemObject
If Fso.FileExists(filename) = True Then
FileExist = True
Else
FileExist = False
End If
Set Fso = Nothing
End Function
Function FolderExist(foldername As String) '返回布尔值:True 存在，False 不存在，foldername 文件夹
Dim Fso As New FileSystemObject
If Fso.FolderExists(foldername) = True Then
FolderExist = True
Else
FolderExist = False
End If
Set Fso = Nothing
End Function
3. 获取驱动器参数
引用内容Function AllSpace(Drive As String) '返回磁盘总空间大小(单位：M)，Drive = 盘符 A ,C, D ...
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
Function FreeSpace(drive) '返回磁盘可用空间大小(单位：M)，Drive = 盘符 A ,C, D ...
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
Function FsType(Drive As String) '获取驱动器文件系统类型，Drive = 盘符 A ,C, D ...
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. 获取系统文件夹路径
引用内容Function GetWindir() '返回 Windows 文件夹路径
Dim Fso As New FileSystemObject
GetWindir = Fso.GetSpecialFolder(WindowsFolder)
Set Fso = Nothing
End Function
Function GetWinSysdir() '返回 Windows\System 文件夹路径
Dim Fso As New FileSystemObject
GetWinSysdir = Fso.GetSpecialFolder(SystemFolder)
Set Fso = Nothing
End Function
5. 综合运用, 一个文件备份通用过程
引用内容Sub BackupFile(Filename As String, Drive As String, Folder As String) 'Filename = 文件名，Drive = 驱动器，Folder = 文件夹(一层)
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
文章来自: 
引用通告: 
Tags: 评论: 0 | 引用: 0 | 查看次数: -
发表评论