How to retrieve the Volume Label and Serial Number of a Drive

How to retrieve the Volume Label and Serial Number of a Drive

A question that is often asked is how to retrieve the Serial Number of a hard drive, in order to try and check that the application is not being installed on many computers. Whilst this can be done using API calls, you should note that the serial number of a hard drive is not reliable for this. If the user installs a new Hard Drive, the software will obviously report a different value. Anyway, the API that you need to use is GetVolumeInformationA. Below are two functions that use this API to return both the Serial Number of the drive and also the Volume Label, as well as an example of how to retrieve the Volume Label using the VBA Dir function.

Option Compare Database
Option Explicit

Private Declare Function apiGetVolumeInformation 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

Private Const MAX_PATH = 260

Function fVolume1(strDriveLetter As String) As String
'   Function to return the volume label for a drive
'   Accepts:
'       strDriveLetter - a valid drive letter for the PC, in the format "C:\"
'   Returns:
'       The volume label if it exists, or else "No label"
    Dim strVolume As String
    strVolume = Dir(strDriveLetter, vbVolume)
    If strVolume = "" Then strVolume = "No label"
    fVolume1 = strVolume
End Function

Function fVolume2(strDriveLetter As String) As String
'   Function to return the volume label for a drive
'   Accepts:
'       strDriveLetter - a valid drive letter for the PC, in the format "C:\"
'   Returns:
'       The volume label if it exists, or else "No label"
    Dim lngReturn As Long, lngDummy1 As Long, lngDummy2 As Long, lngDummy3 As Long
    Dim strVolume As String, strDummy As String
    strVolume = Space(MAX_PATH)
    strDummy = Space(MAX_PATH)
    lngReturn = apiGetVolumeInformation(strDriveLetter, strVolume, Len(strVolume), lngDummy1, lngDummy2, lngDummy3, strDummy, Len(strDummy))
    strVolume = Left(strVolume, InStr(strVolume, vbNullChar) - 1)
    If strVolume = "" Then strVolume = "No label"
    fVolume2 = strVolume
End Function

Function fSerialNumber(strDriveLetter As String) As String
'   Function to return the serial number for a hard drive
'   Accepts:
'       strDriveLetter - a valid drive letter for the PC, in the format "C:\"
'   Returns:
'       The serial number for the drive, formatted as "xxxx-xxxx"
    Dim lngReturn As Long, lngDummy1 As Long, lngDummy2 As Long, lngSerial As Long
    Dim strDummy1 As String, strDummy2 As String, strSerial As String
    strDummy1 = Space(MAX_PATH)
    strDummy2 = Space(MAX_PATH)
    lngReturn = apiGetVolumeInformation(strDriveLetter, strDummy1, Len(strDummy1), lngSerial, lngDummy1, lngDummy2, strDummy2, Len(strDummy2))
    strSerial = Trim(Hex(lngSerial))
    strSerial = String(8 - Len(strSerial), "0") & strSerial
    strSerial = Left(strSerial, 4) & "-" & Right(strSerial, 4)
    fSerialNumber = strSerial
End Function

Top

Last modified at 06/06/2006 14:53:15