Comment puis-je lire le numéro de série du volume HDD à l'aide de VB 6?

Question

Comment puis-je lire le numéro de série du volume du disque dur à l'aide de la VB 6, mais sans utiliser de contrôles ActiveX ou d'extensions tierces?

Answer 1

Private Declare Function GetVolumeInformation _ 
    Lib "kernel32" Alias "GetVolumeInformationA" _ 
    (ByVal lpRootPathName As String, _ 
    ByVal pVolumeNameBuffer 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 

Public Function GetSerialNumber(_ 
    ByVal sDrive As String) As Long 

    If Len(sDrive) Then 
     If InStr(sDrive, "\\") = 1 Then 
      ' Make sure we end in backslash for UNC 
      If Right$(sDrive, 1) <> "\" Then 
       sDrive = sDrive & "\" 
      End If 
     Else 
      ' If not UNC, take first letter as drive 
      sDrive = Left$(sDrive, 1) & ":\" 
     End If 
    Else 
     ' Else just use current drive 
     sDrive = vbNullString 
    End If 

    ' Grab S/N -- Most params can be NULL 
    Call GetVolumeInformation(_ 
     sDrive, vbNullString, 0, GetSerialNumber, _ 
     ByVal 0&, ByVal 0&, vbNullString, 0) 
End Function 

Pour appeler:

Dim Drive As String 
Drive = InputBox("Enter drive for checking SN") 
MsgBox Hex$(GetSerialNumber(Drive)) 

Source: http://www.devx.com/tips/Tip/15908

Answer 2

L'exemple suivant fournit de série du lecteur où votre EXE est

'APi declaration 
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 

Sub subHDsn() 
Dim TempAPi, VolumeSerial As Long 
Dim strPATH As String 

    On Error Resume Next 

    TempAPi = 0 
    VolumeSerial = 0 
    If App.Path Like "*:*" Then 
     'checking whether the drive is local or mapped 
     strPATH = Left(App.Path, 3) 
    Else 
     'if it's a UNC 
     strPATH = Left(App.Path, InStr((InStr(3, App.Path, "\") + 1), App.Path, "\")) 
    End If 
    'call API 
    TempAPi = GetVolumeInformation(strPATH, VolumeName, 100, VolumeSerial, 100, FileSystemFlags, FileSystemName, 100) 
    If TempAPi = 0 Then 
     MsgBox "Error calling API!", 16 
     End 
    End If 
    'convert from HeX 
    HDsn = Hex(VolumeSerial) 

End Sub 

Answer 3

L'exemple suivant sans API besoin.

Public Function GetSerialNumber(ByVal sDrive As String) As String 
    On Error Resume Next 
    Open "Vol.bat" For Output As 1 
     Print #1, "@vol %1%>DSN" 
    Close 
    Kill "DSN" 
    Shell ("Vol.bat " + sDrive) 
    Do 
     Open "DSN" For Input As 1 
     Input #1, GetSerialNumber 
     Input #1, GetSerialNumber 
     Close 
    Loop While GetSerialNumber = "" 
    GetSerialNumber = Right$(GetSerialNumber, 9) 
    Kill "Vol.bat" 
    Kill "DSN" 
End Function