|How to Retrieve Available System Drives||
|NT, 9x, 2000
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