VB-Homepage Tipp 340

Ermitteln der verfügbaren Laufwerke/Laufwerkstypen

Für die Installation oder Funktionalität Ihres Programm benötigen Sie die verfügbaren Laufwerkes bzw. die Art der verfügbaren Laufwerke?
Na dann ist dies ja genau der richtige Tipp für Sie.

1.
Für die Bestimmung des Laufwerkstyps benötigen Sie genau eine API Funktion
Allgemein/Deklarationen
Const DRIVE_ANY = 0
Const DRIVE_REMOVABLE = 2
Const DRIVE_FIXED = 3
Const DRIVE_REMOTE = 4
Const DRIVE_CDROM = 5
Const DRIVE_RAMDISK = 6

Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long

2.
In unserem Demoprojekt sollen die entsprechenden Laufwerke an Hand der Vorgabe ermittelt werden.

2.1
Basteln Sie sich dazu einen CommandButton auf Ihre Form und erstellen fünf weiter Kopien dieses CommanButtons (Command1(0) bis Command1(5))

2.2
Desweiteren benötigen wir eine Listbox (List1) zur Anzeige der Ergebnisse.

3.
Übergeben Sie beim Programmstart die Überschriften der CommandButton
Command1(0).Caption = "Alle Laufwerke"
Command1(1).Caption = "Alle Festplatten"
Command1(2).Caption = "Alle Wechseldatenträger"
Command1(3).Caption = "Alle Netzlaufwerke"
Command1(4).Caption = "Alle CD-ROM's"
Command1(5).Caption = "Alle RAM Disk's"

4.
Im Click Ereignis des CommandButtons erfolgt dann der Aufruf zum Ermitteln der entsprechenden Laufwerke. Die Ergebnisse werden anschließend in die Listbox geschrieben.

Private Sub Command1_Click(Index As Integer)
Dim varDrives, i As Integer

List1.Clear   'erstmal Listbox säubern für neue Einträge

If Index = 0 Then
   varDrives = GetLocalDrives(DRIVE_ANY) 'Alle Typen
   List1.AddItem "Alle vorhandenen Laufwerke"
ElseIf Index = 1 Then
   varDrives = GetLocalDrives(DRIVE_FIXED) 'Festplatten
   List1.AddItem "Alle Festplatten"
ElseIf Index = 2 Then
   varDrives = GetLocalDrives(DRIVE_REMOVABLE) 'Alle Wechseldatenträger
   List1.AddItem "Alle Wechseldatenträger"
ElseIf Index = 3 Then
   varDrives = GetLocalDrives(DRIVE_REMOTE) 'Netzlaufwerke
   List1.AddItem "Alle Netzlaufwerke"
ElseIf Index = 4 Then
   varDrives = GetLocalDrives(DRIVE_CDROM) 'CD-ROM
   List1.AddItem "Alle CD-ROM Laufwerke"
ElseIf Index = 5 Then
   varDrives = GetLocalDrives(DRIVE_RAMDISK) 'RAM
   List1.AddItem "Alle RAM Disk's"
End If

If IsArray(varDrives) Then
   For i = 0 To UBound(varDrives)
      List1.AddItem varDrives(i)
   Next i
Else
   List1.AddItem "Keine Laufwerke dieses Types gefunden"
End If

End Sub

GetLocalDrives ist der Name unserer Prozedur zum ermitteln der verfügbaren Laufwerkes einer definierten Gruppe von Laufwerkstypen, die in Klammern gesetzt, der Prozedur übergeben wird. Nach dem Durchlaufen der Prozedur befinden sich alle entsprechenden Laufwerksbuchstaben in der Variable varDrives und können von dort der Listbox übergeben werden.

5.
Allgemein/GetLocalDrives
Public Function GetLocalDrives(lngType As Long) As Variant

Dim cResult As Long, i As Integer, intCount As Integer
Dim strTmpArray() As String
ReDim strTmpArray(0 To 25)

If lngType = DRIVE_ANY Then
    For i = 0 To 25
        cResult = GetDriveType(Chr(65 + i) & ":\")
        If cResult <> 1 Then
              strTmpArray(intCount) = Chr(65 + i)
              intCount = intCount + 1
        End If
    Next i
Else
    For i = 0 To 25
        cResult = GetDriveType(Chr(65 + i) & ":\")
        If cResult = lngType Then
              strTmpArray(intCount) = Chr(65 + i)
              intCount = intCount + 1
        End If
    Next i
End If

If intCount > 0 Then
    ReDim Preserve strTmpArray(0 To intCount - 1)
    GetLocalDrives = strTmpArray
End If

End Function

6.
Starten Sie Ihr Projekt mit F5 und lassen sich nacheinander alle verfügbaren Laufwerke bzw. alle Laufwerkes eines Typs anzeigen.
Die Modifizierung für Ihr eigenes Projekt sollte dann kein Problem mehr darstellen.

Sozusagen als Zugabe ist es auch möglich mit dieser API Funktion die freien Laufwerksbuchstaben zu ermitteln. Dies scheint allerdings nicht dokumentiert zu sein, da ich es selbst bei Appelman nicht gefunden habe.

Um dies zu nutzen müßten Sie die Definition unter Allgemein/Deklarationen um den Eintrag Const DRIVE_FREE = 1 erweitern, einen zusätzlichen Commandbutton (6) einfügen und die Prozedur GetLocalDrives um eine weitere ElseIf Anweisung ergänzen.
    ElseIf Index = 6 Then
         varDrives = GetLocalDrives(DRIVE_FREE) 'FREI
         List1.AddItem "Alle verfügbaren Laufwerksbuchstaben,"
         List1.AddItem "die nicht belegt sind."


Tipp-Download

Quelle :

Zurück zur Übersichtsseite