在 VB 編程中經(jīng)常需要和文件系統(tǒng)打交道，比如獲取硬盤的剩余空間、判斷文件夾或文件是否存在等。在VB 推出文件系統(tǒng)對象(File System Object)以前，完成這些功能需要調(diào)用 Windows API 函數(shù)或者使用一些比較復(fù)雜的過程來實(shí)現(xiàn)，使編程復(fù)雜、可靠性差又容易出錯。使用 Windows 提供的的文件系統(tǒng)對象，一切變得簡單多了。以下筆者舉出一些編程中比較常用的例子，以函數(shù)或過程的形式提供給大家，讀者可在編程中直接使用，也可以改進(jìn)后實(shí)現(xiàn)更為強(qiáng)大的功能。

  要應(yīng)用 FSO 對象，須要引用一個名為 Scripting 的類型庫，方法是，執(zhí)行 VB6.0 的菜單項(xiàng)“工程/引用”，添加引用列表框中的“Microsoft Scripting Runtime”一項(xiàng)。然后我們在“對象瀏覽器”中就可以看到 Scripting 類型庫下的眾多對象及其方法、屬性。

  1、判斷光驅(qū)的盤符：
  Function GetCDROM() ' 返回光驅(qū)的盤符(字母)
  Dim Fso As New FileSystemObject '創(chuàng)建 FSO 對象的一個實(shí)例
  Dim FsoDrive As Drive, FsoDrives As Drives '定義驅(qū)動器、驅(qū)動器集合對象
  Set FsoDrives = Fso.Drives
  For Each FsoDrive In FsoDrives '遍歷所有可用的驅(qū)動器
  If FsoDrive.DriveType = CDRom Then '如果驅(qū)動器的類型為 CDrom
  GetCDROM = FsoDrive.DriveLetter '輸出其盤符
  Else
  GetCDROM = ""
  End If
  Next
  Set Fso = Nothing
  Set FsoDrive = Nothing
  Set FsoDrives = Nothing
  End Function

  2、判斷文件、文件夾是否存在：
  '返回布爾值:True 存在，F(xiàn)alse 不存在，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 存在，F(xiàn)alse 不存在，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、獲取驅(qū)動器參數(shù):
  '返回磁盤總空間大小(單位：M)，Drive = 盤符 A ,C, D ...
  Function AllSpace(Drive As String)
  Dim Fso As New FileSystemObject, Drv As Drive
 Set Drv = Fso.GetDrive(Drive) '得到 Drv 對象的實(shí)例
  If Drv.IsReady Then '如果該驅(qū)動器存在(軟驅(qū)或光驅(qū)里有盤片，硬盤存取正常)
  AllSpace = Format(Drv.TotalSize / (2 ^ 20), "0.00") '將字節(jié)轉(zhuǎn)換為兆
  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
'獲取驅(qū)動器文件系統(tǒng)類型，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，獲取系統(tǒng)文件夾路徑：
  '返回 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，綜合運(yùn)用：一個文件備份通用過程：
  'Filename = 文件名，Drive = 驅(qū)動器，F(xiàn)older = 文件夾(一層)
  Sub BackupFile(Filename As String, Drive As String, Folder As String)
  Dim Fso As New FileSystemObject '創(chuàng)建 FSO 對象實(shí)例
  Dim Dest_path As String, Counter As Long
  Counter = 0
  Do While Counter < 6 '如果驅(qū)動器沒準(zhǔn)備好，繼續(xù)檢測。共檢測 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 秒后目標(biāo)盤仍未準(zhǔn)備就緒，退出
  MsgBox " 目標(biāo)驅(qū)動器 " & Drive & " 沒有準(zhǔn)備好！ ", vbCritical
  Exit Sub
  End If
  If Fso.GetDrive(Drive).FreeSpace < Fso.GetFile(Filename).Size Then
  MsgBox "目標(biāo)驅(qū)動器空間太??！", vbCritical '目標(biāo)驅(qū)動器空間不夠，退出
  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 '如果目標(biāo)文件夾不存在，創(chuàng)建之
  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

察看評論詳細(xì)