15 мая 2023 года "Исходники.РУ" отмечают своё 23-летие!
Поздравляем всех причастных и неравнодушных с этим событием!
И огромное спасибо всем, кто был и остаётся с нами все эти годы!

Главная Форум Журнал Wiki DRKB Discuz!ML Помощь проекту


Как узнать размер директории


Автор: Randy Birch

Компилятор: Visual Basic

В Windows нет API функций, позволяющих получить общий объём, занимаемы указанными файлами, поэтому мы воспользуемся функциями FindFirstFile и FindNextFile. Приведённый ниже пример позволяет получить полный объём директории, а также поддиректорий. Если в примере изменить "*.*" на нужный тип файлов (например *.doc), то можно получить объём, занимаемый только ими.

Галочка "Recurse" позволяет суммировать объём поддиректорий. Таки образом, если указать в качестве пути только букву диска и убрать галочку, то будет показан только объём файлов, хранящихся в корневой директории диска.

 

Создайте новый проект с формой, содержащей четыре текстовых поля (Text1, Text2, Text3, Text4), чекбокс (Check1), список (list box - List1), кнопку (Command1) и следующий код:


Option Explicit
Private Const vbDot = 46
Private Const MAXDWORD = &HFFFFFFFF
Private Const MAX_PATH = 260
Private Const INVALID_HANDLE_VALUE = -1
Private Const FILE_ATTRIBUTE_DIRECTORY = &H10

Private Type FILETIME
   dwLowDateTime As Long
   dwHighDateTime As Long
End Type

Private Type WIN32_FIND_DATA
   dwFileAttributes As Long
   ftCreationTime As FILETIME
   ftLastAccessTime As FILETIME
   ftLastWriteTime As FILETIME
   nFileSizeHigh As Long
   nFileSizeLow As Long
   dwReserved0 As Long
   dwReserved1 As Long
   cFileName As String * MAX_PATH
   cAlternate As String * 14
End Type

Private Type FILE_PARAMS
   bRecurse          As Boolean
   nFileCount        As Long
   nFileSize         As Currency '64-битное значение
   nSearched         As Long
   sFileNameExt      As String
   sFileRoot         As String
End Type

Private Declare Function FindClose Lib "kernel32" _
  (ByVal hFindFile As Long) As Long
   
Private Declare Function FindFirstFile Lib "kernel32" _
   Alias "FindFirstFileA" _
  (ByVal lpFileName As String, _
   lpFindFileData As WIN32_FIND_DATA) As Long
   
Private Declare Function FindNextFile Lib "kernel32" _
   Alias "FindNextFileA" _
  (ByVal hFindFile As Long, _
   lpFindFileData As WIN32_FIND_DATA) As Long
   
Private Declare Function lstrlen Lib "kernel32" _
    Alias "lstrlenW" (ByVal lpString As Long) As Long

Private Declare Function GetTickCount Lib "kernel32" () As Long


Private Sub Form_Load()

   Text1.Text = "c:\windows"
   Check1.Caption = "Recurse"
   Command1.Caption = "GetDirectorySize"
   
End Sub


Private Sub Command1_Click()

   Dim tstart As Single   'переменная таймера только для этой процедуры
   Dim tend As Single     'переменная таймера только для этой процедуры
   Dim fp As FILE_PARAMS
   
   Text2.Text = ""
   Text3.Text = ""
   Text4.Text = ""
   
   With fp
      .sFileRoot = QualifyPath(Text1.Text) 'начальный путь
      .sFileNameExt = "*.*"                'нужные файлы
      .bRecurse = Check1.Value = 1         'True = рекурсией
   End With
  
   tstart = GetTickCount()
   Call GetDirectorySize(fp.sFileRoot, fp)
   tend = GetTickCount()
   
   Text2.Text = Format$(fp.nSearched, "###,###,###,##0")
   Text3.Text = Format$(fp.nFileSize, "###,###,###,##0")
   Text4.Text = FormatNumber((tend - tstart) / 1000, 2) & "  seconds"
                                    
End Sub


Private Sub GetDirectorySize(sRoot As String, fp As FILE_PARAMS)

   Dim wfd As WIN32_FIND_DATA
   Dim hFile As Long
  
   hFile = FindFirstFile(sRoot & "*.*", wfd)
  
   If hFile <> INVALID_HANDLE_VALUE Then
   
      Do
                  
         If Asc(wfd.cFileName) <> vbDot Then
            If (wfd.dwFileAttributes And vbDirectory) Then
            
               If fp.bRecurse Then
                  GetDirectorySize sRoot & TrimNull(wfd.cFileName) & "\", fp
               End If  'If fp.bRecurse
            
            Else
         
               fp.nFileCount = fp.nFileCount + 1
               fp.nFileSize = fp.nFileSize + _
                            ((wfd.nFileSizeHigh * _
                             (MAXDWORD + 1)) + _
                              wfd.nFileSizeLow)
         
            End If 'If WFD.dwFileAttributes
            
         End If  'If Asc(wfd.cFileName)
      
         fp.nSearched = fp.nSearched + 1
      
      Loop While FindNextFile(hFile, wfd)
   
   End If 'If hFile
  
   Call FindClose(hFile)

End Sub


Private Function TrimNull(startstr As String) As String

   TrimNull = Left$(startstr, lstrlen(StrPtr(startstr)))
   
End Function


Private Function QualifyPath(sPath As String) As String

   If Right$(sPath, 1) <> "\" Then
         QualifyPath = sPath & "\"
   Else: QualifyPath = sPath
   End If
      
End Function