Option Explicit
Private Const MAX_PATH As Long = 260&
Private Declare Function GetLogicalDriveStrings Lib "kernel32.dll" Alias "GetLogicalDriveStringsW" (ByVal nBufferLength As Long, ByVal lpBuffer As Long) As Long
Private Declare Function DeviceIoControl Lib "kernel32.dll" (ByVal hDevice As Long, ByVal dwIoControlCode As Long, lpInBuffer As Any, ByVal nInBufferSize As Long, ByVal lpOutBuffer As Long, ByVal nOutBufferSize As Long, lpBytesReturned As Long, ByVal lpOverlapped As Long) As Long
Private Declare Function CreateFile Lib "kernel32.dll" Alias "CreateFileW" (ByVal lpFileName As Long, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, lpSecurityAttributes As Any, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function CloseHandle Lib "kernel32.dll" (ByVal hObject As Long) As Long
Private Const FILE_READ_ATTRIBUTES As Long = &H80&
Private Const OPEN_EXISTING As Long = 3&
Private Const FILE_SHARE_READ As Long = &H1&
Private Const FILE_SHARE_WRITE As Long = &H2&
Private Const IOCTL_STORAGE_CHECK_VERIFY2 As Long = &H2D0800
Private Sub Form_Load()
Dim Drives() As String
Dim i As Long
'список дисков в массив
Drives = GetDrives()
'перечисляем содержимое массива
For i = 1 To UBound(Drives)
Debug.Print Drives(i)
Next
End Sub
Function GetDrives() As String()
Dim BufLen As Long
Dim Buf As String
Dim i As Long
Dim Drives
Dim ReadyDrives() As String
Dim idx As Long
Dim hDevice As Long
Dim cbBytesReturned As Long
Buf = String$(MAX_PATH, 0)
'получаем список всех букв дисков в системе
BufLen = GetLogicalDriveStrings(MAX_PATH, StrPtr(Buf))
If BufLen <> 0 Then
Buf = Left$(Buf, BufLen - 1)
Drives = Split(Buf, vbNullChar)
ReDim ReadyDrives(UBound(Drives) + 1)
For i = 0 To UBound(Drives)
hDevice = CreateFile(StrPtr("\\.\" & Left$(Drives(i), 2)), _
FILE_READ_ATTRIBUTES, _
FILE_SHARE_READ Or FILE_SHARE_WRITE, _
ByVal 0&, OPEN_EXISTING, 0&, 0&)
If hDevice <> 0 Then
'проверяем готово ли устройство (вставлен ли диск)
If DeviceIoControl(hDevice, _
IOCTL_STORAGE_CHECK_VERIFY2, _
ByVal 0&, 0&, _
0&, 0&, _
cbBytesReturned, _
0&) Then
idx = idx + 1
ReadyDrives(idx) = Drives(i)
End If
CloseHandle hDevice
End If
Next
End If
If idx > 0 Then
ReDim Preserve ReadyDrives(idx)
Else
ReDim ReadyDrives(0)
End If
GetDrives = ReadyDrives
'// todo: do not send IOCTL_STORAGE_CHECK_VERIFY2 control code to floppy drive.
'use IOCTL_STORAGE_CHECK_VERIFY instead.
End Function
