Место на диске (API)

По материалам: http://am.rusimport.ru/MSAccess/default.aspx

Место возвращается в любых единицах измерения (байт,Кбайт, Мбайт).Может возвращать как свободное пространство, так и весь размер диска.

'--------------------------------------------------------------------

' Module : modDiskFreeSpace

' Author : Андрей Митин

' Date : 08.04.2002

' Purpose :

'--------------------------------------------------------------------

'Описание: Место возвращается в любых единицах измерения (байт, Кбайт, Мбайт).

'Может возвращать как свободное пространство, так и весь размер диска.

'В примере в модуле mdlAPI можно посмотреть много других функций, использующих интерфейс win32API.

Option Explicit

Option Compare Database

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

'v_1.0.0 990630

Public Function DiskFreeSpace(strDiskName As String, Optional iUnit As Integer = 3, _

Optional bFree As Boolean = True) As Long

'--------------------------------------------------------------------

' bFree - True = Свободное место

' bFree - False = Всего место

'iUnit -единица измерения

' 1 - байт

' 2 - килобайт

' 3 - мегабайт (по умолчанию)

'--------------------------------------------------------------------

On Error GoTo Err_

Dim lngFreeSpace As Long

Dim lngSectorsPerCluster As Long

Dim lngBytesPerSector As Long

Dim lngNumberOfFreeClusters As Long

Dim lngFileSize As Long

Dim sDiskName As String

If Left(strDiskName, 1) = "\" Then

If Right(strDiskName, 1) = ":" Then

sDiskName = Mid(strDiskName, 1, Len(strDiskName) - 1) & "\"

ElseIf Right(strDiskName, 1) <> "\" Then

sDiskName = strDiskName & "\"

Else

sDiskName = strDiskName

End If

Else

sDiskName = Left(strDiskName, 1) & ":\"

End If

GetDiskFreeSpace sDiskName, lngSectorsPerCluster, lngBytesPerSector, lngNumberOfFreeClusters, lngFreeSpace

If Not bFree Then lngNumberOfFreeClusters = lngFreeSpace

Select Case iUnit

Case 1

lngFreeSpace = CLng(CCur(lngBytesPerSector * lngSectorsPerCluster) * lngNumberOfFreeClusters)

Case 2

lngFreeSpace = CLng(CCur(lngBytesPerSector * lngSectorsPerCluster) * lngNumberOfFreeClusters / 1024)

Case 3

lngFreeSpace = CLng(CCur(lngBytesPerSector * lngSectorsPerCluster / 1024) * lngNumberOfFreeClusters / 1024)

Case Else

lngFreeSpace = 0

End Select

DiskFreeSpace = lngFreeSpace

Ex_:

Exit Function

Err_:

Resume Ex_

Resume

End Function