Display information about Drive letters, Type, and Names.

Category:

System/API

Type:

Snippets

Difficulty:

Intermediate

Author: Anonymous

Version Compatibility: Visual Basic 6, Visual Basic 5

More information:

To run this test code start a new project. Paste the declarations code in to the declarations section of Form1. past the rest of the code below this. Press F5 to run the code.

Instructions: Copy the declarations and code below and paste directly into your VB project.

Declarations:
Option Explicit Private Declare Function GetLogicalDriveStrings Lib "kernel32" Alias "GetLogicalDriveStringsA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long Private Declare Function GetVolumeInformation Lib "kernel32" Alias "GetVolumeInformationA" (ByVal lpRootPathName As String, ByVal lpVolumeNameBuffer As String, ByVal nVolumeNameSize As Long, lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, ByVal nFileSystemNameSize As Long) As Long Private Declare Function GetLogicalDrives Lib "kernel32" () As Long Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long Private Const ERROR_BAD_DEVICE = 1200& Private Const ERROR_CONNECTION_UNAVAIL = 1201& Private Const ERROR_EXTENDED_ERROR = 1208& Private Const ERROR_MORE_DATA = 234 Private Const ERROR_NOT_SUPPORTED = 50& Private Const ERROR_NO_NET_OR_BAD_PATH = 1203& Private Const ERROR_NO_NETWORK = 1222& Private Const ERROR_NOT_CONNECTED = 2250& Private Const NO_ERROR = 0 Private Declare Function WNetGetConnection Lib "mpr.dll" Alias "WNetGetConnectionA" (ByVal lpszLocalName As String, ByVal lpszRemoteName As String, cbRemoteName As Long) As Long Private Const MAX_PATH = 260 Private Const DRIVE_PARTITION = 1 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

Code:

Private Sub Form_Load()
    Dim sTemp As String
    Dim sTemp2 As String
    Dim iNullSpot As Integer
    Dim lDrive As Long
    sTemp = String$(2048, 0)
    Call GetLogicalDriveStrings(2047, sTemp)
    ' go through and add each drive to the list
    Do
        iNullSpot = InStr(sTemp, Chr$(0))
        If iNullSpot > 1 Then
            'get a drive letter and see which type of drive it is
            sTemp2 = UCase$(Left$(sTemp, iNullSpot - 2))
            lDrive = GetDriveType(sTemp2)
            Select Case lDrive
                Case DRIVE_FIXED, DRIVE_PARTITION
                    sTemp2 = "Hard Disk " & GetDriveName((sTemp2 & "\")) & " (" & sTemp2 & ")"
                Case DRIVE_CDROM
                    sTemp2 = "CDROM " & GetDriveName((sTemp2 & "\")) & " (" & sTemp2 & ")"
                Case DRIVE_REMOTE
                    sTemp2 = "Net Drive " & GetNetDriveName(sTemp2) & " (" & sTemp2 & ")"
                Case DRIVE_REMOVABLE
                    If UCase$(Left$(sTemp2, 1)) = "A" Or UCase$(Left$(sTemp2, 1)) = "B" Then
                        sTemp2 = "Floppy Disk (" & sTemp2 & ")"
                    Else
                        sTemp2 = "Removable Disk (" & sTemp2 & ")"
                    End If
                Case Else
                    sTemp2 = "Unknown (" & sTemp2 & ")"
            End Select
            'Get the next drive letter
            sTemp = Mid$(sTemp, iNullSpot + 1)
            MsgBox sTemp2
        End If
    Loop Until iNullSpot <= 1

End Sub
Private Function GetDriveName(ByVal sDrive As String) As String
    Dim sVolBuf As String, sSysName As String
    Dim lSerialNum As Long, lSysFlags As Long, lComponentLength As Long
    Dim lRet As Long
    
    sVolBuf = String$(256, 0)
    sSysName = String$(256, 0)
    lRet = GetVolumeInformation(sDrive, sVolBuf, MAX_PATH, lSerialNum, lComponentLength, lSysFlags, sSysName, MAX_PATH)
    
    If lRet > 0 Then
        sVolBuf = StripTerminator(sVolBuf)
        GetDriveName = StrConv(sVolBuf, vbProperCase)
    End If
End Function

Private Function GetNetDriveName(ByVal sDrive As String) As String
    Dim sRemoteName As String
    Dim lRet As Long
    sDrive = Left$(sDrive, 2) '& Chr$(0)
    
    sRemoteName = Space$(255)
    lRet = WNetGetConnection(sDrive, sRemoteName, Len(sRemoteName))
    GetNetDriveName = StrConv(GetName(StripTerminator(sRemoteName)), vbProperCase)
    'Select Case lRet
    '   Case ERROR_BAD_DEVICE
    '      Msg = "Error: Bad Device"
    '   Case ERROR_CONNECTION_UNAVAIL
    '      Msg = "Error: Connection Un-Available"
    '   Case ERROR_EXTENDED_ERROR
    '      Msg = "Error: Extended Error"
    '   Case ERROR_MORE_DATA
    '      Msg = "Error: More Data"
    '   Case ERROR_NOT_SUPPORTED
    '      Msg = "Error: Feature not Supported"
    '   Case ERROR_NO_NET_OR_BAD_PATH
    '      Msg = "Error: No Network Available or Bad Path"
    '   Case ERROR_NO_NETWORK
    '      Msg = "Error: No Network Available"
    '   Case ERROR_NOT_CONNECTED
    '      Msg = "Error: Not Connected"
    '   Case NO_ERROR
    '      ' all is successful...
    'End Select

End Function

Private Function StripTerminator(ByVal strString As String) As String
    Dim intZeroPos As Long
    intZeroPos = InStr(strString, Chr$(0))
    If intZeroPos > 0 Then
        StripTerminator = Left$(strString, intZeroPos - 1)
    Else
        StripTerminator = strString
    End If
End Function

Private Function GetName(sFileName As String) As String
    Dim k As Integer
    GetName = sFileName
    k = InStrRev(sFileName, "\")
    If k > 0 Then GetName = Right$(sFileName, Len(sFileName) - k)
End Function