VERSION 4.00
Begin VB.Form GetDrives 
   Caption         =   "Form1"
   ClientHeight    =   1080
   ClientLeft      =   2775
   ClientTop       =   5235
   ClientWidth     =   4815
   Height          =   1485
   Left            =   2715
   LinkTopic       =   "Form1"
   ScaleHeight     =   1080
   ScaleWidth      =   4815
   Top             =   4890
   Width           =   4935
   Begin VB.ListBox DriveTypes 
      Height          =   840
      Left            =   2280
      TabIndex        =   2
      Top             =   0
      Width           =   2535
   End
   Begin VB.ListBox AvailableDrives 
      Height          =   840
      Left            =   0
      TabIndex        =   1
      Top             =   0
      Width           =   2295
   End
   Begin VB.CommandButton GetDriveDetails 
      Caption         =   "GetDriveDetails"
      Height          =   255
      Left            =   0
      TabIndex        =   0
      Top             =   840
      Width           =   4815
   End
End
Attribute VB_Name = "GetDrives"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
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
'--end block--'
Private Sub Command1_Click()

End Sub



Private Sub Form_Load()

   Me.Move (Screen.Width - Me.Width) \ 2, (Screen.Height - Me.Height) \ 2
  
End Sub


Private Sub cmdEnd_Click()
   
   Unload Me
   
End Sub


Sub GetDriveDetails_Click()

   Dim r As Long
   Dim allDrives As String
   Dim currDrive As String
   Dim drvType As String
 
  'get the list of all available drives
   allDrives = VBGetLogicalDriveStrings()
 
  'separate the drive strings and retrieve the drive type
   Do Until allDrives = Chr$(0)
   
     'strip off one drive from the string allDrives
      currDrive = StripNulls(allDrives)
   
     'get the drive type
      drvType = rgbDrvType(currDrive)

      AvailableDrives.AddItem currDrive
      DriveTypes.AddItem drvType
    
   Loop

End Sub


Private Function rgbDrvType(RootPathName) As String
 
  'Passed is the drive to check.
  'Returned is the type of drive.
 
   Dim r As Long
  
   r = GetDriveType(RootPathName)
  
   Select Case r
      Case 0: rgbDrvType = "The drive type cannot be determined"
      Case 1: rgbDrvType = "The root directory does not exist"

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

      Case DRIVE_FIXED:   rgbDrvType = "Hard drive; can not be removed"
      Case DRIVE_REMOTE:  rgbDrvType = "Remote (network) drive"
      Case DRIVE_CDROM:   rgbDrvType = "CD-ROM drive"
      Case DRIVE_RAMDISK: rgbDrvType = "RAM disk"
   End Select
  
End Function


Private Function VBGetLogicalDriveStrings() As String

  'returns a single string of available drive
  'letters, each separated by a chr$(0)
   Dim r As Long
   Dim tmp As String
  
   tmp = Space$(64)
   r = GetLogicalDriveStrings(Len(tmp), tmp)
   VBGetLogicalDriveStrings = Trim$(tmp)

End Function


Private Function StripNulls(startStrg As String) As String

  'Take a string separated by a Chr$(0),
  'split off 1 item, and shorten the string
  'so that the next item is ready for removal.
   Dim c As Integer
   Dim item As String

   c = 1
  
   Do

      If Mid$(startStrg, c, 1) = Chr$(0) Then
      
         item = Mid$(startStrg, 1, c - 1)
         startStrg = Mid$(startStrg, c + 1, Len(startStrg))
         StripNulls = item
         Exit Function
    
      End If

      c = c + 1

   Loop

End Function
'--end block--'