Tipp 0257 Laufwerks-Informationen ermitteln (FSO)
Autor/Einsender:
Datum:
  Angie
20.02.2005 (Update)
Entwicklungsumgebung:   VB 6
Ab Visual Basic 6 steht standardmäßig das FileSystemObject (FSO) zur Verfügung, mit dem auch ein komfortabler Umgang mit Ordnern und Dateien möglich ist und das auch zur Analyse des Dateisystems verwendet werden kann.
Mit folgendem Beispiel werden verschiedene Laufwerks-Informationen ermittelt, unter anderem die Bezeichnung und Typ des Laufwerks, die Speicherkapazität und der freier Speicher.
 
Option Explicit

Private m_objFSO As FileSystemObject

Private Sub Form_Load()
  Dim astrDrives() As String
  Dim i As Integer

  Set m_objFSO = New FileSystemObject

  If GetAllDrives(astrDrives) Then
    With Me.lstDrives
      For i = 0 To UBound(astrDrives)
        .AddItem astrDrives(i)
      Next
      .ListIndex = 0
    End With
  Else
    Me.lstDrives.Clear
    Me.txtDriveInfo.Text = "Es ist ein Fehler aufgetreten!"
  End If
End Sub

Private Sub lstDrives_Click()
  Me.txtDriveInfo.Text = _
      GetDriveInfos(Left$(Me.lstDrives.Text, 1))
End Sub

Private Function GetAllDrives(ByRef astrDrives() As String) _
      As Boolean
  Dim fsoDrives   As Drives
  Dim fsoDrive    As Drive
  Dim strDrive    As String
  Dim nDrive      As Long

  On Error GoTo err_GetAllDrives

  Set fsoDrives = m_objFSO.Drives

  ReDim astrDrives(0 To fsoDrives.Count - 1)
  nDrive = -1

  For Each fsoDrive In fsoDrives
    strDrive = fsoDrive.DriveLetter & ":  "

    Select Case fsoDrive.DriveType
      Case 0: strDrive = strDrive & "Unbekannt"
      Case 1: strDrive = strDrive & "Wechseldatenträger"
      Case 2: strDrive = strDrive & "Lokaler Datenträger"
      Case 3: strDrive = strDrive & "Netzwerklaufwerk"
      Case 4: strDrive = strDrive & "CD-ROM-Laufwerk"
      Case 5: strDrive = strDrive & "Virtuelles Laufwerk"
    End Select

    nDrive = nDrive + 1
    astrDrives(nDrive) = strDrive
  Next

  GetAllDrives = True

exit_Func:
  On Error GoTo 0
  Set fsoDrives = Nothing
  Exit Function

err_GetAllDrives:
  MsgBox "Fehler " & Err.Number & vbCrLf & _
      Err.Description, vbOKOnly + vbCritical
  Resume exit_Func
End Function

Private Function GetDriveInfos(ByVal strDriveSel As String) _
      As String
  Dim fsoDrive As Drive
  Dim strInfo  As String

  Set fsoDrive = m_objFSO.GetDrive(strDriveSel)
  With fsoDrive
    If .IsReady = True Then
      strInfo = "Laufwerk: " & .DriveLetter & vbCrLf
      strInfo = strInfo & "Bezeichnung: " & .VolumeName & vbCrLf
      strInfo = strInfo & "Dateisystem: " & .FileSystem & vbCrLf
      strInfo = strInfo & "Serial-Nr: " & .SerialNumber & vbCrLf
      strInfo = strInfo & "Speicherkapazität: " & _
                 FormatNumber(.TotalSize, 0) & " bytes" & vbCrLf
      strInfo = strInfo & "Freier Speicher: " & _
                 FormatNumber(.FreeSpace, 0) & " bytes"

    Else
      strInfo = "Laufwerk " & .DriveLetter & " nicht bereit!"
    End If
  End With
  Set fsoDrive = Nothing

  GetDriveInfos = strInfo
End Function

Private Sub Form_Terminate()
  Set m_objFSO = Nothing
End Sub
 
Weitere Links zum Thema
225032 BUG: Drive Object Properties Are Incorrect on Large Drives (>2GB)
Laufwerksbezeichnung ändern / setzen
Seriennummer und Bezeichnung eines Datenträgers auslesen
Hinweis für VBA-Anwender
Die im Download im VBA-Ordner enthaltene Datei frmGetDriveTypes.frm kann für die Verwendung in einem (Office-)Programm im VB-Editor des entsprechenden Programms importiert werden.
Hinweis
Um diesen Tipp ausführen zu können, muss die Bibliothek Microsoft Scripting Runtime (SCRRUN.DLL) in das VB- bzw. VBA-Projekt eingebunden werden.

Windows-Version
95
98/SE
ME
NT
2000
XP
Vista
Win 7
VB-Version
VBA 5
VBA 6
VB 4/16
VB 4/32
VB 5
VB 6


Download  (7 kB) Downloads bisher: [ 1897 ]

Vorheriger Tipp Zum Seitenanfang Nächster Tipp

Startseite | Projekte | Tutorials | API-Referenz | VB-/VBA-Tipps | Komponenten | Bücherecke | VB/VBA-Forum | VB.Net-Forum | DirectX-Forum | Foren-Archiv | DirectX | VB.Net-Tipps | Chat | Spielplatz | Links | Suchen | Stichwortverzeichnis | Feedback | Impressum

Seite empfehlen Bug-Report
Letzte Aktualisierung: Sonntag, 28. August 2011