|
|||||||
Время создания: 16.03.2019 23:43
Раздел: !Закладки - VBA - Access - msa.polarcom.ru - 16 Система
Запись: xintrea/mytetra_db_adgaver_new/master/base/1532018704fy7musi64w/text.html на raw.githubusercontent.com
|
|||||||
|
|||||||
Место на диске (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 |
|||||||
|
|||||||
|