Laufwerkstyp korrekt erkennen Dieser Tipp zeigt, wie sich der Laufwerkstyp korrekt erkennen lässt - auch bei Diskettenlaufwerken und Wechseldatenträgern
Autor:   Michael Schäffner	Bewertung:     [ Jetzt bewerten ]	Views:  5.761
ohne Homepage	System:  Win9x, WinNT, Win2000, WinXP, Vista	Beispielprojekt auf CD

Geben Sie hier Ihre persönliche Bewertung ab! Anzahl Bewertungen bisher: 13 Bewertung insgesamt: gut Durchschnittliche Bewertung: 3.6 von 5 Sternen

sehr gut     gut     nützlich     mittelmäßig     mangelhaft

Es gibt eine API Deklaration, mit der man den Laufwerkstyp identifizieren kann. Leider nicht korrekt bei Diskettenlaufwerke oder Wechseldatenträger.

Nachfolgender Tipp behebt dieses Problem:

' Benötigte API-Deklarationen
Private Declare Function GetDriveType Lib "kernel32" _
  Alias "GetDriveTypeA" ( _
  ByVal nDrive As String) As Long
 
Private Declare Function SHGetFileInfo Lib "shell32.dll" _
  Alias "SHGetFileInfoA" ( _
  ByVal pszPath As String, _
  ByVal dwFileAttributes As Long, _
  psfi As SHFILEINFO, _
  ByVal cbFileInfo As Long, _
  ByVal uFlags As Long) As Long
 
Private Const MAX_PATH = 260
Private Const SHGFI_TYPENAME = &H400&
 
Enum DriveTypes
  Unknown = 1
  Removable = 2
  HDD = 3
  Network = 4
  CDROM = 5
  RamDisk = 6
  Floppy35 = 7
  Floppy525 = 8
End Enum
 
Private Type SHFILEINFO
  hIcon As Long
  iIcon As Long
  dwAttributes As Long
  szDisplayName As String * MAX_PATH
  szTypeName As String * 80
End Type

Private Function GetFileDescription( _
  ByVal Filename As String) As String
 
  Dim SHInfo As SHFILEINFO
  Dim lPos As Long
 
  SHGetFileInfo Filename, 0, SHInfo, Len(SHInfo), _
    SHGFI_TYPENAME
  lPos = InStr(SHInfo.szTypeName, Chr$(0))
  If lPos > 0 Then
    GetFileDescription = Left(SHInfo.szTypeName, lPos - 1)
  End If
End Function

Public Function GetDrvType(Drive As String) _
  As DriveTypes
 
  Select Case GetDriveType(Left(Drive, 2) & "\")
    Case 2
      Select Case GetFileDescription(Left(Drive, 2) & "\")
        Case "3,5-Diskette", "3½-Diskette"
          GetDrvType = DriveTypes.Floppy35
        Case "5,25-Diskette", "5¼-Diskette"
           GetDrvType = DriveTypes.Floppy525
         Case Else
           GetDrvType = DriveTypes.Removable
       End Select
     Case 3
       GetDrvType = DriveTypes.HDD
     Case 4
       GetDrvType = DriveTypes.Network
     Case 5
       GetDrvType = DriveTypes.CDROM
     Case 6
       GetDrvType = DriveTypes.RamDisk
     Case Else
       GetDrvType = DriveTypes.Unknown
  End Select
End Function