Private Const DRIVE_REMOVABLE As Long = 2
Private Const DRIVE_FIXED As Long = 3
Private Const DRIVE_REMOTE As Long = 4
Private Const DRIVE_CDROM As Long = 5  'can be a CD or a DVD
Private Const DRIVE_RAMDISK As Long = 6
      
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 Sub Form_Load()

   Me.Move (Screen.Width - Me.Width) \ 2, (Screen.Height - Me.Height) \ 2
   Command1.Caption = "Get Available Drives (all VB versions)"
   Command2.Caption = "Get Available Drives (VB6 only)"
   
End Sub


Private Sub Form_DblClick()

   List1.Clear
   
End Sub


Private Sub Command1_Click()

  'VB4-32 / VB5 / VB6-compatible code
  
   Dim sAllDrives As String
   Dim sDrive As String
   Dim sDrvType As String
 
  'get the list of all drives
   sAllDrives = GetDriveString()
 
  'separate the drive strings and
  'retrieve the drive type
   Do Until sAllDrives = Chr$(0)
   
      sDrive = StripNulls(sAllDrives)
      sDrvType = GetDriveDescription(sDrive)

      List1.AddItem sDrive & vbTab & sDrvType
    
   Loop

End Sub


Private Sub Command2_Click()

  'VB6-only

   Dim sAllDrives As String
   Dim sDrvType As String
   Dim sDrives() As String
   Dim cnt As Long
   
  'get the list of all drives
   sAllDrives = GetDriveString()
   
  'Change nulls to spaces, then trim.
  'This is required as using Split()
  'with Chr$(0) alone adds two additional
  'entries to the array drives at the end
  'representing the terminating characters.
   sAllDrives = Replace$(sAllDrives, Chr$(0), Chr$(32))
   sDrives() = Split(Trim$(sAllDrives), Chr$(32))

   For cnt = LBound(sDrives) To UBound(sDrives)
         
      sDrvType = GetDriveDescription(sDrives(cnt))

      List1.AddItem sDrives(cnt) & vbTab & sDrvType
    
   Next
   
End Sub


Private Function GetDriveString() As String

  'Used by both demos
  
  'returns string of available
  'drives each separated by a null
   Dim sBuff As String
   
  'possible 26 drives, three characters
  'each plus a trailing null for each
  'drive letter and a terminating null
  'for the string
   sBuff = Space$((26 * 4) + 1)
  
  If GetLogicalDriveStrings(Len(sBuff), sBuff) Then

     'just trim off the trailing spaces - leave the nulls
      GetDriveString = Trim$(sBuff)
      
   End If

End Function


Private Function GetDriveDescription(RootPathName) As String
 
  'Used by both demos
  
  'Passed is the drive to check.
  'Returned is the type of drive.
   Select Case GetDriveType(RootPathName)
      Case 0: GetDriveDescription = "The drive type cannot be determined"
      Case 1: GetDriveDescription = "The root directory does not exist"

      Case DRIVE_REMOVABLE:
          Select Case Left$(RootPathName, 1)
              Case "a", "b": GetDriveDescription = "Floppy drive"
              Case Else: GetDriveDescription = "Removable drive"
          End Select

      Case DRIVE_FIXED:   GetDriveDescription = "Hard drive; can not be removed"
      Case DRIVE_REMOTE:  GetDriveDescription = "Remote (network) drive"
      Case DRIVE_CDROM:   GetDriveDescription = "Optical drive (CD or DVD)"
      Case DRIVE_RAMDISK: GetDriveDescription = "RAM disk"
   End Select
  
End Function


Private Function StripNulls(startstr As String) As String

  'Routine used by older VB4-32 / VB5 / VB6 code demo only
 
  'Take a string separated by chr$(0)
  'and split off 1 item, shortening the
  'string so next item is ready for removal.
   Dim pos As Long

   pos = InStr(startstr$, Chr$(0))
  
   If pos Then
   
      StripNulls = Mid$(startstr, 1, pos - 1)
      startstr = Mid$(startstr, pos + 1, Len(startstr))
   
   End If

End Function