Attribute VB_Name = "DriveRead"
'lancer le sub DList
'strDrives est un tableau qui contient tout les nom des drives et leur types




Option Explicit
'Constante
Private Const DRIVE_UNKNOWN = 0
Private Const DRIVE_ABSENT = 1
Private Const DRIVE_REMOVABLE = 2
Private Const DRIVE_FIXED = 3
Private Const DRIVE_REMOTE = 4
Private Const DRIVE_CDROM = 5
Private Const DRIVE_RAMDISK = 6


'API
Private Declare Function GetLogicalDriveStrings Lib "kernel32" Alias _
    "GetLogicalDriveStringsA" (ByVal nBufferLength As Long, _
    ByVal lpBuffer As String) As Long
Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" _
    (ByVal nDrive As String) As Long


'Function
Private Function fGetDrives() As String
    Dim lngRet As Long
    Dim buffer As String * 255

    lngRet = GetLogicalDriveStrings(255, buffer)
    fGetDrives = Left(buffer, lngRet)
End Function

Public Function fDriveType(strDriveName As String) As String
    Dim lngRet As Long
    Dim strDrive As String
    lngRet = GetDriveType(strDriveName)
    Select Case lngRet
        Case DRIVE_FIXED
            strDrive = "Disque fixe"
        Case DRIVE_REMOTE
            strDrive = "Lecteur réseau"
            Case DRIVE_UNKNOWN
            strDrive = "Inconnu"
        Case DRIVE_ABSENT
            strDrive = "Absent"
        Case DRIVE_REMOVABLE
            strDrive = "Amovible"
        Case DRIVE_CDROM
            strDrive = "CD Rom"
        Case DRIVE_RAMDISK
            strDrive = "Disque ram"
    End Select
    fDriveType = strDrive
End Function


Public Function ListAllDrives(ByRef strDrives)

    Dim strAllDrives As String
    Dim strTmp As String
    Dim NbOccurence As Byte
   'Dim strDrives(0 To 254, 0 To 254) As String 'Tableau qui contient les drives
    
    strAllDrives = fGetDrives
    If strAllDrives <> "" Then
        Do
            strTmp = Mid$(strAllDrives, 1, InStr(strAllDrives, vbNullChar) - 1) 'lecture du lecteur (ex: A:\vbNullChar) jusqu'à vbnullchar
            strAllDrives = Mid$(strAllDrives, InStr(strAllDrives, vbNullChar) + 1) 'supprime le lecteur lu de la liste
            
            strDrives(NbOccurence, 0) = strTmp
            strDrives(NbOccurence, 1) = fDriveType(strTmp)
            

            NbOccurence = NbOccurence + 1
        Loop While strAllDrives <> ""
    End If


End Function

Public Sub DList()
Dim strDrives(0 To 254, 0 To 254) As String 'Tableau qui contient les drives
Call ListAllDrives(strDrives)
MsgBox strDrives(4, 1)
End Sub