Die Community zu .NET und Classic VB.
Menü

VB 5/6-Tipp 0084: Festplattendaten, Laufwerksdaten auslesen

 von 

Beschreibung 

Hier werden allerlei Informationen über einen Datenträger geboten. Neben der gesamten Speicherkapazität und dem freien Speicher lässt sich die Art des Dateisystems, die Clustergröße, die Datenträgerbezeichnung, die Seriennummer etc. erfahren.

Update am 08. Februar 2003 von Kai:
Nun sollte die Festplattengröße wirklich keine Probleme mehr geben.

Schwierigkeitsgrad:

Schwierigkeitsgrad 2

Verwendete API-Aufrufe:

GetDiskFreeSpaceA (GetDiskFreeSpace), GetVolumeInformationA (GetVolumeInformation)

Download:

Download des Beispielprojektes [2,95 KB]

'Dieser Quellcode stammt von http://www.activevb.de
'und kann frei verwendet werden. Für eventuelle Schäden
'wird nicht gehaftet.

'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
'Ansonsten viel Spaß und Erfolg mit diesem Source!

'------------- Anfang Projektdatei Project1.vbp -------------
'--------- Anfang Formular "Form1" alias Form1.frm  ---------
' Steuerelement: Festplattenauswahlliste "Drive1"
' Steuerelement: Beschriftungsfeld "Label2" (Index von 0 bis 11)
' Steuerelement: Beschriftungsfeld "Label1" (Index von 0 bis 11)

Option Explicit

Private Declare Function GetVolumeInformation Lib "kernel32" _
        Alias "GetVolumeInformationA" (ByVal lpRootPathName _
        As String, ByVal lpVolumeNameBuffer As String, ByVal _
        nVolumeNameSize As Long, lpVolumeSerialNumber As Long, _
        lpMaximumComponentLength As Long, lpFileSystemFlags _
        As Long, ByVal lpFileSystemNameBuffer As String, ByVal _
        nFileSystemNameSize As Long) As Long

Private Declare Function GetDiskFreeSpace Lib "kernel32" Alias _
        "GetDiskFreeSpaceA" (ByVal lpRootPathName As String, _
        lpSectorsPerCluster As Long, lpBytesPerSector As Long, _
        lpNumberOfFreeClusters As Long, lpTotalNumberOfClusters _
        As Long) As Long

Const FS_CASE_IS_PRESERVED = &H2
Const FS_CASE_SENSITIVE = &H1
Const FS_UNICODE_STORED_ON_DISK = &H4
Const FS_PERSISTENT_ACLS = &H8
Const FS_FILE_COMPRESSION = &H10
Const FS_VOL_IS_COMPRESSED = &H8000&

Private Sub Form_Load()
  Call GetDriveInf("c")
  Drive1.Drive = "c"
End Sub

Private Sub Drive1_Change()
  Call GetDriveInf(Left$(Drive1.Drive, 1))
End Sub

Private Sub GetDriveInf(ByVal Drv$)
    Dim X As Long, AA As String, Result As Long
    Dim SerN As Long, PathL As Long, Flags As Long
    Dim XPC As Long, BPS As Long
    Dim FreeB As Double, FreeC As Long
    Dim TotB As Double, TotC As Long
    Dim VolN As String * 256
    Dim FileS As String * 256
  
    For X = 0 To Label2.UBound
        Label2(X).Caption = ""
    Next X
    
    Drv = Drv & ":\"
    Result = GetVolumeInformation(Drv, VolN, 256, SerN, _
                                    PathL, Flags, FileS, 256)
    If Result = 0 Then
        MsgBox ("Error in GetVolumeInformation.")
    Else
        Label2(0) = Drv
        Label2(1) = Left$(VolN, InStr(VolN, Chr$(0)) - 1)
        Label2(2) = SerN
        Label2(3) = Left$(FileS, InStr(FileS, Chr$(0)) - 1)
        Label2(4) = PathL
              
        If Flags And FS_CASE_IS_PRESERVED Then AA = AA & "Preserved "
        If Flags And FS_CASE_SENSITIVE Then AA = AA & "Sensistive "
        If Flags And FS_UNICODE_STORED_ON_DISK Then AA = AA & "Unicode "
        If Flags And FS_PERSISTENT_ACLS Then AA = AA & "Persistent "
        If Flags And FS_FILE_COMPRESSION Then AA = AA & "File-Compr. "
        If Flags And FS_VOL_IS_COMPRESSED Then AA = AA & "Vol-Compr."
        Label2(11) = AA
    End If
    
    Result = GetDiskFreeSpace(Drv, XPC, BPS, FreeC, TotC)
    If Result = 0 Then
        MsgBox ("Error in GetDiskFreeSpace.")
    Else
        Label2(5) = TotC
        Label2(6) = XPC
        Label2(7) = BPS
        Label2(8) = FreeC
        TotB = CDbl(TotC) * XPC * BPS
        Label2(9) = Format$(TotB, "###,###,###,###,###,###")
        FreeB = CDbl(FreeC) * XPC * BPS
        Label2(10) = Format$(FreeB, "###,###,###,###,###,###")
    End If
End Sub
'---------- Ende Formular "Form1" alias Form1.frm  ----------
'-------------- Ende Projektdatei Project1.vbp --------------

Tipp-Kompatibilität:

Windows/VB-VersionWin32sWin95Win98WinMEWinNT4Win2000WinXP
VB4
VB5
VB6

Hat dieser Tipp auf Ihrem Betriebsystem und mit Ihrer VB-Version funktioniert?

Ja, funktioniert!

Nein, funktioniert nicht bei mir!

VB-Version:

Windows-Version:

Ihre Meinung  

Falls Sie Fragen zu diesem Artikel haben oder Ihre Erfahrung mit anderen Nutzern austauschen möchten, dann teilen Sie uns diese bitte in einem der unten vorhandenen Themen oder über einen neuen Beitrag mit. Hierzu können sie einfach einen Beitrag in einem zum Thema passenden Forum anlegen, welcher automatisch mit dieser Seite verknüpft wird.

Archivierte Nutzerkommentare 

Klicken Sie diesen Text an, wenn Sie die 6 archivierten Kommentare ansehen möchten.
Diese stammen noch von der Zeit, als es noch keine direkte Forenunterstützung für Fragen und Kommentare zu einzelnen Artikeln gab.
Aus Gründen der Vollständigkeit können Sie sich die ausgeblendeten Kommentare zu diesem Artikel aber gerne weiterhin ansehen.

Kommentar von Gerhard Quentel am 09.07.2009 um 13:21

Sehr geehrte Spezialisten,

ist es möglich auch ohne vorher ein Netzlaufwerk zu mounten (z.B. \\10.191.5.10\) von diesem die Speichergröße, freien Speicherplatz usw. zu ermitteln?

Für Ihre Hilfe wäre ich dankbar.
Mit freundlichem Gruß
Gerhard Quentel

Kommentar von VBA-bon am 07.05.2007 um 15:41

Um die Beschränkung auf 2GB aufzuheben einfach folgende Funktion beutzen:
GetDiskFreeSpaceEx

Private Declare Function GetDiskFreeSpaceEx Lib "kernel32.dll" Alias "GetDiskFreeSpaceExA" (ByVal lpDirectoryName As String, ByRef lpFreeBytesAvailableToCaller As ULARGE_INTEGER, ByRef lpTotalNumberOfBytes As ULARGE_INTEGER, ByRef lpTotalNumberOfFreeBytes As ULARGE_INTEGER) As Long
Private Type ULARGE_INTEGER
LowPart As Long
HighPart As Long
End Type

Kommentar von PCMueller am 29.04.2004 um 14:05

Kann man diesen Tip noch einmal einfügen, unter der Überschrift
Prüfen, ob Laufwerk bereit ist?
(für z.B. Dir Controll). ist glaube ich eine gute Idee, damit man nicht permanent mit error-meldungen beim testen von CD-Rom Laufwerken beschäftigt ist, wenn keine CD im Laufwerk ist.
Kurze Version hierzu:

Public Function Laufwerk_ist_bereit(ByVal Drive As String) As Boolean
Dim DRV As String, Result As Long
'unbenutzte aber notwendige parameter für API
Dim VolN As String * 256
Dim SerN As Long, PathL As Long, Flags As Long
Dim FileS As String * 256
'start der funktion
DRV = Trim$(Drive)
If Len(DRV) = 1 Then DRV = DRV & "\"
If Right$(DRV, 1) <> "\" Then DRV = DRV & "\"
Result = GetVolumeInformation(DRV, VolN, 256, SerN, _
PathL, Flags, FileS, 256)
If Result = 0 Then
Laufwerk_ist_bereit = False
Else
Laufwerk_ist_bereit = True
End If
End Function



PS byval parameter sollte man nie ändern!
man kommt dadurch nur durcheinander, da wenn z.B. c: reinkommt, hier c:\ zurückgeht. da es sich hier im BSP aber nicht um eine funktion handelt, könnte dies verwirren, und lange fehlersuchzeiten verursachen!
Statt dessen lieber eine lokale variable spendieren.


PS zu der Frage mit den Seriennummern: die bekommt man nur unter NT-Systemen, win9x Systeme geben die Formatierungskennung zurück.
MFG Thomas (Hannover).

Kommentar von VBProfie am 21.05.2002 um 14:33

Ähem, das Ding läuft garnicht. Habe gedacht
das meine 160 GB Maxtor am Arsch währe
und habe darauf eine Maxtohr Platte 560 Gig
als Indusriepladde gekauft und da ging der Schrott auch nciht.
Der macht immer einen Uberlauf, obwohl ich einen 2100 MHZ Pentium Nortwood mit 1,5 GB DDR-Ram habe.
Am rechner kanns also nicht liegen

Kommentar von Martin Wager am 27.08.2001 um 15:07

Bei großen Platten wird immer 2.14GB angezeigt. Der Wert ist erst richtig, sobal weniger als 1GB frei ist

Kommentar von Armin R am 23.08.2001 um 11:28

Weiß jemand wieso die Seriennummer einer CD unter Win98/ME und WinNt verschieden sind? In Win98 und Me sind sie gleich?