vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
NEU! sevCoolbar 2.0 - Professionelle Toolbars im modernen Design!  
 vb@rchiv Quick-Search: Suche startenErweiterte Suche starten   RSS-Feeds  | Newsletter  | Impressum  | vb@rchiv CD Vol.6  | Shop Copyright ©2000-2015
 
zurück
Rubrik: Dateisystem15.03.02
GetDiskFreeSpaceEx-Funktion

Diese Funktion ermittelt den gesamten und den freien Speicherplatz eines Laufwerks.

Betriebssystem:  Win95, Win98, WinNT 4.0, Win2000, WinMEViews:  5.623 

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 GetDiskFreeSpaceEx Lib "kernel32.dll" _
      Alias "GetDiskFreeSpaceExA" ( _
      ByVal lpDirectoryName As String, _
      lpFreeBytesAvailableToCaller As ULARGE_INTEGER, _
      lpTotalNumberOfBytes As ULARGE_INTEGER, _
      lpTotalNumberOfFreeBytes As ULARGE_INTEGER) As Long


    Beschreibung:

    Diese Funktion ermittelt den gesamten und den freien Speicherplatz eines Laufwerks.


    Parameter:

    lpDirectoryNameErwartet einen existierenden Pfad eines Ordners oder eines Laufwerks als String.
    lpFreeBytesAvailableToCallerErwartet eine ULARGE_INTEGER-Strukur, die gefüllt wird mit demfreien Speicherplatz die dem Programm, das die Funktion aufruft, zur Verfügung steht. Um die Anzahl der Bytes zu ermittelnkopieren Sie die Struktur mittels der MoveMemor-Funktion (CopyMemory) in eine "Currency Variable" und multiplizierenSie den Wert dann mit "10.000".
    lpTotalNumberOfBytesErwartet eine ULARGE_INTEGER-Strukur, die gefüllt wird mit demgesamten Speicherplatz des Laufwerks. Um die Anzahl der Bytes zu ermittelnkopieren Sie die Struktur mittels der MoveMemor-Funktion (CopyMemory) in eine "Currency Variable" und multiplizierenSie den Wert dann mit "10.000".
    lpTotalNumberOfFreeBytesErwartet eine ULARGE_INTEGER-Strukur, die gefüllt wird mit demfreien Speicherplatz des Laufwerks. Um die Anzahl der Bytes zu ermitteln kopierenSie die Struktur mittels der MoveMemor-Funktion (CopyMemory) in eine "Currency Variable" und multiplizierenSie den Wert dann mit "10.000".


    Rückgabewert:

    Ist die Funktion erfolgreich, so ist ein Wert "ungleich 0" die Rückgabe, andernfalls wird "0" zurückgegeben. Für erweiterte Fehlerinformationen rufenSie 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, OS As OSVERSIONINFO, InputRet As String, 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("Bitteg geben sie einen Laufwerksbuchstaben ein (" &  _
      Buffer & ").", "Speicher Information ermitteln", "C:\")
      If InputRet = "" Or Len(InputRet) < 3 Then
        MsgBox "Ungültige eingabe, Bitte geben sie nur Laufwerksbuchstaben,  _
        Doppelpunkt und Backslash ein"
        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 Funktion aufrufen
      With OS
        Select Case .dwPlatformId
        Case VER_PLATFORM_WIN32_WINDOWS
          If InStr(1, OS.szCSDVersion, "B") << 0 Or .dwMinorVersion < 0 Then  _
          ' größer als Windows 95 OSR2
            Call GetNewFreespace(InputRet)
          Else
            Call GetOldFreespace(InputRet)
          End If
        Case VER_PLATFORM_WIN32_NT
          If .dwMajorVersion <= 4 Then ' größer als Windows NT 3.x
            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
    ' benutzt die 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-Speicherauslastung 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
    ' benutzt die neue Version von GetDiskFreespace
    Private Function GetNewFreespace(ByVal Root As String)
      Dim Retval As Long
      Dim CBytes As ULARGE_INTEGER, TBytes As ULARGE_INTEGER, FBytes As ULARGE_INTEGER 
      Dim CB  As Currency, TB As Currency, FB As Currency, 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.623 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