在 VB 編程中經(jīng)常需要和文件系統(tǒng)打交道，比如獲取硬盤(pán)的剩余空間、判斷文件夾或文件是否存在等。在VB 推出文件系統(tǒng)對(duì)象(File System Object)以前，完成這些功能需要調(diào)用 Windows API 函數(shù)或者使用一些比較復(fù)雜的過(guò)程來(lái)實(shí)現(xiàn)，使編程復(fù)雜、可靠性差又容易出錯(cuò)。使用 Windows 提供的的文件系統(tǒng)對(duì)象，一切變得簡(jiǎn)單多了。以下筆者舉出一些編程中比較常用的例子，以函數(shù)或過(guò)程的形式提供給大家，讀者可在編程中直接使用，也可以改進(jìn)后實(shí)現(xiàn)更為強(qiáng)大的功能。
要應(yīng)用 FSO 對(duì)象，須要引用一個(gè)名為 Scripting 的類(lèi)型庫(kù)，方法是，執(zhí)行 VB6.0 的菜單項(xiàng)“工程/引用”，添加引用列表框中的“Microsoft Scripting Runtime”一項(xiàng)。然后我們?cè)?#8220;對(duì)象瀏覽器”中就可以看到 Scripting 類(lèi)型庫(kù)下的眾多對(duì)象及其方法、屬性。
1、判斷光驅(qū)的盤(pán)符：
Function GetCDROM() ' 返回光驅(qū)的盤(pán)符(字母)
Dim Fso As New FileSystemObject '創(chuàng)建 FSO 對(duì)象的一個(gè)實(shí)例
Dim FsoDrive As Drive, FsoDrives As Drives '定義驅(qū)動(dòng)器、驅(qū)動(dòng)器集合對(duì)象
Set FsoDrives = Fso.Drives
For Each FsoDrive In FsoDrives '遍歷所有可用的驅(qū)動(dòng)器
If FsoDrive.DriveType = CDRom Then '如果驅(qū)動(dòng)器的類(lèi)型為 CDrom
GetCDROM = FsoDrive.DriveLetter '輸出其盤(pán)符
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ū)動(dòng)器參數(shù):
'返回磁盤(pán)總空間大小(單位：M)，Drive = 盤(pán)符 A ,C, D ...
Function AllSpace(Drive As String)
Dim Fso As New FileSystemObject, Drv As Drive
Set Drv = Fso.GetDrive(Drive) '得到 Drv 對(duì)象的實(shí)例
If Drv.IsReady Then '如果該驅(qū)動(dòng)器存在(軟驅(qū)或光驅(qū)里有盤(pán)片，硬盤(pán)存取正常)
AllSpace = Format(Drv.TotalSize / (2 ^ 20), "0.00") '將字節(jié)轉(zhuǎn)換為兆
Else
AllSpace = 0
End If
Set Fso = Nothing
Set Drv = Nothing
End Function
'返回磁盤(pán)可用空間大小(單位：M)，Drive = 盤(pán)符 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ū)動(dòng)器文件系統(tǒng)類(lèi)型，Drive = 盤(pán)符 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)用：一個(gè)文件備份通用過(guò)程：
'Filename = 文件名，Drive = 驅(qū)動(dòng)器，F(xiàn)older = 文件夾(一層)
Sub BackupFile(Filename As String, Drive As String, Folder As String)
Dim Fso As New FileSystemObject '創(chuàng)建 FSO 對(duì)象實(shí)例
Dim Dest_path As String, Counter As Long
Counter = 0
Do While Counter < 6 '如果驅(qū)動(dòng)器沒(méi)準(zhǔn)備好，繼續(xù)檢測(cè)。共檢測(cè) 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)盤(pán)仍未準(zhǔn)備就緒，退出
MsgBox " 目標(biāo)驅(qū)動(dòng)器 " & Drive & " 沒(méi)有準(zhǔn)備好！ ", vbCritical
Exit Sub
End If
If Fso.GetDrive(Drive).FreeSpace < Fso.GetFile(Filename).Size Then
MsgBox "目標(biāo)驅(qū)動(dòng)器空間太小！", vbCritical '目標(biāo)驅(qū)動(dòng)器空間不夠，退出
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) '延時(shí)過(guò)程，Delay 單位約為 1 秒
Dim StartTime As Single
StartTime = Timer
Do Until (Timer - StartTime) > Delay
Loop
End Sub
本站僅提供存儲(chǔ)服務(wù)，所有內(nèi)容均由用戶(hù)發(fā)布，如發(fā)現(xiàn)有害或侵權(quán)內(nèi)容，請(qǐng)
點(diǎn)擊舉報(bào)。
