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

'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 --------------

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