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:	Views:  14.026
ohne Homepage	System:  Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11	Beispielprojekt auf CD

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

Copyright ©2000-2024 vb@rchiv Dieter OtterAlle Rechte vorbehalten.

Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein.