TABLE borderColor=#ffeacc cellSpacing=0 borderColorDark=#ffffff cellPadding=0 width=600 align=center borderColorLight=#ffeacc border=1>
在 VB 编程中经常需要和文件系统打交道
比如获取硬盘
剩余空间、判断文件夹或文件是否存在等
在VB 推出文件系统对象(File 
Object)以前完成这些功能需要
Windows API 
或者使用
些比较复杂过程来实现使编程复杂、可靠性差又容易出错使用 Windows 提供文件系统对象切变得简单多了以下笔者举出些编程中比较常用例子以或过程形式提供给大家读者可在编程中直接使用也可以改进后实现更为强大功能要应用 FSO 对象
须要引用个名为 Scripting 类型库思路方法是执行 VB6.0 菜单项“工程/引用”添加引用列表框中“Microsoft Scripting Runtime”项然后我们在“对象浏览器”中就可以看到 Scripting 类型库下众多对象及其思路方法、属性1、判断光驱
盘符:Function GetCDROM
´ 返回光驱盘符(字母)Dim Fso As New File
Object ´创建 FSO 对象个例子Dim FsoDrive As Drive, FsoDrives As Drives ´定义驱动器、驱动器集合对象
Set FsoDrives = Fso.Drives
For Each FsoDrive In FsoDrives ´遍历所有可用
驱动器If FsoDrive.DriveType = CDRom Then ´如果驱动器
类型为 CDromGetCDROM = 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 File
ObjectIf 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 File
ObjectIf 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 File
Object, Drv As DriveSet 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 File
Object, drv As driveSet 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 File
Object, Drv As DriveSet Drv = Fso.GetDrive(Drive)
If Drv.IsReady Then
FsType = Drv.File
Else
FsType = \"\"
End If
Set Fso = Nothing
Set Drv = Nothing
End Function
4
获取系统文件夹路径:´返回 Windows 文件夹路径
Function GetWindir
Dim Fso As New File
ObjectGetWindir = Fso.GetSpecialFolder(WindowsFolder)
Set Fso = Nothing
End Function
´返回 Windows\\
文件夹路径Function GetWinSysdir
Dim Fso As New File
ObjectGetWinSysdir = Fso.GetSpecialFolder(
Folder)Set Fso = Nothing
End Function
5
综合运用:个文件备份通用过程:´Filename = 文件名
Drive = 驱动器Folder = 文件夹(层)Sub BackupFile(Filename As String, Drive As String, Folder As String)
Dim Fso As New File
Object ´创建 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 \" 文件备份完毕
\", vbOKOnlySet 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: QQ: 9365822
最新评论