Программирование на Visual Basic

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