如何在VB中使用FSO-星旺坡

管理首页

VB使用FSO

VB使用FSO
2007-12-05 11:44要应用 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

另一个例子：

''vb里如何读取文件的创建更新时间等信息

Sub ShowFileAccessInfo(filespec)
Dim fs, f, s, GetCDROM
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFile(filespec)
s = UCase(filespec) & vbCrLf
s = s & "Created: " & f.DateCreated & vbCrLf
s = s & "Last Accessed: " & f.DateLastAccessed & vbCrLf
s = s & "Last Modified: " & f.DateLastModified
''''MsgBox s, 0, "File Access Info"
''''Debug.Print "ppp"

Print s

End Sub