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

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

 von ActiveVB

'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-Version	Win32s	Win95	Win98	WinME	WinNT4	Win2000	WinXP
VB4
VB5
VB6

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

Ja, funktioniert!

Nein, funktioniert nicht bei mir!

VB-Version: VB6 VB5 VB4

Windows-Version: Windows XP Windows 2000 Windows NT4 Windows Me Windows 98 Windows 95 Win32s

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.

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