Как узнать свободное место на диске в VB6: FileSystemObject и GetDiskFreeSpaceEx

Когда программе нужно знать свободное место

Экспорт базы, сохранение бэкапа, распаковка обновления, запись видео. Если место кончится посередине, пользователь получит обрезанный файл и ошибку 61 «Disk full» в самый неудобный момент. Гораздо вежливее проверить свободное пространство заранее и сразу сказать: «нужно 2,4 ГБ, доступно 900 МБ».

Та же проверка полезна в сервисных утилитах: мониторинг серверов, очистка временных папок при заполнении диска, предупреждение администратора.

Ниже два способа: через объект Drive библиотеки Scripting Runtime, где всё решается одной строкой, и через вызов Windows API, который не требует дополнительных ссылок. Оба возвращают значения в байтах, поэтому отдельно разберём перевод в понятные единицы и правильный тип переменной.

Самый короткий способ: FileSystemObject

Библиотека Microsoft Scripting Runtime содержит объект Drive со свойствами размера. Функция получает букву диска, путь к папке на нём или сетевой путь и возвращает число байтов.

Тип результата Double выбран не случайно. Long в VB6 вмещает только около 2 миллиардов, то есть 2 ГБ, а современные диски гораздо больше. Double точно хранит целые числа до 2 в степени 53, этого хватит на любой накопитель.

' Нужна ссылка: Microsoft Scripting Runtime
Public Function GetDriveAvailableSpace(ByVal strDrive As String) As Double
    Dim fso As New Scripting.FileSystemObject
    Dim drv As Scripting.Drive

    ' GetDriveName вытащит "C:" из "C:\Data\file.txt"
    Set drv = fso.GetDrive(fso.GetDriveName(strDrive))
    If Not drv.IsReady Then
        Err.Raise vbObjectError + 1, "GetDriveAvailableSpace", _
                  "Диск " & drv.DriveLetter & " не готов"
    End If
    GetDriveAvailableSpace = drv.AvailableSpace
End Function

AvailableSpace, FreeSpace и TotalSize

У объекта Drive три свойства размера, и путать их не стоит.

• AvailableSpace: сколько байтов может записать текущий пользователь с учётом дисковых квот;
• FreeSpace: всё свободное место тома без учёта квот;
• TotalSize: полный объём тома.

Перевод в понятные единицы и перебор дисков

Пользователю нужны не байты, а гигабайты с одним знаком после запятой. Небольшая функция форматирования выбирает подходящую единицу сама. Делить следует на 1024, так считает и Проводник Windows.

Коллекция fso.Drives перечисляет все диски системы. Перед чтением размеров проверяйте IsReady: пустой привод компакт-дисков или отключённый кардридер вернёт ошибку 71 «Disk not ready». Свойство DriveType отличает съёмные (1), жёсткие (2), сетевые (3), CD-ROM (4) и RAM-диски (5).

Public Function FormatBytes(ByVal b As Double) As String
    Dim units As Variant, i As Integer
    units = Array("Б", "КБ", "МБ", "ГБ", "ТБ")
    Do While b >= 1024 And i < UBound(units)
        b = b / 1024: i = i + 1
    Loop
    FormatBytes = Format$(b, "0.0") & " " & units(i)
End Function

Public Sub ListDrives()
    Dim fso As New Scripting.FileSystemObject, d As Scripting.Drive
    For Each d In fso.Drives
        If d.IsReady And d.DriveType = Fixed Then
            Debug.Print d.DriveLetter & ": свободно " & FormatBytes(d.AvailableSpace) _
                        & " из " & FormatBytes(d.TotalSize)
        End If
    Next
End Sub

Без Scripting Runtime: API GetDiskFreeSpaceEx

Если проект не должен зависеть от scrrun.dll (например, на машинах, где администратор отключил Windows Script Host), используйте функцию kernel32 GetDiskFreeSpaceEx. Старая GetDiskFreeSpace возвращает неверные значения на томах больше 2 ГБ, её применять не надо.

API отдаёт 64-битные целые. В VB6 нет типа LongLong, но есть Currency: это тоже 8 байтов, только с фиксированной точкой и четырьмя знаками после запятой. Значение получается в 10000 раз меньше, поэтому результат умножают на 10000.

Private Declare Function GetDiskFreeSpaceEx Lib "kernel32" _
    Alias "GetDiskFreeSpaceExA" (ByVal lpRoot As String, _
    lpFreeAvailable As Currency, lpTotal As Currency, _
    lpTotalFree As Currency) As Long

Public Function FreeBytesApi(ByVal strRoot As String) As Double
    Dim avail As Currency, total As Currency, free As Currency
    ' strRoot: "C:\" или "\\server\share\"
    If GetDiskFreeSpaceEx(strRoot, avail, total, free) = 0 Then
        Err.Raise vbObjectError + 2, "FreeBytesApi", "Ошибка API: " & Err.LastDllError
    End If
    FreeBytesApi = CDbl(avail) * 10000   ' Currency хранит значение / 10000
End Function

Сетевые пути и практическая проверка

Обе техники работают с UNC-путями вида \\server\share. FileSystemObject принимает их в GetDrive напрямую, а API требует завершающую обратную косую черту. Для сетевой папки получится место, доступное вашей учётной записи на сервере.

Проверку перед записью делайте с запасом: файловая система тратит место на кластеры и метаданные, а другие процессы пишут на тот же диск параллельно. Разумно требовать хотя бы на 5 или 10 процентов больше, чем размер будущего файла, и всё равно обрабатывать ошибку 61 при самой записи.

Для долгих операций проверку стоит повторять: если бэкап пишется полчаса, за это время соседний процесс может занять оставшееся место. Достаточно сверяться с AvailableSpace после каждого крупного блока и останавливать запись с понятным сообщением, пока на диске ещё остаётся резерв.

Как это делают сегодня

Вопросы и ответы