Atlanta Custom Software Development 

 
   Search        Code/Page
 

User Login
Email

Password

 

Forgot the Password?
Services
» Web Development
» Maintenance
» Data Integration/BI
» Information Management
Programming
  Database
Automation
OS/Networking
Graphics
Links
Tools
» Regular Expr Tester
» Free Tools

GetDiskFreeBytes - Determine number of free bytes on disk
[ All Languages » VB »  Windows]

Total Hit ( 2067)

Rate this article:     Poor     Excellent 

 Submit Your Question/Comment about this article

Rating


 


Click here to copy the following block
Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal _
  lpLibFileName As String) As Long
Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, _
  ByVal lpProcName As String) As Long
Private Declare Function GetDiskFreeSpaceEx Lib "kernel32" Alias _
  "GetDiskFreeSpaceExA" (ByVal lpDirectoryName As String, _
  lpFreeBytesAvailableToCaller As Any, lpTotalNumberOfBytes As Any, _
  lpTotalNumberOfFreeBytes As Any) 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

' Return the number of free bytes available to caller, total bytes available
' to caller, and total free bytes on a disk. This function supports volumes
' larger than 2G and Windows systems that supports disk quotas, where a
' user might be prevented to use all the free space on disk.
' If disk quotes aren't in use, the 1st and 3rd argument always return
' the same values.

' On entry, driveName is the name of a drive or a directory. If running on
' Windows 95 OSR2 or later versions, you can also pass a UNC path, but in this
' case you must append a backslash, as in "\\MyServer\MyShare\". If you pass
' a null string, the current drive is used.
' On exit, the three arguments you've passed receive the desired information.

' What makes this function advanced is that it is based on the
' GetDiskFreeSpaceEx API function, which is available only on Windows 95
' OSR2, Windows 98, Windows NT4 and later release. Before calling the API
' routine, this function ensures that it is available, otherwise it
' reverts to the older GetDiskFreeSpace API function.
' Another detail that makes the implementation of this function more
' difficult is that the GetDiskFreeSpaceEx routine expects pointers to
' LARGE_INTEGER structures, which aren't supported in VB. The code below
' uses Currency values, and then scales them up by 4 decimal positions.

Sub GetDiskFreeBytes(driveName As String, FreeBytesAvailableToCaller As _
  Currency, TotalBytesAvailableToCaller As Currency, _
  TotalFreeBytes As Currency)

  Dim hModule As Long, procAddr As Long, res As Long
  
  ' first, determine whether we can call the GetDiskFreeSpaceEx function
  hModule = LoadLibrary("kernel32.Dll")
  If hModule Then
    procAddr = GetProcAddress(hModule, "GetDiskFreeSpaceExA")
    If procAddr Then
      ' we call safely call the GetDiskFreeSpaceEx
      ' Note that instead of passing LARGE_INTEGER values, we're
      ' using Currency values (8 bytes)
      res = GetDiskFreeSpaceEx(driveName, FreeBytesAvailableToCaller, _
        TotalBytesAvailableToCaller, TotalFreeBytes)
      ' decrement Dll's usage counter (not really necessary)
      FreeLibrary hModule
      
      If res = 0 Then
        ' a null result means error (probably invalid drive)
        Err.Raise 5, , Err.LastDllError
      Else
        ' we must scale up the Currency by a factor of 10,000
        FreeBytesAvailableToCaller = FreeBytesAvailableToCaller * 10000
        TotalBytesAvailableToCaller = TotalBytesAvailableToCaller * _
          10000
        TotalFreeBytes = TotalFreeBytes * 10000
        Exit Sub
      End If
    End If
    ' decrement Dll's usage counter (not really necessary)
    FreeLibrary hModule
  End If
  
  ' if we get here, GetDiskFreeSpaceEx isn't available or raised an error
  Dim lpSectorsPerCluster As Long
  Dim lpBytesPerSector As Long
  Dim lpNumberOfFreeClusters As Long
  Dim lpTotalNumberOfClusters As Long
  
  res = GetDiskFreeSpace(driveName, lpSectorsPerCluster, lpBytesPerSector, _
    lpNumberOfFreeClusters, lpTotalNumberOfClusters)
  If res = 0 Then
    ' a null result means error (probably invalid drive)
    Err.Raise 5, , Err.LastDllError
  Else
    ' return result through parameters
    FreeBytesAvailableToCaller = lpNumberOfFreeClusters * _
      lpSectorsPerCluster * lpBytesPerSector
    TotalBytesAvailableToCaller = lpTotalNumberOfClusters * _
      lpSectorsPerCluster * lpBytesPerSector
    ' without quotas, this value is the same as FreeBytesAvailableToCaller
    TotalFreeBytes = FreeBytesAvailableToCaller
  End If
End Sub


Submitted By : Nayan Patel  (Member Since : 5/26/2004 12:23:06 PM)

Job Description : He is the moderator of this site and currently working as an independent consultant. He works with VB.net/ASP.net, SQL Server and other MS technologies. He is MCSD.net, MCDBA and MCSE. In his free time he likes to watch funny movies and doing oil painting.
View all (893) submissions by this author  (Birth Date : 7/14/1981 )


Home   |  Comment   |  Contact Us   |  Privacy Policy   |  Terms & Conditions   |  BlogsZappySys

© 2008 BinaryWorld LLC. All rights reserved.