TopPicLogo TopPicText

Место на диске (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


Назад ToTop
L.E. 23.11.2017
Рейтинг@Mail.ru