Drivelistbox

Signaler
Messages postés
14
Date d'inscription
jeudi 2 octobre 2003
Statut
Membre
Dernière intervention
30 décembre 2004
-
Messages postés
201
Date d'inscription
jeudi 26 février 2004
Statut
Membre
Dernière intervention
30 juin 2008
-
Bonjour,

est-il possible, dans une DriveListBox, d'afficher le nom entier des lecteurs, et du titre des CDROM.

Par exemple, dans mon appli, j'ai les lecteurs :
a:
c:
d:(lecteur CDROM)
e:(lecteur DVD)

mais lorsqu'un cd est inséré dans un des lecteurs, le "libellé" ne change pas !!! j'ai toujours une simple lettre !!

merci d'avance,

yeye

6 réponses

Messages postés
1247
Date d'inscription
mardi 7 mai 2002
Statut
Membre
Dernière intervention
18 février 2019
3
Non a ma connaissance ce n'est pas possible avec un drive listbox, mais tu peu le faire avec un combo box et l'api : GetVolumeInformation.

Ci dessous un exemple avec un combobox (combo1) :

Dans un module :

' Déclaration
Declare Function GetVolumeInformation Lib "kernel32" Alias "GetVolumeInformationA" ( _
    ByVal lpRootPathName As String, _
    ByVal lpVolumeNameBuffer As String, _
    ByVal nVolumeNameSize As Long, _
    lpVolumeSerialNumber As Long, _
    lpMaximumComponentLength As Long, _
    lpFileSystemFlags As Long, _
    ByVal lpFileSystemNameBuffer As String, _
    ByVal nFileSystemNameSize As Long) As Long


Dans ta form :

Private Sub Form_Load()
Dim fso As Object, dR, d
    
    ' Recherche les lecteurs de CD sur la machine et sélectionne le 1er
    Set fso = CreateObject("scripting.FileSystemObject")
    Set dR = fso.Drives
    For Each d In dR
    
       
        Dim r&, PathName$, DrvVolumeName$, DrvSerialNo$
        rgbGetVolumeInformationRDI d.driveletter & ":", DrvVolumeName$, DrvSerialNo$
        If Trim(DrvVolumeName$) <> vbNullString Then
        Combo1.AddItem d.driveletter & ": [" & DrvVolumeName$ & "]"
        Else
        Combo1.AddItem d.driveletter & ": "
        End If
     
        
    Next d
    
        Combo1.ListIndex = 0
   
End Sub
Private Sub rgbGetVolumeInformationRDI(PathName$, DrvVolumeName$, DrvSerialNo$)
    Dim r As Long
    Dim pos As Integer
    Dim HiWord As Long
    Dim HiHexStr As String
    Dim LoWord As Long
    Dim LoHexStr As String
    Dim VolumeSN As Long
    Dim MaxFNLen As Long
    Dim UnusedStr As String
    Dim UnusedVal1 As Long
    Dim UnusedVal2 As Long

    DrvVolumeName$ = Space$(14)
    UnusedStr$ = Space$(32)

    r& = GetVolumeInformation(PathName$, _
    DrvVolumeName$, Len(DrvVolumeName$), VolumeSN&, _
    UnusedVal1&, UnusedVal2&, UnusedStr$, Len(UnusedStr$))

    If r& = 0 Then Exit Sub

    'determine le label

    pos% = InStr(DrvVolumeName$, Chr$(0))
    If pos% Then DrvVolumeName$ = Left$(DrvVolumeName$, pos% - 1)    If Len(Trim$(DrvVolumeName$)) 0 Then DrvVolumeName$ "(pas de label)"
    
    'determine l'id du disque

    HiWord& = GetHiWord(VolumeSN&) And &HFFFF&
    LoWord& = GetLoWord(VolumeSN&) And &HFFFF&
    
    HiHexStr$ = Format$(Hex(HiWord&), "0000")
    LoHexStr$ = Format$(Hex(LoWord&), "0000")
    
    DrvSerialNo$ = HiHexStr$ & "-" & LoHexStr$
End Sub
Function GetHiWord(dw As Long) As Integer
    If dw& And &H80000000 Then
        GetHiWord% = (dw& \ 65535) - 1
    Else: GetHiWord% = dw& \ 65535
    End If
End Function
Function GetLoWord(dw As Long) As Integer
    If dw& And &H8000& Then
        GetLoWord% = &H8000 Or (dw& And &H7FFF&)
    Else: GetLoWord% = dw& And &HFFFF&
    End If
End Function


Voila ++
Messages postés
14
Date d'inscription
jeudi 2 octobre 2003
Statut
Membre
Dernière intervention
30 décembre 2004

ouh la !!! que c long !!
je me plonge dans tout ça !

merci beaucoup

yeye
Messages postés
106
Date d'inscription
lundi 16 décembre 2002
Statut
Membre
Dernière intervention
28 octobre 2005

Salut yeyedeb

Pour savoir le nom d'un volume, en VB,
y'a (légerement) plus simple :

'Dim NomLect as string

NomLect = Dir("d:", vbVolume)

N$
Messages postés
1247
Date d'inscription
mardi 7 mai 2002
Statut
Membre
Dernière intervention
18 février 2019
3
Effectivement NicoSoftt a raison est pas "légérement" lol
Je ne connaissais pas cette argument de la commande dir!!!!

Mille excuse Yeyeded et merci a Nicosoftt!!!

Donc ca donne plus simplement :

Dim fso As Object, dR, d
Set fso = CreateObject("scripting.FileSystemObject")
Set dR = fso.Drives
For Each d In dR
Combo1.AddItem d.driveletter & ": [" & Dir(d.driveletter & ":/", vbVolume) & "]"
Next


voila ++
Messages postés
14
Date d'inscription
jeudi 2 octobre 2003
Statut
Membre
Dernière intervention
30 décembre 2004

ah oui en effet, ça marche très bien aussi !!! ;o)

en tout cas, merci à tous les deux !!!

yeye
Messages postés
201
Date d'inscription
jeudi 26 février 2004
Statut
Membre
Dernière intervention
30 juin 2008

merci bcp nicosoft et pcpunch, vous m'enlevez une epine du pied....
;-)

zeunz.