|
Declare Function GetLogicalDriveStrings Lib "kernel32" Alias "GetLogicalDriveStringsA" _
(ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" _ (ByVal nDrive As String) As Long Global Const DRIVE_REMOVABLE = 2 Global Const DRIVE_FIXED = 3 Global Const DRIVE_REMOTE = 4 Global Const DRIVE_CDROM = 5 Global Const DRIVE_RAMDISK = 6 Public Function GetAllDrives() As String Dim lngResult&, strDrives$, strJustOneDrive$, intPos%, lngDriveType& Dim strBuffer As String 'buffer op procedureniveau declareren. strDrives$ = Space$(255) lngResult& = GetLogicalDriveStrings(Len(strDrives$), strDrives$) strDrives$ = Left$(strDrives$, lngResult&) Do intPos% = InStr(strDrives$, Chr$(0)) If intPos% Then strJustOneDrive$ = Left$(strDrives$, intPos% - 1) strDrives$ = Right$(strDrives$, Len(strDrives$) - intPos%) lngDriveType& = GetDriveType(strJustOneDrive$) Select Case lngDriveType& Case DRIVE_CDROM strBuffer = strBuffer & "CD-Rom: " & strJustOneDrive$ & vbCrLf Case DRIVE_REMOVABLE strBuffer = strBuffer & "RemovableDrive: " & strJustOneDrive$ & vbCrLf Case DRIVE_FIXED strBuffer = strBuffer & "LocalDrive: " & strJustOneDrive$ & vbCrLf Case DRIVE_REMOTE strBuffer = strBuffer & "NetworkDrive: " & strJustOneDrive$ & vbCrLf Case DRIVE_RAMDISK strBuffer = strBuffer & "RamDrive: " & strJustOneDrive$ & vbCrLf End Select End If Loop Until strDrives$ = "" GetAllDrives = strBuffer End Function |