VB中FSO对象用法详解

要应用 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 & \" 没有准备好！ \

Exit Sub

End If

If Fso.GetDrive(Drive).FreeSpace < Fso.GetFile(Filename).Size Then

MsgBox \"目标驱动器空间太小！\

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 \" 文件备份完毕。\

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