| How to Retrieve Available System Drives |
Applies To |
|
| OS: VB: |
NT, 9x, 2000 5, 6 |
|
There have been many times when I needed a list of system drives in my apps. The quick & dirty way used to be to place a hidden DriveListBox on the form and then scroll through the List array. Well, that is simply unprofessional. In addition, it doesn't work when you need the drive information in a class or a DLL or a formless application.
In addition, you must be able to tell a floppy drive from a network drive. So I built a class that is so simple, an idiot can use it. All it requires you to do is instantiate it - it does the rest. Then you simply scroll through various collections. There is the AllDrives collection which lists all the drives found on the system. The class also breaks the drives down into specialized collections: FloppyDrives, LocalHardDrives, CDRomDrives, NetworkDrives, RemovableDrives and even RamDiskDrives (from the good ol' DOS days).
Download the code or simply cut and paste from below.
| Project Creation Instructions. |
|---|
| Add the following to a clsDriveAssignment class |
|---|
Option Explicit
Public AllDrives As New Collection
Public LocalHardDrives As New Collection
Public FloppyDrives As New Collection
Public RemovableDrives As New Collection
Public NetworkDrives As New Collection
Public CDRomDrives As New Collection
Public RamDiskDrives As New Collection
'APIs for retrieving drives
Private Declare Function GetLogicalDriveStrings _
Lib "kernel32" Alias "GetLogicalDriveStringsA" _
(ByVal nBufferLength As Long, _
ByVal lpBuffer As String) As Long
Private Declare Function GetDriveType _
Lib "kernel32" Alias "GetDriveTypeA" _
(ByVal nDrive As String) As Long
Private Const DRIVE_REMOVABLE = 2
Private Const DRIVE_FIXED = 3
Private Const DRIVE_REMOTE = 4
Private Const DRIVE_CDROM = 5
Private Const DRIVE_RAMDISK = 6
Private Sub FillDriveCollection()
Dim arrayAllDrives() As String
Dim x As Integer
GetAllDrives arrayAllDrives()
For x = 1 To UpperBound(arrayAllDrives())
Select Case GetDriveType(arrayAllDrives(x))
Case 0:
'The drive type cannot be determined
Case 1
'The root directory does not exist
Case DRIVE_REMOVABLE:
Select Case LCase$(Left$(arrayAllDrives(x), 1))
Case "a", "b" 'Floppy drive
FloppyDrives.Add arrayAllDrives(x)
Case Else 'Removable drive
RemovableDrives.Add arrayAllDrives(x)
End Select
Case DRIVE_FIXED 'Hard drive; can not be removed
LocalHardDrives.Add arrayAllDrives(x)
Case DRIVE_REMOTE 'Remote (network) drive
NetworkDrives.Add arrayAllDrives(x)
Case DRIVE_CDROM 'CD-ROM drive
CDRomDrives.Add arrayAllDrives(x)
Case DRIVE_RAMDISK 'RAM disk
RamDiskDrives.Add arrayAllDrives(x)
End Select
AllDrives.Add arrayAllDrives(x)
Next
End Sub
Private Function UpperBound(SampleArray() As String) As Long
Dim Temp As Long
On Error Resume Next
Temp = UBound(SampleArray)
If Err = 0 Then
UpperBound = Temp
Else
UpperBound = 0 'if error just set it to 0, because all the arrays are 1-based
End If
End Function
Private Sub GetAllDrives(DriveArray() As String)
Dim sAllDrives As String
Dim iDriveCount As Integer
'get the list of all available drives
'returns Null separated list of drives
'plus a Null at the end
sAllDrives = GetDriveLetters()
'split the list of drives into an array
DriveArray = Split2Array(sAllDrives, Chr$(0))
iDriveCount = UpperBound(DriveArray)
'if iDriveCounter = 0 Or 1 Then nothing was found
'other than Null at the end (in case of 1)
If iDriveCount > 1 Then
'great - data found - get rid of the array element with the Null
ReDim Preserve DriveArray(1 To iDriveCount - 1)
End If
End Sub
Private Function GetDriveLetters() As String
'returns a single string of available drive letters
'each separated by Null, plus a Null at the end
Dim Temp As String
Temp = Space$(64)
GetLogicalDriveStrings Len(Temp), Temp
GetDriveLetters = Trim$(Temp)
End Function
Function Split2Array(ByVal Text As String, Optional ByVal Delimiter As String = " ", _
Optional ByVal Limit As Long = -1, Optional CompareMethod As _
VbCompareMethod = vbBinaryCompare) As Variant
'provides functionality identical to Split function in VB6
ReDim res(1 To 100) As String
Dim resCount As Long
Dim length As Long
Dim startIndex As Long
Dim endIndex As Long
length = Len(Text)
startIndex = 1
resCount = 1
Do While startIndex <= length And resCount <> Limit
' get the next delimiter
endIndex = InStr(startIndex, Text, Delimiter, CompareMethod)
If endIndex = 0 Then endIndex = length + 1
' make room in the array, if necessary
If resCount > UBound(res) Then
ReDim Preserve res(1 To resCount + 99) As String
End If
' store the new element
res(resCount) = Mid$(Text, startIndex, endIndex - startIndex)
resCount = resCount + 1
startIndex = endIndex + Len(Delimiter)
Loop
' trim unused values
ReDim Preserve res(1 To resCount - 1) As String
' return the array inside a Variant
Split2Array = res()
End Function
Private Sub Class_Initialize()
FillDriveCollection
End Sub
Private Sub Class_Terminate()
Set AllDrives = Nothing
Set LocalHardDrives = Nothing
Set FloppyDrives = Nothing
Set RemovableDrives = Nothing
Set NetworkDrives = Nothing
Set CDRomDrives = Nothing
Set RamDiskDrives = Nothing
End Sub
| Add the following code to Form1 |
|---|
Private Sub Command1_Click()
Dim oDrvList As clsDriveAssignment
Dim x As Integer
Me.Cls
Set oDrvList = New clsDriveAssignment
With oDrvList
Print "All Drives: " & .AllDrives.Count
For x = 1 To .AllDrives.Count
Print " " & .AllDrives(x);
Next
Print: Print
Print "Floppy Drives: " & .FloppyDrives.Count
For x = 1 To .FloppyDrives.Count
Print " " & .FloppyDrives(x);
Next
Print: Print
Print "Local Hard Drives: " & .LocalHardDrives.Count
For x = 1 To .LocalHardDrives.Count
Print " " & .LocalHardDrives(x);
Next
Print: Print
Print "CD-ROM Drives: " & .CDRomDrives.Count
For x = 1 To .CDRomDrives.Count
Print " " & .CDRomDrives(x);
Next
Print: Print
Print "Network Drives: " & .NetworkDrives.Count
For x = 1 To .NetworkDrives.Count
Print " " & .NetworkDrives(x);
Next
Print: Print
Print "Removable Drives: " & .RemovableDrives.Count
For x = 1 To .RemovableDrives.Count
Print " " & .RemovableDrives(x);
Next
Print: Print
Print "RAM Drives: " & .RamDiskDrives.Count
For x = 1 To .RamDiskDrives.Count
Print " " & .RamDiskDrives(x);
Next
End With
Set oDrvList = Nothing
End Sub
| Remarks |
|---|