drivelistbox

Question

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

pcpunch · Answer

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 ++

yeyedeb · Answer

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

NicoSoftt · Answer

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$

pcpunch · Answer

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 ++

yeyedeb · Answer

ah oui en effet, ça marche très bien aussi !!! ;o)

en tout cas, merci à tous les deux !!!

yeye

zeunz · Answer

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

Drivelistbox

6 réponses

Discussions similaires