VB6中FSO具体应用详解

末蓝、 2024-03-23 17:45 49阅读 0赞

文前申明:原文为通用版实例代码,本菜鸟在每例之后加入一个简单的实例(均验证通过),供有需要的朋友参考.

您正在看的VB教程是:VB入门基础认识VB的文件系统对象FSO。

在 VB 编程中经常需要和文件系统打交道，比如获取硬盘的剩余空间、判断文件夹或文件是否存在等。在VB 推出文件系统对象(File System Object)以前，完成这些功能需要调用 Windows API 函数或者使用一些比较复杂的过程来实现，使编程复杂、可靠性差又容易出错。使用 Windows 提供的的文件系统对象，一切变得简单多了。以下笔者举出一些编程中比较常用的例子，以函数或过程的形式提供给大家，读者可在编程中直接使用，也可以改进后实现更为强大的功能。  
  
要应用 FSO 对象，须要引用一个名为 Scripting 的类型库，方法是，执行 VB6.0 的菜单项“工程/引用”，添加引用列表框中的“Microsoft Scripting Runtime”一项。然后我们在“对象浏览器”中就可以看到 Scripting 类型库下的众多对象及其方法、属性。

![29dddb5eaba341aa946697d7f5dca92a.jpeg][]

如果未添加此引用,运行时会出现以下错误:

![4d153d4d3df149eeb0bb46f04b9f6872.jpeg][]

## 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设置为true

![5602194e773543a5a884a78a7a385c02.jpeg][]

Sub 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

Set Fso = Nothing

Set FsoDrive = Nothing

Set FsoDrives = Nothing

End Sub

## 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

### 个人改进实例:验证文件是否存在 ###

![92443d1d6b324c1aaf6429de5f556085.jpeg][]

![645cc086b3e044cd90c328c253cfe550.jpeg][]

首先在form中建立一个文本框和一个按钮.文本框的multiline属性改为true

运行时在文本框中输入文件名,格式为D:\\\*.jpg,可以用通配符,或者固定文件名

然后单击按钮来验证文件是否存在

Sub Command1\_Click()

Dim fs As New FileSystemObject

filename = Text1.Text

If fs.FileExists(filename) Then

Text1.Text = "存在"

Else

Text1.Text = "不存在"

End If

End Sub

Private Sub Form\_Load()

Command1.Caption = "验证"

End Sub

## 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

### 个人改进实例:验证c盘空间和文件类型 ###

在窗体中画一个文本框和一个按钮,文本框的multiline属性改为true

![74474d5ffe7c44b99bcd872b48cd922a.jpeg][]

Sub 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 = Nothing

Text1.Text = "C盘空间为" & AllSpace & "MB" & vbCrLf & "c盘空闲空间为" & free & "MB"

Text1.Text = Text1.Text & vbCrLf & "c盘的文件系统为" & sys

End Sub

## 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

### 个人改进实例:获取系统文件夹 ###

同上,在窗体中画文本框和按钮,运行后点按钮来验证,别忘了把文本框的multiline属性改为true

![0fd92accd0bd413bb4b0c58acf959a53.jpeg][]

Private Sub Command1\_Click()

Dim fso As New FileSystemObject

getwin = fso.GetSpecialFolder(windowfolder)

getsys = fso.GetSpecialFolder(SystemFolder)

Text1.Text = "windows文件夹为:" & getwin & vbCrLf & "system文件夹为:" & getsys

End Sub

## 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 秒  
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 Sub

Private 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 & Folder

MsgBox "目标文件为" & Dest\_path

If Not Fso.FolderExists(Dest\_path) Then '如果目标文件夹不存在，创建之

Fso.CreateFolder (Dest\_path)

End If

Fso.CopyFile sofile, Dest\_path, True

'拷贝，直接覆盖同名文件

MsgBox " 文件备份完毕。", vbOKOnly

Set Fso = Nothing

End Sub

## 个人改进实例二:(精简) ##

先建立窗体,在窗体下输入以下代码:

Private Sub Form\_Load()

Dim Fso As New FileSystemObject '创建 FSO 对象实例

Dim Depath As String

Dim sofile

sofile = InputBox("请输入要复制的文件名(如C:\\temp.doc)")

MsgBox "要复制的文件名为" & sofile

Depath = InputBox("请输入目的文件夹(如D:\\temp\\):")

MsgBox "目标文件夹为" & Depath

If Not Fso.FolderExists(Depath) Then '如果目标文件夹不存在，创建之

Fso.CreateFolder (Depath)

End If

Fso.CopyFile sofile, Depath, True

'拷贝，直接覆盖同名文件

MsgBox " 文件备份完毕。", vbOKOnly

Set Fso = Nothing

End Sub

[29dddb5eaba341aa946697d7f5dca92a.jpeg]: https://image.dandelioncloud.cn/pgy_files/images/2024/03/14/644a833f4ab04745bd0d18b7d113bab4.png
[4d153d4d3df149eeb0bb46f04b9f6872.jpeg]: https://image.dandelioncloud.cn/pgy_files/images/2024/03/14/cfcfdffd691d46479b51ac69545224e1.png
[5602194e773543a5a884a78a7a385c02.jpeg]: https://image.dandelioncloud.cn/pgy_files/images/2024/03/14/6a9dca61ed2843f2999acfa37f6ad860.png
[92443d1d6b324c1aaf6429de5f556085.jpeg]: https://image.dandelioncloud.cn/pgy_files/images/2024/03/14/b6e2023ccd5248d4a3dc60bbc0d99209.png
[645cc086b3e044cd90c328c253cfe550.jpeg]: https://image.dandelioncloud.cn/pgy_files/images/2024/03/14/b1600da03337427688f7952c789ecac8.png
[74474d5ffe7c44b99bcd872b48cd922a.jpeg]: https://image.dandelioncloud.cn/pgy_files/images/2024/03/14/67c41911c38d4e92b15f34579b006c2b.png
[0fd92accd0bd413bb4b0c58acf959a53.jpeg]: https://image.dandelioncloud.cn/pgy_files/images/2024/03/14/a97e814384184077be69ff81e742fb05.png