vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
NEU! sevCoolbar 3.0 - Professionelle Toolbars im modernen Design!  
 vb@rchiv Quick-Search: Suche startenErweiterte Suche starten   Impressum  | Datenschutz  | vb@rchiv CD Vol.6  | Shop Copyright ©2000-2025
 
zurück
Rubrik: Dateisystem · Laufwerke   |   VB-Versionen: 26.11.25
Ermittlung von Parametern eines oder mehrerer Drives

Es werden Funktionen zur Ermittlung und Verwendung von Drive-Informationen gezeigt.

Autor:   Dietrich HerrmannBewertung:     [ Jetzt bewerten ]Views:  57 
ohne HomepageSystem:  Win7, Win8, Win10, Win11kein Beispielprojekt 

Im Nachfolgenden werden Funktionen zur Ermittlung und Verwendung von Drive-Informationen gezeigt.

Die erste Funktion dient der Ermittlung von diversen Informationen zu allen Drives in einem System.

''' <summary>
''' Drive Infos, für alle Drives im System
''' </summary>
''' <param name="tFlag">die Art der Darstellung der Ergebnisse</param>
''' <remarks>0.. die Ergebnisse nur in Debug.Print-Ausgabe
''' 1.. die lange Textausgabe
''' 2.. die kurze Ausgabe
''' <param name="delim">das Trennzeichen zu einzelnen Parametern</param>
''' <returns></returns>
Public Function getDriveInfos(Optional tFlag As Short = 0, Optional delim As String = vbTab) As String
  Dim allDrives() As DriveInfo = DriveInfo.GetDrives()
  Dim d As DriveInfo, t As String = ""
  Dim trenn As String = StrDup(30, "-") + vbCrLf
 
  For Each d In allDrives
    Select Case tFlag
      Case 0  ' Debug only
        Try
          Debug.Print("Drive: {0}", d.Name)
          Debug.Print("Drive type: {0}", d.DriveType)
          If d.IsReady Then
            Debug.Print("Volume label: {0}", d.VolumeLabel)
            Debug.Print("File system: {0}", d.DriveFormat)
            Debug.Print("Available space to current user:{0, 15} bytes", d.AvailableFreeSpace)
            Debug.Print("Total available space:          {0, 15} bytes", d.TotalFreeSpace)
            Debug.Print("Total size of drive:            {0, 15} bytes" + vbCrLf, d.TotalSize)
            ' Debug.Print(vbCrLf)
          Else
            Debug.Print("Drive {0} is not ready!", d.Name)
          End If
        Catch ex As Exception
        End Try
 
      Case 1  ' Langausgabe
        Try
          t += "Drive: " + d.Name + vbCrLf
          t += "Drive type: " + d.DriveType.ToString + vbCrLf
          If d.IsReady Then
            t += "Volume label: " + d.VolumeLabel + vbCrLf
            t += "File system: " + d.DriveFormat + vbCrLf
            t += "Total size of drive: " + FormatBytes(d.TotalSize) + vbCrLf
            t += "Total available space: " + FormatBytes(d.TotalFreeSpace) + vbCrLf
          Else
            t += "Drive: " + d.Name + " is not ready!" + vbCrLf
          End If
          t += trenn
        Catch ex As Exception
        End Try
 
      Case 2  ' Kurzausgabe
        t += d.Name + delim
        t += d.VolumeLabel + vbCrLf
 
      Case Else   ' nur die Bezeichnungen
        t += d.Name + ";"
    End Select
  Next
 
  Select Case tFlag
    Case 0
      Return allDrives.Length
    Case 1, 2
      Return t.Substring(0, t.Length - 2)
    Case Else
      Return t.Substring(0, t.Length - 1)
  End Select
End Function

Hierzu eine kurze Anwendungsmöglichkeit:

Dim driv As String = getDriveInfos(2).Replace(vbTab, " ").Replace("", "")
Dim spv As String() = Split(driv, vbCrLf)

Die zweite Funktion ermittelt die physischen Types der Drives:

''' <summary>
''' Ermitteln DiskTypes
''' </summary>
Public Function EnumPhysicalDriveTypes() As String()
  Dim scope = New ManagementScope("\.rootmicrosoftwindowsstorage")
  Dim searcher = New ManagementObjectSearcher("SELECT * FROM MSFT_PhysicalDisk")
  Dim Type, Types() As String, i As Short = 0
 
  scope.Connect()
  searcher.Scope = scope
 
  Dim rootDrive As String = Path.GetPathRoot(Environment.SystemDirectory)
  Dim queryObj As ManagementObject
 
  For Each queryObj In searcher.Get()
    ReDim Preserve Types(i)
    Select Case queryObj("MediaType")
      Case 1
        Type = "Unspecified"
      Case 3
        Type = "HDD"
      Case 4
        Type = "SSD"
      Case 5
        Type = "SCM"
      Case Else
        Type = "Unspecified"
    End Select
    Types(i) = Type
    i += 1
    ' MsgBox("Device " & queryObj("DeviceID") & ": " & Type)
  Next
  searcher.Dispose()
 
  Return Types
End Function

Anwendung:

Dim diskTypes() As String = EnumPhysicalDriveTypes()

Und schließlich die dritte Funktion zum Ermitteln der physischen Daten der Speicherbelegung der Drives:

''' <summary>
''' Ermitteln der Speichernutzung von Disks
''' </summary>
''' <param name="drive">der logische Dik-Name</param>
''' <returns>einen String mit allen Daten</returns>
''' <remarks>es wird die Hilfsfunktion benötigt:  FormatBytesSys</remarks>
Public Function getDiskStorage(drive As String)
  Dim res As String = ""
  Dim driveInfo As DriveInfo = New DriveInfo(drive)
 
  With driveInfo
    If .IsReady Then
      Dim totalSizeGB As ULong = .TotalSize   ' Gesamtspeicherplatz
      Dim availableFreeSpaceGB As ULong = .AvailableFreeSpace ' verwendbarer Speicherplatz
      Dim totalFreeSpaceGB As ULong = .TotalFreeSpace ' absolut freier Speicherplatz
      Dim occupiedSpaceGB As ULong = totalSizeGB - totalFreeSpaceGB   ' belegter Speicherplatz
 
      res &= drive & vbTab & FormatBytesSys(totalSizeGB) & vbTab _
        & FormatBytesSys(availableFreeSpaceGB) & vbTab _
        & FormatBytesSys(totalFreeSpaceGB) & vbTab _
        & FormatBytesSys(occupiedSpaceGB)
    Else
      Debug.Print(drive & " - ist nicht bereit.")
    End If
  End With
 
  Return res
End Function

Die Anwendung dazu:

Dim store, sp() As String
store = getDiskStorage(spv(0).Substring(0, 2))
sp = Split(store, vbTab)

Folgende Hilfsunktion wird benötigt:

''' <summary>
''' Berechnung von handelbaren Speichergrößen
''' </summary>
''' <param name="As"></param>
''' <param name="suffixArt"></param>
''' <param name="dec"></param>
''' <returns></returns>
Public Function FormatBytesSys(BytesCaller As ULong,
  Optional suffixArt As String = "k", Optional dec As Short = 0) As String
 
  ' art... k (Kurzbezeichnung der Größe)
  ' art... nicht k (Langbezeichnung)
 
  Dim DoubleBytes As ULong
  Try
    Select Case BytesCaller
      Case Is >= 1099511627776
        DoubleBytes = BytesCaller / 1099511627776 'TB
        Return FormatNumber(DoubleBytes, dec) & If(suffixArt = "k", " TB", " Terabyte")
      Case 1073741824 To 1099511627775
        DoubleBytes = BytesCaller / 1073741824 'GB
        Return FormatNumber(DoubleBytes, dec) & If(suffixArt = "k", " GB", " Gigabyte")
      Case 1048576 To 1073741823
        DoubleBytes = BytesCaller / 1048576 'MB
        Return FormatNumber(DoubleBytes, dec) & If(suffixArt = "k", " MB", " Megabyte")
      Case 1024 To 1048575
        DoubleBytes = BytesCaller / 1024 'KB
        Return FormatNumber(DoubleBytes, dec) & If(suffixArt = "k", " KB", " Kilobyte")
      Case 0 To 1023
        DoubleBytes = BytesCaller ' Bytes
        Return FormatNumber(DoubleBytes, dec) & " Bytes"
      Case Else
        Return ""
    End Select
  Catch
    Return ""
  End Try
End Function

Dieser Tipp wurde bereits 57 mal aufgerufen.

Voriger Tipp   |   Zufälliger Tipp   |   Nächster Tipp

Über diesen Tipp im Forum diskutieren
Haben Sie Fragen oder Anregungen zu diesem Tipp, können Sie gerne mit anderen darüber in unserem Forum diskutieren.

Neue Diskussion eröffnen

nach obenzurück


Anzeige

Kauftipp Unser Dauerbrenner!Diesen und auch alle anderen Tipps & Tricks finden Sie auch auf unserer aktuellen vb@rchiv  Vol.6

Ein absolutes Muss - Geballtes Wissen aus mehr als 8 Jahren vb@rchiv!
- nahezu alle Tipps & Tricks und Workshops mit Beispielprojekten
- Symbol-Galerie mit mehr als 3.200 Icons im modernen Look
Weitere Infos - 4 Entwickler-Vollversionen (u.a. sevFTP für .NET), Online-Update-Funktion u.v.m.
 
   

Druckansicht Druckansicht Copyright ©2000-2025 vb@rchiv Dieter Otter
Alle 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.

Diese Seiten wurden optimiert für eine Bildschirmauflösung von mind. 1280x1024 Pixel