02. Этот пример показывает как с использованием API интерфейса определить информацию по дискам системы.
' Запрашиваем информацию о диске
Private Declare Function apiGetDiskFreeSpace Lib "kernel32" Alias "GetDiskFreeSpaceA" _
(ByVal lpRootPathName As String, _
lpSectorsPerCluster As Long, _
lpBytesPerSector As Long, _
lpNumberOfFreeClusters As Long, _
lpTotalNumberOfClusters As Long) As Long
' Загрузка данных
Private Sub Form_Load()
On Error Resume Next
Me.myDrive.RowSource = funGetDrivers
Me.myDrive = Me.myDrive.Column(0, 0)
myDrive_AfterUpdate
Err.Clear
End Sub
' Получаем информацию о диске системы
Private Function funInformationDisk()
Dim fs, dc, D, s As String
On Error Resume Next
s = ""
' 1. Получаем информацию из файловой системы
Set fs = CreateObject("Scripting.FileSystemObject")
Set dc = fs.Drives
For Each D In dc
If StrComp(D.DriveLetter, Left(myDrive, 1), vbTextCompare) = 0 Then
s = s "Серийный номер: " D.SerialNumber ";"
s = s "Емкость диска: " Format(D.TotalSize, "#,0") ";"
s = s "Доступный объем диска: " Format(D.AvailableSpace, "#,0") ";"
s = s "Свободное место на диске: " Format(D.FreeSpace, "#,0") ";"
s = s "Метка тома: " D.VolumeName ";"
s = s "Файловая система: " D.FileSystem ";"
Exit For
End If
Err.Clear
Next D
' 2. Получаем информацию из api интерфейса
Dim SectorsPerCluster As Long ' Секторов на клястер
Dim BytesPerSector As Long ' Байт на сектор
Dim NumberOfFreeClustors As Long ' Свободных клястеров
Dim TotalNumberOfClustors As Long ' Всего клястеров
' Запрашиваем свободное место
Call apiGetDiskFreeSpace(Left(Me.myDrive, 2), _
SectorsPerCluster, BytesPerSector, _
NumberOfFreeClustors, TotalNumberOfClustors)
s = s "Число секторов на клястер: " Format(SectorsPerCluster, "#,0") ";"
s = s "Число байт на сектор: " Format(BytesPerSector, "#,0") ";"
s = s "Число свободных клястеров: " Format(NumberOfFreeClustors, "#,0") ";"
s = s "Всего клястеров: " Format(TotalNumberOfClustors, "#,0") ";"
' Используя клястеры Вы можете определить
' a) Емкость диска = TotalNumberOfClustors * SectorsPerCluster * BytesPerSector
' b) Свободное место = NumberOfFreeClustors * SectorsPerCluster * BytesPerSector
' 3. Присваиваем источник данных
Me.myList.RowSource = s
Exit Function
End Function
' Заполняем список с информацией о дисках
Private Function funGetDrivers() As String
Dim fs, dc, D
Dim s As String
On Error GoTo 999
Err.Clear
funGetDrivers = ""
Set fs = CreateObject("Scripting.FileSystemObject")
Set dc = fs.Drives
For Each D In dc
Select Case D.driveType
Case 0: s = "Неизвестная БД"
Case 1: s = "Дискета"
Case 2: s = "Жесткий диск"
Case 3: s = "Сетевой диск"
Case 4: s = "CD-ROM"
Case 5: s = "RAM диск"
End Select
If D.IsReady Then
funGetDrivers = funGetDrivers D.DriveLetter ":\ - " s ";"
End If
Next
Exit Function
999:
MsgBox Err.Description
Err.Clear
funGetDrivers = ""
End Function
' Обновляем информацию
Private Sub myDrive_AfterUpdate()
funInformationDisk
End Sub