DrivesSystem

Option Explicit

Public Declare Function GetLogicalDriveStrings Lib "kernel32" Alias "GetLogicalDriveStringsA" _
(ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Public Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" _
(ByVal nDrive As String) As Long
Public Const DRIVE_REMOVABLE = 2
Public Const DRIVE_FIXED = 3
Public Const DRIVE_REMOTE = 4
Public Const DRIVE_CDROM = 5
Public Const DRIVE_RAMDISK = 6

'Add the following code to Form1.


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
End Sub

Private Sub cmdGetDriveDetails_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$ = rgbGetDriveType(currDrive$)

Print " " & currDrive$ & vbTab & drvType$

Loop

End Sub

Private Function rgbGetDriveType(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: 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 VBGetLogicalDriveStrings() As String
'returns a single string of available drive

'letters, each separated by a chr$(0)

Dim r As Long
Dim i As Integer
Dim tmp As String

tmp$ = Space$(64)

r& = GetLogicalDriveStrings(Len(tmp$), tmp$)

VBGetLogicalDriveStrings = Trim$(tmp$)

End Function

Private Function StripNulls(startStrg$) 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