Используя функции GetDriveType и GetDiskFreeSpace определить тип диска и количество свободных кластеров на диске

@Artem_by · Регистрация: 18.02.2014

Студворк — интернет-сервис помощи студентам

Доброго времени суток.Нужна помощь в исправлении кода по 2м АР функциям .Используя функции GetDriveType и GetDiskFreeSpace определить тип диска и количество свободных кластеров на диске.
Среда VS 9.Заранее благодарю.

VB.NET
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
Declare Function GetDiskFreeSpace Lib "kernel32.dll" Alias "GetDiskFreeSpaceA" (ByVal lpRootPathName As String, ByVal lpSectorsPerCluster As Long, ByVal lpBytesPerSector As Long, ByVal lpNumberOfFreeClusters As Long, ByVal lpTotalNumberOfClusters As Long) As Long
    Declare Function GetDriveType Lib "kernel32.dll" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
 
    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        Dim drivetype As Long
        'DRIVE_CDROM = 5
        'CD-ROM. 
        'DRIVE_FIXED = 3
        'Жесткий диск. 
        'DRIVE_RAMDISK = 6
        'RAM-диск. 
        'DRIVE_REMOTE = 4
        'Сетевой диск. 
        'DRIVE_REMOVABLE = 2
        'Сменный диск(напр.дискетта или любой сменный диск). 
        'nDrive()
        'Корневой каталог диска,как "c:\" или "a:\" 
        drivetype = GetDriveType("d:\")
        If drivetype = 0 Then Debug.Print("Error")
        If drivetype = 1 Then Debug.Print("Диск D:\ не существует.")
        If drivetype = DRIVE_RAMDISK Then Print("Диск D:\ Ram диск.")
        If drivetype = DRIVE_REMOVABLE Then Print("Диск D:\ сменный диск.")
        If drivetype = DRIVE_FIXED Then Print("Диск D:\ жесткий диск.")
        If drivetype = DRIVE_CDROM Then Print("Диск D:\ CD-ROM.")
        If drivetype = DRIVE_REMOTE Then Print("Диск D:\ Сетевой диск.")
        If drivetype = nDrive Then Print("Диск D:\ Корневой каталог диска.")
 
    End Sub
 
    Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
        ' Считаем и отображаем количество свободного места и общего объема диска D:
        Dim secPerClus As Long  ' число секторов в кластере
        Dim bytePerSec As Long  ' число байт в секторе
        Dim freeClus As Long  ' число свободных кластеров
        Dim totalClus As Long  ' общее число кластеров
        Dim retval As Long  ' возвращаемое значение
 
        retval = GetDiskFreeSpace("d:\", secPerClus, bytePerSec, freeClus, totalClus)
 
        ' Отображаем информацию
        Debug.Print "Свободно:"; freeClus * secPerClus * bytePerSec; "байт"
        Debug.Print "Общий объем:"; totalClus * secPerClus * bytePerSec; "байт"
    End Sub

@Антихакер32 · 18.02.2014, 11:45

Ссылка1
Ссылка2

@Artem_by · 19.02.2014, 21:16 **[ТС]**

Это не VB.net, а просто VB

@Антихакер32 · 19.02.2014, 21:25

Сообщение от Artem_by

Private Sub Button1_Click(ByVal sender ...

Ты обрати внимание на эту инструкцию, ну не я же тему переместил сюда

SoftIce · 19.02.2014, 23:13

GetDiskFreeSpace - динозавр.

VB.NET
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
Public Class Form1
    'Declare Function GetDiskFreeSpace Lib "kernel32.dll" Alias "GetDiskFreeSpaceA" (ByVal lpRootPathName As String, ByVal lpSectorsPerCluster As Integer, ByVal lpBytesPerSector As Integer, ByVal lpNumberOfFreeClusters As Integer, ByVal lpTotalNumberOfClusters As Integer) As Integer
    Declare Function GetDriveType Lib "kernel32.dll" Alias "GetDriveTypeA" (ByVal nDrive As String) As Integer
 
    Private Declare Function GetDiskFreeSpaceEx _
     Lib "kernel32" _
     Alias "GetDiskFreeSpaceExA" _
     (ByVal lpDirectoryName As String, _
     ByRef lpFreeBytesAvailableToCaller As Long, _
     ByRef lpTotalNumberOfBytes As Long, _
     ByRef lpTotalNumberOfFreeBytes As Long) As Long
 
    Public Const DRIVE_RAMDISK = 6
    Public Const DRIVE_REMOVABLE = 2
    Public Const DRIVE_FIXED = 3
    Public Const DRIVE_REMOTE = 4
    Public Const DRIVERVERSION = 0      '  Device driver version
    Public Const DRIVE_CDROM = 5
 
       Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        Dim drivetype As Long
        drivetype = GetDriveType("d:\")
        If drivetype = 0 Then MsgBox("Error")
        If drivetype = 1 Then MsgBox("Диск D:\ не существует.")
        If drivetype = DRIVE_RAMDISK Then MsgBox("Диск D:\ Ram диск.")
        If drivetype = DRIVE_REMOVABLE Then MsgBox("Диск D:\ сменный диск.")
        If drivetype = DRIVE_FIXED Then MsgBox("Диск D:\ жесткий диск.")
        If drivetype = DRIVE_CDROM Then MsgBox("Диск D:\ CD-ROM.")
        If drivetype = DRIVE_REMOTE Then MsgBox("Диск D:\ Сетевой диск.")
        'If drivetype = nDrive Then  msgbox("Диск D:\ Корневой каталог диска.")
 
    End Sub
 
    Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
        ' Считаем и отображаем количество свободного места и общего объема диска D:
        MsgBox("Total " & GetTotalSpace("D:\") & " MB")
        MsgBox("Free " & GetFreeSpace("D:\") & " MB")
 
    End Sub
    Public Function GetFreeSpace(ByVal Drive As String) As Long
        'returns free space in MB, formatted to two decimal places
        'e.g., msgbox("Free Space on C: "& GetFreeSpace("C:\") & "MB")
 
        Dim lBytesTotal, lFreeBytes, lFreeBytesAvailable As Long
 
        Dim iAns As Long
 
        iAns = GetDiskFreeSpaceEx(Drive, lFreeBytesAvailable, _
             lBytesTotal, lFreeBytes)
        If ians > 0 Then
 
            Return BytesToMegabytes(lFreeBytes)
        Else
            Throw New Exception("Invalid or unreadable drive")
        End If
 
 
    End Function
 
 
    Public Function GetTotalSpace(ByVal Drive As String) As String
        'returns total space in MB, formatted to two decimal places
        'e.g., msgbox("Free Space on C: "& GetTotalSpace("C:\") & "MB")
 
        Dim lBytesTotal, lFreeBytes, lFreeBytesAvailable As Long
 
        Dim iAns As Long
 
        iAns = GetDiskFreeSpaceEx(Drive, lFreeBytesAvailable, _
             lBytesTotal, lFreeBytes)
        If iAns > 0 Then
 
            Return BytesToMegabytes(lBytesTotal)
        Else
            Throw New Exception("Invalid or unreadable drive")
        End If
    End Function
 
    Private Function BytesToMegabytes(ByVal Bytes As Long) _
    As Long
 
 
        Dim dblAns As Double
        dblAns = (Bytes / 1024) / 1024
        BytesToMegabytes = Format(dblAns, "###,###,##0.00")
 
    End Function
End Class

@Artem_by · 02.03.2014, 11:36 **[ТС]**

Спасибо.А можно будет зациклить проверку разных дисков,а не только D,не используя компонентов типо CheckBox,что бы программа проверила все диски?

Добавлено через 2 минуты
Т.е. не просто копирнуть в исходнике код и повставлять для каждого диска,а зациклить?

Памирыч · 02.03.2014, 13:29

Вот небольшой проект, отображает графически пространство доступных дисков (нужно было, не помню для чего)

Кода почти нет

SoftIce · 04.03.2014, 05:53

Сообщение от Artem_by

А можно будет зациклить проверку разных дисков,а не только D

Прошу заметить, что есть более оптимальные решения данного вопроса, но ТС-у нужно именно с использованием GetDriveType и GetDiskFreeSpace

VB.NET
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
Public Class Form1
    'Declare Function GetDiskFreeSpace Lib "kernel32.dll" Alias "GetDiskFreeSpaceA" (ByVal lpRootPathName As String, ByVal lpSectorsPerCluster As Integer, ByVal lpBytesPerSector As Integer, ByVal lpNumberOfFreeClusters As Integer, ByVal lpTotalNumberOfClusters As Integer) As Integer
    Declare Function GetDriveType Lib "kernel32.dll" Alias "GetDriveTypeA" (ByVal nDrive As String) As Integer
 
    Private Declare Function GetDiskFreeSpaceEx _
     Lib "kernel32" _
     Alias "GetDiskFreeSpaceExA" _
     (ByVal lpDirectoryName As String, _
     ByRef lpFreeBytesAvailableToCaller As Long, _
     ByRef lpTotalNumberOfBytes As Long, _
     ByRef lpTotalNumberOfFreeBytes As Long) As Long
 
    Public Const DRIVE_RAMDISK = 6
    Public Const DRIVE_REMOVABLE = 2
    Public Const DRIVE_FIXED = 3
    Public Const DRIVE_REMOTE = 4
    Public Const DRIVERVERSION = 0      '  Device driver version
    Public Const DRIVE_CDROM = 5
 
    Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
        Dim letter As String = "", S As String = "", i As Integer
        Dim St() As String = {"Error", " не существует.", " сменный диск.", " жесткий диск.", " Сетевой диск.", "  CD-ROM.", " Ram диск."}
        Dim AlfaBet As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
        Dim drivetype As Long
        For i = 1 To Len(AlfaBet)
            letter = Mid(AlfaBet, i, 1)
            drivetype = GetDriveType(letter & ":\")
            If drivetype = 1 Then
                S &= ("Диск '" & letter & "' не определен") & vbCrLf
            Else
                S &= "Диск " & letter & St(drivetype) & vbTab & _
                     "Всего на '" & letter & "' : " & GetTotalSpace(CStr(letter) & ":\") & " MB" & vbTab & _
                     "Свободно на '" & letter & "' : " & GetFreeSpace(CStr(letter) & ":\") & " MB" & vbCrLf
            End If
        Next
        MsgBox(S)
    End Sub
 
 
 
    Public Function GetFreeSpace(ByVal Drive As String) As Long
        'returns free space in MB, formatted to two decimal places
        'e.g., msgbox("Free Space on C: "& GetFreeSpace("C:\") & "MB")
 
        Dim lBytesTotal, lFreeBytes, lFreeBytesAvailable As Long
 
        Dim iAns As Long
 
        iAns = GetDiskFreeSpaceEx(Drive, lFreeBytesAvailable, _
             lBytesTotal, lFreeBytes)
        If ians > 0 Then
 
            Return BytesToMegabytes(lFreeBytes)
        Else
            Throw New Exception("Invalid or unreadable drive")
        End If
 
 
    End Function
 
 
    Public Function GetTotalSpace(ByVal Drive As String) As String
        'returns total space in MB, formatted to two decimal places
        'e.g., msgbox("Free Space on C: "& GetTotalSpace("C:\") & "MB")
 
        Dim lBytesTotal, lFreeBytes, lFreeBytesAvailable As Long
 
        Dim iAns As Long
 
        iAns = GetDiskFreeSpaceEx(Drive, lFreeBytesAvailable, _
             lBytesTotal, lFreeBytes)
        If iAns > 0 Then
 
            Return BytesToMegabytes(lBytesTotal)
        Else
            Throw New Exception("Invalid or unreadable drive")
        End If
    End Function
 
    Private Function BytesToMegabytes(ByVal Bytes As Long) _
    As Long
 
 
        Dim dblAns As Double
        dblAns = (Bytes / 1024) / 1024
        BytesToMegabytes = Format(dblAns, "###,###,##0.00")
 
    End Function
End Class

Новые блоги и статьи Все статьи Все блоги /
Кто-нибудь знает, где можно бесплатно получить настольный компьютер или ноутбук? США. Programma_Boinc 26.12.2025 Кто-нибудь знает, где можно бесплатно получить настольный компьютер или ноутбук? США. Нашел на реддите интересную статью под названием «Кто-нибудь знает, где получить бесплатный компьютер или. . .	Thinkpad X220 Tablet — это лучший бюджетный ноутбук для учёбы, точка. Programma_Boinc 23.12.2025 Рецензия / Мнение/ Перевод Нашел на реддите интересную статью под названием The Thinkpad X220 Tablet is the best budget school laptop period . Ниже её машинный перевод. Thinkpad X220 Tablet —. . .	PhpStorm 2025.3: WSL Terminal всегда стартует в ~ and_y87 14.12.2025 PhpStorm 2025. 3: WSL Terminal всегда стартует в ~ (home), игнорируя директорию проекта Симптом: После обновления до PhpStorm 2025. 3 встроенный терминал WSL открывается в домашней директории. . .	Как объединить две одинаковые БД Access с разными данными VikBal 11.12.2025 Помогите пожалуйста !! Как объединить 2 одинаковые БД Access с разными данными.	Новый ноутбук volvo 07.12.2025 Всем привет. По скидке в "черную пятницу" взял себе новый ноутбук Lenovo ThinkBook 16 G7 на Амазоне: Ryzen 5 7533HS 64 Gb DDR5 1Tb NVMe 16" Full HD Display Win11 Pro
Музыка, написанная Искусственным Интеллектом volvo 04.12.2025 Всем привет. Некоторое время назад меня заинтересовало, что уже умеет ИИ в плане написания музыки для песен, и, собственно, исполнения этих самых песен. Стихов у нас много, уже вышли 4 книги, еще 3. . .	От async/await к виртуальным потокам в Python IndentationError 23.11.2025 Армин Ронахер поставил под сомнение async/ await. Создатель Flask заявляет: цветные функции - провал, виртуальные потоки - решение. Не threading-динозавры, а новое поколение лёгких потоков. Откат?. . .	Поиск "дружественных имён" СОМ портов Argus19 22.11.2025 Поиск "дружественных имён" СОМ портов На странице: https:/ / norseev. ru/ 2018/ 01/ 04/ comportlist_windows/ нашёл схожую тему. Там приведён код на С++, который показывает только имена СОМ портов, типа,. . .	Сколько Государство потратило денег на меня, обеспечивая инсулином. Programma_Boinc 20.11.2025 Сколько Государство потратило денег на меня, обеспечивая инсулином. Вот решила сделать интересный приблизительный подсчет, сколько государство потратило на меня денег на покупку инсулинов. . . .	Ломающие изменения в C#.NStar Alpha Etyuhibosecyu 20.11.2025 Уже можно не только тестировать, но и пользоваться C#. NStar - писать оконные приложения, содержащие надписи, кнопки, текстовые поля и даже изображения, например, моя игра "Три в ряд" написана на этом. . .

@Антихакер32 1201 / 473 / 46 Регистрация: 06.01.2014 Сообщений: 1,797 Записей в блоге: 19
	18.02.2014, 11:45
	Ссылка1 Ссылка2 0

@Artem_by 0 / 0 / 0 Регистрация: 18.02.2014 Сообщений: 10
	19.02.2014, 21:16 [ТС]
	Это не VB.net, а просто VB 0

@Artem_by 0 / 0 / 0 Регистрация: 18.02.2014 Сообщений: 10
	02.03.2014, 11:36 [ТС]
	Спасибо.А можно будет зациклить проверку разных дисков,а не только D,не используя компонентов типо CheckBox,что бы программа проверила все диски? Добавлено через 2 минуты Т.е. не просто копирнуть в исходнике код и повставлять для каждого диска,а зациклить? 0

Используя функции GetDriveType и GetDiskFreeSpace определить тип диска и количество свободных кластеров на диске

Решение