The DriveInfo class represents information about a drive. Its Initialize function uses the GetVolumeInformation and GetDriveType API functions to load detailed drive information into its public variables. The ToString method provides a string giving all of the details in a convenient tab-delimited format.

Public DriveType As DriveTypes
Public VolumeName As String
Public FileSystemName As String
Public SerialNumber As Long
Public MaxComponentLength As Long
Public SupportsLongFileNames As Boolean
Public FileSystemFlags As Long
Public PreservesNames As Boolean
Public CaseSensitiveSearch As Boolean
Public SupportsUnicodeOnDisk As Boolean
Public SupportsPersistentAcls As Boolean
Public SupportsFileCompression As Boolean
Public VolumeIsCompressed As Boolean
Public SupportsEncryption As Boolean
Public SupportsObjectIds As Boolean
Public SupportsReparsePoints As Boolean
Public SupportsSparseFiles As Boolean
Public SupportsVolumeQuotas As Boolean
Public IsEmpty As Boolean

' Load the information for this drive.
' Parameter drive_name should be a single letter.
Public Sub Initialize(ByVal drive_name As String)
Dim volume_name As String
Dim file_system_name As String
Dim info_status As Long
Dim file_system_flags As Long

    ' Format the drive name as in A:\.
    drive_name = UCase$(Left$(drive_name, 1) & ":\")

    ' Get the drive type.
    Me.DriveType = GetDriveType(drive_name)

    ' Initialize name buffers.
    volume_name = Space$(256)
    file_system_name = Space$(256)

    ' Get the volume information.
    info_status = GetVolumeInformation(drive_name, _
        volume_name, Len(volume_name), Me.SerialNumber, _
        Me.MaxComponentLength, file_system_flags, _
        file_system_name, Len(file_system_name))

    ' Set the return values.
    Me.VolumeName = CleanString(volume_name)
    Me.FileSystemName = CleanString(file_system_name)
    Me.SupportsLongFileNames = (Me.MaxComponentLength = 255)
    Me.FileSystemFlags = file_system_flags
    Me.PreservesNames = (file_system_flags And _
        FILE_CASE_PRESERVED_NAMES)
    Me.CaseSensitiveSearch = (file_system_flags And _
        FILE_CASE_SENSITIVE_SEARCH)
    Me.SupportsUnicodeOnDisk = (file_system_flags And _
        FILE_UNICODE_ON_DISK)
    Me.SupportsPersistentAcls = (file_system_flags And _
        FILE_PERSISTENT_ACLS)
    Me.SupportsFileCompression = (file_system_flags And _
        FILE_FILE_COMPRESSION)
    Me.VolumeIsCompressed = (file_system_flags And _
        FILE_VOLUME_IS_COMPRESSED)
    Me.SupportsEncryption = (file_system_flags And _
        FILE_SUPPORTS_ENCRYPTION)
    Me.SupportsObjectIds = (file_system_flags And _
        FILE_SUPPORTS_OBJECT_IDS)
    Me.SupportsReparsePoints = (file_system_flags And _
        FILE_SUPPORTS_REPARSE_POINTS)
    Me.SupportsSparseFiles = (file_system_flags And _
        FILE_SUPPORTS_SPARSE_FILES)
    Me.SupportsVolumeQuotas = (file_system_flags And _
        FILE_VOLUME_QUOTAS)

    If (Me.DriveType = drivetype_REMOVABLE) Or _
       (Me.DriveType = drivetype_CDROM) _
    Then
        Me.IsEmpty = (info_status = 0)
    Else
        Me.IsEmpty = False
    End If
End Sub

' Truncate the string at a NULL character if it
' contains one and remove leading and trailing spaces.
Private Function CleanString(ByVal txt As String) As String
Dim pos As Integer

    pos = InStr(txt, vbNullChar)
    If pos > 0 Then txt = Left$(txt, pos - 1)
    CleanString = Trim$(txt)
End Function

' Return a string representing the drive information.
Public Function ToString() As String
Dim txt As String

    txt = "DriveType:" & vbTab
    Select Case Me.DriveType
        Case drivetype_UNKNOWN
            txt = txt & "Unknown"
        Case drivetype_NO_ROOT_DIR
            txt = txt & "No root directory"
        Case drivetype_REMOVABLE
            txt = txt & "Removable"
        Case drivetype_FIXED
            txt = txt & "Fixed"
        Case drivetype_REMOTE
            txt = txt & "Remote"
        Case drivetype_CDROM
            txt = txt & "CD ROM"
        Case drivetype_RAMDISK
            txt = txt & "Ramdisk"
        Case Else
            txt = txt & "Unknown"
    End Select
    txt = txt & vbCrLf

    txt = txt & "VolumeName: " & vbTab & Me.VolumeName & _
        vbCrLf
    txt = txt & "FileSystemName: " & vbTab & _
        Me.FileSystemName & vbCrLf
    txt = txt & "SerialNumber: " & vbTab & Me.SerialNumber _
        & vbCrLf
    txt = txt & "MaxComponentLength: " & vbTab & _
        Me.MaxComponentLength & vbCrLf
    txt = txt & "SupportsLongFileNames: " & vbTab & _
        Me.SupportsLongFileNames & vbCrLf
    txt = txt & "FileSystemFlags: " & vbTab & _
        Hex$(Me.FileSystemFlags) & vbCrLf
    txt = txt & "PreservesNames: " & vbTab & _
        Me.PreservesNames & vbCrLf
    txt = txt & "CaseSensitiveSearch: " & vbTab & _
        Me.CaseSensitiveSearch & vbCrLf
    txt = txt & "SupportsUnicodeOnDisk: " & vbTab & _
        Me.SupportsUnicodeOnDisk & vbCrLf
    txt = txt & "SupportsPersistentAcls: " & vbTab & _
        Me.SupportsPersistentAcls & vbCrLf
    txt = txt & "SupportsFileCompression: " & vbTab & _
        Me.SupportsFileCompression & vbCrLf
    txt = txt & "VolumeIsCompressed: " & vbTab & _
        Me.VolumeIsCompressed & vbCrLf
    txt = txt & "SupportsEncryption: " & vbTab & _
        Me.SupportsEncryption & vbCrLf
    txt = txt & "SupportsObjectIds: " & vbTab & _
        Me.SupportsObjectIds & vbCrLf
    txt = txt & "SupportsReparsePoints: " & vbTab & _
        Me.SupportsReparsePoints & vbCrLf
    txt = txt & "SupportsSparseFiles: " & vbTab & _
        Me.SupportsSparseFiles & vbCrLf
    txt = txt & "SupportsVolumeQuotas: " & vbTab & _
        Me.SupportsVolumeQuotas & vbCrLf
    txt = txt & "IsEmpty: " & vbTab & Me.IsEmpty & vbCrLf
    ToString = txt
End Function