Recuperer le label et le numero de serie d'un disque dur


Commenter

Contenu du snippet

Récuperer les infos du disque ( N° de série et le label du disque )

Source / Exemple : 


' Déclaration à mettre dans un Module

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
'Fin des Déclarations

Private Sub Bouton1_Click()
    Dim r&, PathName$, DrvVolumeName$, DrvSerialNo$

'Disque à checker

    PathName$ = "c:\"
    
    rgbGetVolumeInformationRDI PathName$, DrvVolumeName$, DrvSerialNo$
    
    'Afficher le résultat dans des msgbox

    MsgBox (" Lecteur " & ": " & UCase$(PathName$))
    MsgBox (" Le Label du disk " & ": " & DrvVolumeName$)
    MsgBox (" Le Numéro de série du disque " & ": " & DrvSerialNo$)
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

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (Nix)