|
|
|
|
|
|
|
|
|
|
|
 |
|
|||||||||||||||||||||||||||||||||||||||||||||||||||||||
|
||||||||||||||||||||||||||||||||||||||||||||||||||||||||
 |
||||||||||||||||||||||||||||||||||||||||||||||||||||||||
|
|
||
| Visual Basic Disk/Drive API Routines GetDiskFreeSpaceEx: Detailed Drive Info |
||
| Posted: | Thursday June 29, 1999 | |
| Updated: | Monday December 26, 2011 | |
| Applies to: | VB4-32, VB5, VB6 | |
| Developed with: | VB6, Windows NT4 | |
| OS restrictions: | Win95, Win98, WinNT4, Win2000 | |
| Author: | VBnet - Randy Birch | |
| Prerequisites | ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
| None. This code will work against any drive. | ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
|
|
||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
 Until
Windows 95 OSR2 hit the streets the world was simple, and only the rarest and most expensive hard drives exceeded 2 gigabytes; in fact, a
300-400 megabyte drive was considered high tech server material! Windows 95 provides the GetDiskFreeSpace API to return information about the physical drive,
and GetVolumeInformation to return volume-specific data such as the volumes file system and characteristics.
Today, a two gig drive remains unusual - because 'usual' has now become anything between a 120 to 500 gig drive. This movement to larger drives - and the corresponding larger partitions - happened around mid-way through Win95's life. In an updated Win95 release - Win95 OSR2 GetDiskFreeSpaceEx API was introduced to handle the values returned by larger drives formatted into the (then) new FAT32 partitions (Win9x), or the 4 gig partitions available under Windows NT4. GetDiskFreeSpaceEx, as declared in the MSDN for C developers, uses the ULONG data type for its return values. A 64-bit integer, VB no comparible data type to handle true 64-bit integers. There are workarounds (like creating a Type with two longs), but we do have a specialized 64-bit data type that will fit the bill with some tweaking - the Currency type. The main difference between this and a true ULONG is the need to compensate for the decimal positions that the Currency type adds, but that is not a problem. The code on this page performs several different operations that you may find useful either together or individually, in order to get the drive and volume information from a given system's drives:
Because of the length of some of the code lines, particularly the ones to populate the TreeView, this page is somewhat wider than I prefer. It might be easiest to do a select all on the page an paste it into notepad, or to return to the link that brought you here and open the page in its own window. |
||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
| BAS Module Code | ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
|
||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
| Place the following code into the general declarations area of a bas module: | ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
|
|
||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
Option Explicit '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' Copyright ©1996-2011 VBnet/Randy Birch, All Rights Reserved. ' Some pages may also contain other copyrights by the author. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' Distribution: You can freely use this code in your own ' applications, but you may not reproduce ' or publish this code on any web site, ' online service, or distribute as source ' on any media without express permission. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Public Type VBNET_DRIVE_INFO
DrvsAvailable As String
DrvType As String
DrvSectors As Long 'GetDiskFreeSpace only
DrvBytesPerSector As Long 'GetDiskFreeSpace only
DrvFreeClusters As Long 'GetDiskFreeSpace only
DrvTotalClusters As Long 'GetDiskFreeSpace only
DrvSpaceFree As Currency 'GetDiskFreeSpaceEx only
DrvSpaceFreeToCaller As Currency 'GetDiskFreeSpaceEx only
DrvSpaceUsed As Currency 'GetDiskFreeSpaceEx only
DrvSpaceTotal As Currency 'GetDiskFreeSpaceEx only
DrvVolumeName As String
DrvSerialNo As String
DrvFileSystemName As String
DrvFileSystemSupport As String
DrvFileSystemFlags As Long
End Type
Public 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
Public Declare Function GetLogicalDriveStrings Lib "kernel32" _
Alias "GetLogicalDriveStringsA" _
(ByVal nBufferLength As Long, _
ByVal lpBuffer As String) As Long
Public Declare Function GetDiskFreeSpaceEx Lib "kernel32" _
Alias "GetDiskFreeSpaceExA" _
(ByVal lpcurrDrive As String, _
lpFreeBytesAvailableToCaller As Currency, _
lpTotalNumberOfBytes As Currency, _
lpTotalNumberOfFreeBytes As Currency) As Long
Public Declare Function GetDiskFreeSpace Lib "kernel32" _
Alias "GetDiskFreeSpaceA" _
(ByVal lpRootPathName As String, _
lpSectorsPerCluster As Long, _
lpBytesPerSector As Long, _
lpNumberOfFreeClusters As Long, _
lpTtoalNumberOfClusters As Long) As Long
Public Declare Function GetUserName Lib "advapi32" _
Alias "GetUserNameA" _
(ByVal lpBuffer As String, nSize As Long) As Long
Public Declare Function GetDriveType Lib "kernel32" _
Alias "GetDriveTypeA" _
(ByVal nDrive As String) As Long
'drive type constants
Public Const DRIVE_REMOVABLE As Long = 2
Public Const DRIVE_FIXED As Long = 3
Public Const DRIVE_REMOTE As Long = 4
Public Const DRIVE_CDROM As Long = 5
Public Const DRIVE_RAMDISK As Long = 6
'file system constants
Public Const FS_CASE_SENSITIVE As Long = &H1
Public Const FS_CASE_IS_PRESERVED As Long = &H2
Public Const FS_UNICODE_STORED_ON_DISK As Long = &H4
Public Const FS_PERSISTENT_ACLS As Long = &H8
Public Const FS_FILE_COMPRESSION As Long = &H10
Public Const FS_VOL_IS_COMPRESSED As Long = &H8000&
Public HasLargeDriveSupport As Boolean
Public Function OsHasLargeDriveSupport() As Boolean
'Determines whether the method supports a
'call to the GetDiskFreeSpaceEx API.
'The method first calls the GetDiskFreeSpaceEx API.
'If the call fails (no entry point in kernel32)
'then the function returns false, indicating
'that the app should use the GetDiskFreeSpace
'API instead. GetDiskFreeSpace is limited
'to partitions less than 2 gig.
On Local Error GoTo LargeSupport_Error
Dim RootPathName As String
Dim tmp1 As Currency
Dim tmp2 As Currency
Dim tmp3 As Currency
RootPathName = "C:\"
'get the drive's disk parameters
If GetDiskFreeSpaceEx(RootPathName, _
tmp1, _
tmp2, _
tmp3) Then
'GetDiskFreeSpaceEx supported.
OsHasLargeDriveSupport = True
End If
LargeSupport_Exit:
Exit Function
LargeSupport_Error:
'No large drive support; use
'GetDiskFreeSpace instead
OsHasLargeDriveSupport = False
Resume LargeSupport_Exit
End Function |
||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
| Form Code | ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
|
||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
| To a new from, add: a Combo box (Combo1), two labels
(Label1 and Label2), two command buttons (Command1 and Command2), a
TreeView (Treeview1) and a checkbox (Check1).
Add an ImageList (optional) to the form, and populate with appropriate images. If you chose not to use the ImageList, be sure to remove al the references to the ImageList icon throughout the CreateTreeviewDriveData code. (Alternatively, you can download the base VB6 form and imagelist). The images I used were:
Add two hidden menus to the form as follows:
With the above in place, add the following code to the form: |
||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
|
|
||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
Option Explicit
Const mnuExpand As Integer = 1
Const mnuExpandAll As Integer = 3
Const mnuColapseAll As Integer = 4
Private Sub Form_Load()
'check if the operating system supports
'calls to the GetDiskFreeSpaceEx API
HasLargeDriveSupport = OsHasLargeDriveSupport()
Label2.Caption = IIf(HasLargeDriveSupport, _
"Large drives are supported; GetDiskFreeSpaceEx will be used", _
"Large drives NOT supported; GetDiskFreeSpace will be used")
'centre form
Me.Move (Screen.Width - Me.Width) \ 2, (Screen.Height - Me.Height) \ 2
'load the drives
LoadAvailableDrives Combo1
'select the second combo item, (should be C)
Combo1.ListIndex = 1
'initialize the TreeView popup menu.
'
'Note that this is NOT the same as
'calling:
' mnuTVStyle(1).Checked = True
'The above only checks the item,
'without firing the associated
'menu code.
mnuTVStyle_Click 1
End Sub
Private Sub LoadAvailableDrives(cmbo As ComboBox)
Dim lpBuffer As String
'get list of available drives
lpBuffer = GetDriveString()
'Separate the drive strings
'and add to the combo. StripNulls
'will continually shorten the
'string. Loop until a single
'remaining terminating null is
'encountered.
Do Until lpBuffer = Chr$(0)
'strip off one drive item
'and add to the combo
cmbo.AddItem StripNulls(lpBuffer)
Loop
End Sub
Private Function GetDriveString() As String
'returns string of available
'drives each separated by a null
Dim sBuffer As String
'possible 26 drives, three characters each, plus trailing null
sBuffer = Space$(26 * 4)
If GetLogicalDriveStrings(Len(sBuffer), sBuffer) Then
'do not trim off trailing null!
GetDriveString = Trim$(sBuffer)
End If
End Function
Function StripNull(startStrg As String) As String
'Take a string separated by Chr(0)'s, and split off 1 item, and
'shorten the string so that the next item is ready for removal.
Dim pos As Integer
pos = InStr(startStrg, Chr$(0))
If pos Then
StripNull = Mid(startStrg, 1, pos - 1)
startStrg = Mid(startStrg, pos + 1, Len(startStrg))
End If
End Function
Function HiWord(dw As Long) As Long
If dw And &H80000000 Then
HiWord = (dw \ 65535) - 1
Else
HiWord = dw \ 65535
End If
End Function
Function LoWord(dw As Long) As Long
If dw And &H8000& Then
LoWord = &H8000& Or (dw And &H7FFF&)
Else
LoWord = dw And &HFFFF&
End If
End Function
Private Sub Command2_Click()
Dim thisDrive As String
Dim c As Integer
If Combo1.ListCount > 0 Then
Label1.Caption = "Loading drive stats..."
DoEvents
'increase the apparent speed by setting the
'control's visible property to false, then
'clear the TreeView and load the nodes
TreeView1.Visible = False
If TreeView1.Nodes.count > 0 Then TreeView1.Nodes.Clear
For c = 0 To Combo1.ListCount - 1
thisDrive = Left$(Combo1.List(c), 1)
CreateTreeviewDriveData thisDrive
Next
TreeView1.Visible = True
End If
Label1.Caption = "Select drive and right-click for options."
End Sub
Private Sub Command1_Click()
Dim thisDrive As String
thisDrive = Left$(Combo1.List(Combo1.ListIndex), 1)
If TreeView1.Nodes.count > 0 Then TreeView1.Nodes.Clear
CreateTreeviewDriveData thisDrive
Label1.Caption = "Select '" & thisDrive & "' and right-click for options."
End Sub
Private Sub Combo1_Click()
Dim thisDrive As String
thisDrive = Left$(Combo1.List(Combo1.ListIndex), 1)
If TreeView1.Nodes.count > 0 Then TreeView1.Nodes.Clear
CreateTreeviewDriveData thisDrive
Label1.Caption = "Select '" & thisDrive & "' and right-click for options."
Command1.Caption = "Reload " & Combo1.List(Combo1.ListIndex)
End Sub
Private Function rgbGetDriveType(RootPathName As String) As String
'returns the type of drive.
Select Case GetDriveType(RootPathName)
Case 0: rgbGetDriveType = "The drive type cannot be determined."
Case 1: rgbGetDriveType = "The root directory does not exist."
Case DRIVE_REMOVABLE:
Select Case Left(RootPathName, 1)
Case "a", "b": rgbGetDriveType = "Floppy drive."
Case Else: rgbGetDriveType = "Removable drive."
End Select
Case DRIVE_FIXED: rgbGetDriveType = "Hard drive; can not be removed."
Case DRIVE_REMOTE: rgbGetDriveType = "Remote (network) drive."
Case DRIVE_CDROM: rgbGetDriveType = "CD-ROM drive."
Case DRIVE_RAMDISK: rgbGetDriveType = "RAM disk."
End Select
End Function
Private Function rgbGetDiskFreeSpace(RootPathName As String, _
VDI As VBNET_DRIVE_INFO) As Long
'returns data about the selected drive.
'Passed is the RootPathName; the other
'variables are filled in here.
'This routine uses the GetDiskFreeSpaceEx API
'if that API is supported, otherwise it uses
'the older GetDiskFreeSpace
'GetDiskFreeSpaceEx only variables
Dim BytesFreeToCalller As Currency
Dim TotalBytes As Currency
Dim TotalFreeBytes As Currency
Dim TotalBytesUsed As Currency
Dim msg As String
On Local Error GoTo DiskFreeSpace_error
If HasLargeDriveSupport Then 'use GetDiskFreeSpaceEx
'get the drive's disk parameters
If GetDiskFreeSpaceEx(RootPathName, _
BytesFreeToCalller, _
TotalBytes, _
TotalFreeBytes) = 1 Then
'multiplying the returned valued by 10000
'to adjust for the 4 decimal places that the
'currency data type returns.
VDI.DrvSpaceTotal = (TotalBytes * 10000)
VDI.DrvSpaceFree = (TotalFreeBytes * 10000)
VDI.DrvSpaceFreeToCaller = (BytesFreeToCalller * 10000)
VDI.DrvSpaceUsed = ((TotalBytes - TotalFreeBytes) * 10000)
rgbGetDiskFreeSpace = 1
End If
Else 'use the older GetDiskFreeSpace
If GetDiskFreeSpace(RootPathName, _
VDI.DrvSectors, _
VDI.DrvBytesPerSector, _
VDI.DrvFreeClusters, _
VDI.DrvTotalClusters) = 1 Then
VDI.DrvSpaceTotal = (VDI.DrvSectors * VDI.DrvBytesPerSector * VDI.DrvTotalClusters)
VDI.DrvSpaceFree = (VDI.DrvSectors * VDI.DrvBytesPerSector * VDI.DrvFreeClusters)
'DrvSpaceFreeToCaller is not returned so use DrvSpaceFree
VDI.DrvSpaceFreeToCaller = VDI.DrvSpaceFree
VDI.DrvSpaceUsed = VDI.DrvSpaceTotal - VDI.DrvSpaceFree
rgbGetDiskFreeSpace = 1
End If
End If
DiskFreeSpace_exit:
On Local Error GoTo 0
Exit Function
DiskFreeSpace_error:
If HasLargeDriveSupport Then
msg = "An error occurred processing the GetDiskFreeSpaceEx call." & vbNewLine
msg = msg & "Check that the variables passed are declared Currency."
MsgBox msg, vbExclamation
Else
msg = "Drive information for drive " & RootPathName & _
" has caused an error." & vbNewLine & vbNewLine & _
"The probable cause is that the drive" & _
"exceeds two gig, generating an overflow " & _
"in the drive space calculations because the " & _
"operating system does not support GetDiskFreeSpaceEx"
MsgBox msg, vbExclamation
End If
rgbGetDiskFreeSpace = False
Resume DiskFreeSpace_exit
End Function
Private Function rgbGetVolumeInformation(RootPathName As String, _
VDI As VBNET_DRIVE_INFO) As Long
'Returns information about the passed drive's
'type, free space, total space, volume information
Dim pos As Integer
Dim HiWord As Long, HiHexStr As String
Dim LoWord As Long, LoHexStr As String
Dim VolumeSN As Long
Dim MaxFNLen As Long
'create working strings
VDI.DrvVolumeName = Space(14)
VDI.DrvFileSystemName = Space(32)
'do what it says
If GetVolumeInformation(RootPathName, _
VDI.DrvVolumeName, _
Len(VDI.DrvVolumeName), _
VolumeSN, MaxFNLen, _
VDI.DrvFileSystemFlags, _
VDI.DrvFileSystemName, _
Len(VDI.DrvFileSystemName)) Then
'the volume label
pos = InStr(VDI.DrvVolumeName, Chr(0))
If pos Then VDI.DrvVolumeName = Left(VDI.DrvVolumeName, pos - 1)
If Len(Trim(VDI.DrvVolumeName)) = 0 Then VDI.DrvVolumeName = "(no label)"
'File system type (FAT, NTFS etc)
pos = InStr(VDI.DrvFileSystemName, Chr(0))
If pos Then VDI.DrvFileSystemName = Left(VDI.DrvFileSystemName, pos - 1)
'File type parameters
VDI.DrvFileSystemSupport = "Supports " & MaxFNLen & "-character filenames"
'Drive volume id
VDI.DrvSerialNo = Hex(VolumeSN)
'return success
rgbGetVolumeInformation = 1
End If
End Function
Private Function rgbGetUserName() As String
'returns the name of the user
Dim username As String
username = Space$(256)
If GetUserName(username, Len(username)) Then
rgbGetUserName = Left(username, InStr(username, Chr$(0)) - 1)
Else
rgbGetUserName = "(unknown)"
End If
End Function
Public Sub CreateTreeviewDriveData(thisDrive As String)
Dim nodX As Node
Dim count As Integer
Dim nIcon As Integer
Dim thisDriveFull As String
Dim TreeName As String
Dim TreeCaption As String
Dim dCaption As String
Dim dummy As String
Dim pKey As String
Dim OtherInfoKey As String
Dim flagExpand As Boolean
Const drvFormat As String = "###,###,###,###,##0 b\y\t\e\s"
Const cluFormat As String = "###,###,###,###,##0"
'my own structure to hold the drive info
Dim VDI As VBNET_DRIVE_INFO
'set the Expand Nodes flag value based on the checkbox
flagExpand = Check1.Value = 1
'assign the imagelist to the treeview
TreeView1.ImageList = ImageList1
'If this is the first time through the
'routine (the treeview is empty), create
'the text for the root tree item & expand
'the root node. If the treeview has contents,
'just get the current parent key. The parent
'key to the entire tree is stored in 'TreeName'.
If TreeView1.Nodes.count = 0 Then
'the root item text will also be the key name
TreeName = "Drive Details on '" & rgbGetUserName() & "'"
Set nodX = TreeView1.Nodes.Add(, , TreeName, TreeName, 1, 1)
'force the node expanded .. for the
'others, use the flag
nodX.Expanded = True
Else: TreeName = TreeView1.Nodes.Item(1).Text
End If
'increment a counter to create individual
'keynames for use as a parent keyname for
'further subordinate childs
thisDriveFull = thisDrive & ":\"
count = count + 1
pKey = CStr(count) & "K" & thisDrive
'set the drive icon no from the imagelist,
'and the drive caption.
nIcon = rgbGetDriveIconFromType(thisDriveFull)
'If there was no error in the API calls
If rgbGetDiskFreeSpace(thisDriveFull, VDI) = 1 And _
rgbGetVolumeInformation(thisDriveFull, VDI) = 1 Then
'display the root drive, and expand as set in the flag
Set nodX = TreeView1.Nodes.Add(TreeName, tvwChild, _
pKey, _
"Drive " & thisDriveFull, _
nIcon)
nodX.Expanded = flagExpand
'create an individual key. Here I use a form of the
'variable name appended with the count value. This
'ensures that if in a While...Wend loop for all drives,
'each key will be unique.
dummy = "DFS" & count & thisDrive
dCaption = "File System : " & VDI.DrvFileSystemName
Set nodX = TreeView1.Nodes.Add(pKey, tvwChild, dummy, dCaption, nIcon)
dummy = "DVN" & count & thisDrive
dCaption = "Volume Label : " & VDI.DrvVolumeName
Set nodX = TreeView1.Nodes.Add(pKey, tvwChild, dummy, dCaption, nIcon)
dummy = "DSR" & count & thisDrive
dCaption = "Volume Serial No : " & VDI.DrvSerialNo
Set nodX = TreeView1.Nodes.Add(pKey, tvwChild, dummy, dCaption, nIcon)
dummy = "DST" & count & thisDrive
dCaption = "Total Drive Size : " & Format$(VDI.DrvSpaceTotal, drvFormat)
Set nodX = TreeView1.Nodes.Add(pKey, tvwChild, dummy, dCaption, nIcon)
dummy = "DSU" & count & thisDrive
dCaption = "Drive Space Used : " & Format$(VDI.DrvSpaceUsed, drvFormat)
Set nodX = TreeView1.Nodes.Add(pKey, tvwChild, dummy, dCaption, nIcon)
dummy = "DSF" & count & thisDrive
dCaption = "Drive Space Free : " & Format$(VDI.DrvSpaceFree, drvFormat)
Set nodX = TreeView1.Nodes.Add(pKey, tvwChild, dummy, dCaption, nIcon)
dummy = "SFC" & count & thisDrive
dCaption = "Space Free To Caller : " & Format$(VDI.DrvSpaceFreeToCaller, drvFormat)
Set nodX = TreeView1.Nodes.Add(pKey, tvwChild, dummy, dCaption, nIcon)
'If GetDiskFreeSpaceEx was used, the
'cluster/sector info was not returned
'so print "n/a"
dummy = "DRVS" & count & thisDrive
dCaption = "Sectors : " & _
IIf(VDI.DrvSectors, Format$(VDI.DrvSectors, cluFormat), "n/a")
Set nodX = TreeView1.Nodes.Add(pKey, tvwChild, dummy, dCaption, nIcon)
dummy = "DBPS" & count & thisDrive
dCaption = "Bytes Per Sector : " & _
IIf(VDI.DrvSectors, Format$(VDI.DrvBytesPerSector, cluFormat), "n/a")
Set nodX = TreeView1.Nodes.Add(pKey, tvwChild, dummy, dCaption, nIcon)
dummy = "DFCL" & count & thisDrive
dCaption = "Free Clusters : " & _
IIf(VDI.DrvSectors, Format$(VDI.DrvFreeClusters, cluFormat), "n/a")
Set nodX = TreeView1.Nodes.Add(pKey, tvwChild, dummy, dCaption, nIcon)
dummy = "DTFC" & count & thisDrive
dCaption = "Total Clusters : " & _
IIf(VDI.DrvSectors, Format$(VDI.DrvTotalClusters, cluFormat), "n/a")
Set nodX = TreeView1.Nodes.Add(pKey, tvwChild, dummy, dCaption, nIcon)
'The "Other Info" goes next, and this item will
'be a parent to the other info data shown below it,
'so the key must be saved and used below.
'The icon is determined by offsetting the
'drive-type icon by 7 (see the imagelist icons).
OtherInfoKey = "Other" & count & thisDrive
dCaption = "Other Volume Info"
Set nodX = TreeView1.Nodes.Add(pKey, tvwChild, OtherInfoKey, dCaption, nIcon + 7)
nodX.Expanded = flagExpand
'This is where the "Other Info" goes, so we have to
'create a new indent level, by using the Other Info
'key as the parent.
'
'As these will have no sub-child items, the 'dummy'
'can be omitted leaving a comma as a placeholder
Set nodX = TreeView1.Nodes.Add(OtherInfoKey, tvwChild, , rgbGetDriveType(thisDriveFull), 8)
Set nodX = TreeView1.Nodes.Add(OtherInfoKey, tvwChild, , VDI.DrvFileSystemSupport, 8)
'these are only set based on flags returned in VDI.DrvFileSystemFlags
If VDI.DrvFileSystemFlags And FS_CASE_IS_PRESERVED Then
Set nodX = TreeView1.Nodes.Add(OtherInfoKey, _
tvwChild, , _
"case preserved when saved", 8)
End If
If VDI.DrvFileSystemFlags And FS_CASE_SENSITIVE Then
Set nodX = TreeView1.Nodes.Add(OtherInfoKey, _
tvwChild, , _
"supports case-sensitive filenames", 8)
End If
If VDI.DrvFileSystemFlags And FS_PERSISTENT_ACLS Then
Set nodX = TreeView1.Nodes.Add(OtherInfoKey, _
tvwChild, , _
"preserves and enforces ACL", 8)
End If
If VDI.DrvFileSystemFlags And FS_UNICODE_STORED_ON_DISK Then
Set nodX = TreeView1.Nodes.Add(OtherInfoKey, _
tvwChild, , _
"supports Unicode filenames", 8)
End If
If VDI.DrvFileSystemFlags And FS_FILE_COMPRESSION Then
Set nodX = TreeView1.Nodes.Add(OtherInfoKey, _
tvwChild, , _
"supports file-based compression", 8)
End If
If VDI.DrvFileSystemFlags And FS_VOL_IS_COMPRESSED Then
Set nodX = TreeView1.Nodes.Add(OtherInfoKey, _
tvwChild, , _
"specified volume is compressed", 8)
End If
End If
End Sub
Private Sub mnuTVEdit_Click(Index As Integer)
Dim c As Integer
Dim currNodeIndex As Integer
'currNodeIndex represents the
'indentation level of the current node
'Assume that the node is a first-level node.
'This assures that a Collapse All command
'will not close the root.
currNodeIndex = 1 'the drive letter
'if the current node is already expanded,
'then assume the node desired is at the
'second indent level
If TreeView1.Nodes(1).Expanded Then currNodeIndex = 2 'info
Select Case Index
Case mnuExpand
'toggle the treeview's visible state
'to avoid the unnecessary repainting
'as each node changes state
TreeView1.Visible = False
TreeView1.SelectedItem.Expanded = Not TreeView1.SelectedItem.Expanded
TreeView1.Visible = True
Case mnuExpandAll
'toggle the treeview's visible state
'to avoid the unnecessary repainting
'as each node changes state
TreeView1.Visible = False
'expand all the nodes from the current
'node through the last node for the
'given tree item
For c = currNodeIndex To TreeView1.Nodes.count
If TreeView1.Nodes(c).Children > 0 Then
TreeView1.Nodes(c).Expanded = True
End If
Next
TreeView1.Visible = True
Case mnuColapseAll
'toggle the treeview's visible state
'to avoid the unnecessary repainting
'as each node changes state
TreeView1.Visible = False
'collapse all the nodes from the current
'node through the last node for the
'given tree item
For c = currNodeIndex To TreeView1.Nodes.count
If TreeView1.Nodes(c).Children > 0 Then
TreeView1.Nodes(c).Expanded = False
End If
Next
TreeView1.Visible = True
End Select
End Sub
Private Sub mnuTVStyle_Click(Index As Integer)
mnuTVStyle(TreeView1.Style).Checked = False
TreeView1.Style = Index
mnuTVStyle(Index).Checked = True
End Sub
Private Sub TreeView1_MouseUp(Button As Integer, _
Shift As Integer, _
x As Single, _
y As Single)
If Button = 2 Then PopupMenu mnuBar(1), , , , mnuTVEdit(1)
End Sub
Private Sub TreeView1_NodeClick(ByVal Node As Node)
'configure the hidden menu items based on the current selection
'set the Expand/Collapse captions
If TreeView1.Nodes(Node.Index).Expanded Then
mnuTVEdit(mnuExpand).Caption = "&Collapse"
Else
mnuTVEdit(mnuExpand).Caption = "&Expand"
End If
mnuTVEdit(mnuExpand).Enabled = Node.Children > 0
End Sub
Private Function rgbGetDriveIconFromType(RootPathName As String) As Integer
'returns the index to the imagelist
'where the specified drive icon is.
Select Case GetDriveType(RootPathName)
Case 0: rgbGetDriveIconFromType = 1
Case 1:
Case DRIVE_REMOVABLE:
Select Case Left(RootPathName, 1)
Case "a", "b": rgbGetDriveIconFromType = 2
Case Else: rgbGetDriveIconFromType = 1
End Select
Case DRIVE_FIXED: rgbGetDriveIconFromType = 3
Case DRIVE_REMOTE: rgbGetDriveIconFromType = 6
Case DRIVE_CDROM: rgbGetDriveIconFromType = 4
Case DRIVE_RAMDISK: rgbGetDriveIconFromType = 7
End Select
End Function |
||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
| Comments | ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
| Run the project and select a drive. The drive and its
details will be loaded into the treeview. Label2 reflects the API being used, and the treeview context menu will provide the ability to
change the treeview style, and expand or collapse the nodes.
If you want to test the accuracy of the OsHasLargeDriveSupport() function, you can cause the GetDiskFreeSpaceEx API to fail by changing the Alias from GetDiskFreeSpaceEx to another word, ie GetDiskFreeSpaceExXXX. Just make sure that you have at least one partition that is smaller than 2 gigs to try the code against. |
||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
|
|
|
|
|
|||||
|
|||||
|
|
|||||
|
Copyright ©1996-2011 VBnet and Randy Birch. All Rights Reserved. |
 |
