Home
Search
 
What's New
Index
Books
Links
Q & A
Newsletter
Banners
 
Feedback
Tip Jar
 
 
 
 
500MB 27GB Web Hosting - $9.95/Month
 
 
 
 
 
Old Pages
 
Old Index
Site Map
What's New
 
Books
How To
Tips & Tricks
Tutorials
Stories
Performance
Essays
Links
Q & A
New in VB6
Free Stuff
Pictures
 
 
 
TitleDisplay disk volume information
Keywordsdisk information, volume information, disk space, free space
CategoriesFiles & Directories, Utilities
 
Use the GetVolumeInfo and GetDiskFreeSpace API functions.
 
Private Sub Command1_Click()
Dim txt As String
Dim volume_name As String * 256
Dim file_system_name As String * 256
Dim serial_number As Long
Dim component_length As Long
Dim system_flags As Long
Dim sectors_per_cluster As Long
Dim bytes_per_sector As Long
Dim free_clusters As Long
Dim total_clusters As Long
Dim total_bytes As Long
Dim free_bytes As Long

    If GetVolumeInformation(txtDrive.Text, _
        volume_name, Len(volume_name), _
        serial_number, component_length, _
        system_flags, file_system_name, _
        Len(file_system_name)) = 0 _
    Then
        txt = "Error in GetVolumeInformation."
    Else
        txt = txtDrive.Text
        volume_name = Left$(volume_name, InStr(volume_name, _
            Chr$(0)) - 1)
        txt = txt & vbCrLf & "Volume Name: " & volume_name
        txt = txt & vbCrLf & "Serial number: " & _
            Format$(serial_number)
        txt = txt & vbCrLf & "Max component length: " & _
            Format$(component_length)
        txt = txt & vbCrLf & "System Flags: "
        If system_flags And FS_CASE_IS_PRESERVED Then txt = _
            txt & vbCrLf & "    FS_CASE_IS_PRESERVED"
        If system_flags And FS_CASE_SENSITIVE Then txt = _
            txt & vbCrLf & "    FS_CASE_SENSITIVE"
        If system_flags And FS_UNICODE_STORED_ON_DISK Then _
            txt = txt & vbCrLf & "    " & _
            "FS_UNICODE_STORED_ON_DISK"
        If system_flags And FS_PERSISTENT_ACLS Then txt = _
            txt & vbCrLf & "    FS_PERSISTENT_ACLS"
        If system_flags And FS_FILE_COMPRESSION Then txt = _
            txt & vbCrLf & "    FS_FILE_COMPRESSION"
        If system_flags And FS_VOL_IS_COMPRESSED Then txt = _
            txt & vbCrLf & "    FS_VOL_IS_COMPRESSED"
        file_system_name = Left$(file_system_name, _
            InStr(file_system_name, Chr$(0)) - 1)
        txt = txt & vbCrLf & "File System: " & _
            file_system_name
    End If

    If GetDiskFreeSpace(txtDrive.Text, _
        sectors_per_cluster, bytes_per_sector, _
        free_clusters, total_clusters) = 0 _
    Then
        txt = txt & vbCrLf & "Error in GetDiskFreeSpace."
    Else
        txt = txt & vbCrLf & "Sectors Per Cluster: " & _
            Format$(sectors_per_cluster)
        txt = txt & vbCrLf & "Bytes Per Sector: " & _
            Format$(bytes_per_sector)
        txt = txt & vbCrLf & "Free Clusters: " & _
            Format$(free_clusters)
        txt = txt & vbCrLf & "Total Clusters: " & _
            Format$(total_clusters)
        total_bytes = total_clusters * sectors_per_cluster _
            * bytes_per_sector
        txt = txt & vbCrLf & "Total Bytes: " & _
            Format$(total_bytes)
        free_bytes = free_clusters * sectors_per_cluster * _
            bytes_per_sector
        txt = txt & vbCrLf & "Bytes Free: " & _
            Format$(free_bytes)
        txt = txt & vbCrLf & "Percent Used: " & Format$(1 - _
            (free_bytes / total_bytes), "0.00%")
    End If
    
    txtResults.Text = txt
End Sub
 
 
Copyright © 1997-2003 Rocky Mountain Computer Consulting, Inc.   All rights reserved.
  Updated