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