Soyez le premier à donner votre avis sur cette source.
Snippet vu 24 095 fois - Téléchargée 90 fois
' 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
parce que sa me parresais louche
Kevin
ses la 98 ème source de nix fait le meme jour meme heure et minute et seconde 17/09/1999 00:00:00 xD mdr
Kevin
Si vous voulez le No de disque dur physique et non de la partition, en cherchant bien sur le site vous trouverez cette adresse: http://www.vbfrance.com/code.aspx?ID=27883
Le code fonctionne apparement sous tout les OS.
Bonne prog.
MERCI
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.