Soyez le premier à donner votre avis sur cette source.
Snippet vu 21 593 fois - Téléchargée 9 fois
Function GetPhysicalDriveSerialNumber(Optional ID As Integer = 0, Optional bSepar As Boolean = True) As String GetPhysicalDriveSerialNumber = "0000-0000" On Local Error Resume Next Dim sComputerName$ sComputerName = Environ$("COMPUTERNAME") Dim WMI_Obj As Object, WMI_ObjProps As Object, ObjClsItem As Object Set WMI_Obj = GetObject("winmgmts:\\" & sComputerName & "\root\cimv2") Set WMI_ObjProps = WMI_Obj.ExecQuery("Select * from Win32_PhysicalMedia", , 48) Dim sRet As String For Each ObjClsItem In WMI_ObjProps If ObjClsItem.Tag = "\\.\PHYSICALDRIVE" & CStr(ID) Then ' ici le serial en base16 ou 10 sRet = Trim$(ObjClsItem.SerialNumber) ' conversion base10 If Not (LenB(sRet) = 16) Then sRet = GetBase10FromBase16(sRet) ' ok, retour If bSepar Then GetPhysicalDriveSerialNumber = UCase$(LeftB$(sRet, 8) & "-" & RightB$(sRet, 8)) Else GetPhysicalDriveSerialNumber = UCase$(sRet) End If Exit For End If Next ObjClsItem Set ObjClsItem = Nothing Set WMI_ObjProps = Nothing Set WMI_Obj = Nothing End Function Private Function GetBase10FromBase16(ByVal sStr As String) As String Dim i As Integer sStr = Replace(sStr, "20", vbNullString) GetBase10FromBase16 = Space$(8) For i = 1 To 15 Step 2 Mid$(GetBase10FromBase16, i \ 2 + 1, 1) = Chr$(Val("&H" & Mid$(sStr, i, 2))) Next i End Function
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.