vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
TOP-Angebot: 12 bzw. 19 Entwickler-Vollversionen zum unschlagbaren Preis!  
 vb@rchiv Quick-Search: Suche startenErweiterte Suche starten   RSS-Feeds  | Newsletter  | Impressum  | Datenschutz  | vb@rchiv CD Vol.6  | Shop Copyright ©2000-2015
 
zurück
Rubrik: Dateisystem15.11.01
GetDiskFreeSpace-Funktion

Diese Funktion liefert die Größe des gesamten und freien Festplattenspeichers einer Festplatte bis zu einer Größe von 2 Gigabyte.

Betriebssystem:  Win95, Win98, WinNT 3.1, Win2000, WinMEViews:  5.745 

Summer-Special bei Tools & Components!
Gute Laune Sommer bei Tools & Components
Top Summer-Special - Sparen Sie teilweise über 100,- EUR
Alle sev-Entwicklerkomponenten und Komplettpakete jetzt bis zu 25% reduziert!
zum Beispiel:
  • Developer CD nur 455,- EUR statt 569,- EUR
  • sevDTA 2.0 nur 224,30 EUR statt 299,- EUR
  •  
  • vb@rchiv   Vol.6 nur 18,70 EUR statt 24,95 EUR
  • sevCoolbar 3.0 nur 58,70 EUR statt 69,- EUR
  • - Werbung -Und viele weitere Angebote           Aktionspreise nur für kurze Zeit gültig

    Deklaration:

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

    Beschreibung:
    Diese Funktion liefert die Größe des gesamten und freien Festplattenspeichers einer Festplatte bis zu einer Größe von 2 Gigabyte.

    Parameter:
    lpRootPathNameErwartet den Laufwerksbuchstaben als Strings, zb. "a:\, c:\ etc."..
    lpSectorsPerClusterGibt die Anzahl der Sektoren pro Cluster zurück
    lpBytesPerSectorGibt die Bytes pro Sektor zurück
    lpNumberOfFreeClustersGibt die Anzahl der Cluster des freien Speicherplatzes zurück.
    lpTotalNumberOfClustersGibt die Anzahl der Cluster des gesamten Speicherplatzes zurück.

    Rückgabewert:
    Ist die Funktion erfolgreich, wird ein Wert "ungleich 0", andernfalls "0" zurückgegeben. Für erweiterte Fehlerinformationen rufen Sie die GetLastError-Funktion auf.


    Beispiel:

    Private Declare Function GetDiskFreeSpace Lib "kernel32.dll" _
      Alias  "GetDiskFreeSpaceA" ( _
      ByVal lpRootPathName As String, _
      lpSectorsPerCluster As Long, _
      lpBytesPerSector As Long, _
      lpNumberOfFreeClusters As Long, _
      lpTotalNumberOfClusters As Long) As Long
     
    Private Declare Function GetDiskFreeSpaceEx Lib "kernel32.dll" _
      Alias "GetDiskFreeSpaceExA" ( _
      ByVal lpDirectoryName As String, _
      lpFreeBytesAvailableToCaller As ULARGE_INTEGER, _
      lpTotalNumberOfBytes As ULARGE_INTEGER, _
      lpTotalNumberOfFreeBytes As ULARGE_INTEGER) As Long
     
    Private Declare Function GetVersionEx Lib "kernel32.dll" _
      Alias "GetVersionExA" ( _
      lpVersionInformation As OSVERSIONINFO) As Long
     
    Private Declare Function GetLogicalDriveStrings Lib "kernel32.dll" _
      Alias "GetLogicalDriveStringsA" ( _
      ByVal nBufferLength As Long, _
      ByVal lpBuffer As String) As Long
     
    Private Declare Sub CopyMemory Lib "kernel32.dll" _
      Alias "RtlMoveMemory" ( _
      Destination As Any, _
      Source As Any, _
      ByVal Length As Long)
     
    Private Type ULARGE_INTEGER
      LowPart As Long
      HighPart As Long
    End Type
     
    Private Type OSVERSIONINFO
      dwOSVersionInfoSize As Long
      dwMajorVersion As Long
      dwMinorVersion As Long
      dwBuildNumber As Long
      dwPlatformId As Long
      szCSDVersion As String * 128
    End Type
     
    Private Const VER_PLATFORM_WIN32s = 0 ' Win 3.1 mit 32 Bit-Erweiterung
    Private Const VER_PLATFORM_WIN32_WINDOWS = 1 ' Win NT/2000
    Private Const VER_PLATFORM_WIN32_NT = 2 ' Win 9x
    Private Sub Command1_Click()
      Dim Retval As Long
      Dim OS As OSVERSIONINFO
      Dim InputRet As String
      Dim Buffer As String
     
      ' Laufwerksbuchstaben ermitteln
      Buffer = Space(256)
      Retval = GetLogicalDriveStrings(Len(Buffer), Buffer)
      Buffer = Left$(Buffer, Retval)
      Buffer = Replace(Buffer, "\" & vbNullChar, ", ")
     
      ' User nach dem Laufwerk fragen, dessen Informationen
      ' ermittelt werden sollen
      InputRet = InputBox("Geben Sie einen Laufwerksbuchstaben ein " &  _
      "(" & Buffer & ").", "Speicher Information ermitteln", "C:\")
      If InputRet = "" Or Len(InputRet) > 3 Then
        MsgBox "Ungültige Eingabe - nur Laufwerksbuchstaben, " & _
          "Doppelpunkt und Backslash eingeben."
        Exit Sub
      End If
     
      ' Betriebssystem ermitteln
      OS.dwOSVersionInfoSize = Len(OS)
      Retval = GetVersionEx(OS)
      If Retval = 0 Then
        MsgBox "Betriebssystem-Version konnte nicht ermittelt werden."
        Exit Sub
      End If
     
      ' Je nach Betriebsystem, entsprechende
      ' API-Funktion aufrufen
      With OS
        Select Case .dwPlatformId
        Case VER_PLATFORM_WIN32_WINDOWS
          If InStr(1, OS.szCSDVersion, "B") <> 0 Or _
        .dwMinorVersion > 0 Then
            ' Win98 oder höher
            Call GetNewFreespace(InputRet)
          Else
            Call GetOldFreespace(InputRet)
          End If
        Case VER_PLATFORM_WIN32_NT
          If .dwMajorVersion >= 4 Then
        ' WinNT 4/Win2000/WinXP
            Call GetNewFreespace(InputRet)
          Else
            Call GetOldFreespace(InputRet)
          End If
        Case Else
          MsgBox "Windows 3.x Version kann nicht ermittelt werden."
        End Select
      End With
    End Sub
    ' "alte Version" von GetDiskFreespace
    Private Function GetOldFreespace(ByVal Root As String)
      Dim Retval As Long
      Dim SC As Long, BC As Long, FC As Long, TC As Long
      Dim TSpace As Long, FSpace As Long, USpace As Long
     
      ' HD-Speierauslastung ermitteln und ausrechnen
      Retval = GetDiskFreeSpace(Root, SC, BC, FC, TC)
      TSpace = TC * SC * BC / 1024 / 1024
      FSpace = FC * SC * BC / 1024 / 1024
      USpace = TSpace - FSpace
     
      ' Festplattenauslastung ausgeben
      MsgBox "Gesamt: " & Format$(TSpace, "##.00 MB") & vbCrLf & _
        "Belegt: " & Format$(USpace, "##.00 MB") & vbCrLf & _
        "Frei: " & Format$(FSpace, "##.00 MB") & vbCrLf _
        , , "Festplattenspeicher Laufwerk """ & Root & """"
    End Function
    ' "neue Version" von GetDiskFreespace
    Private Function GetNewFreespace(ByVal Root As String)
      Dim Retval As Long
      Dim CBytes As ULARGE_INTEGER
      Dim TBytes As ULARGE_INTEGER
      Dim FBytes As ULARGE_INTEGER 
      Dim CB  As Currency
      Dim TB As Currency
      Dim FB As Currency
      Dim UB As Currency
     
      ' Speicherauslastung ermitteln und berechnen
      Retval = GetDiskFreeSpaceEx(Root, CBytes, TBytes, FBytes)
      CopyMemory CB, CBytes, 8
      CB = CB * 10000 / 1024 / 1024
      CopyMemory TB, TBytes, 8
      TB = TB * 10000 / 1024 / 1024
      CopyMemory FB, FBytes, 8
      FB = FB * 10000 / 1024 / 1024
      UB = TB - FB
     
      MsgBox "Gesamt: " & Format$(TB, "##.00 MB") & vbCrLf & _
        "Belegt: " & Format$(UB, "##.00 MB") & vbCrLf & _
        "Frei: " & Format$(FB, "##.00 MB") & vbCrLf _
        , , "Festplattenspeicher Laufwerk """ & Root & """"
    End Function

    Diese Seite wurde bereits 5.745 mal aufgerufen.

    nach obenzurück
     
       

    Druckansicht Druckansicht Copyright ©2000-2015 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