Re: Size On Disk

Tech-Archive recommends: Repair Windows Errors & Optimize Windows Performance

"Lorin" <lorinm@xxxxxxxxxxx> wrote in message news:953BDCEE-8BCE-46C6-81F8-D233914A851A@xxxxxxxxxxxxxxxx

How do I get a file's "size on disk"?
(not file size)

Here is some code I wrote a while ago to count the files and folders in any selected drive or folder and report the number of files and folders found together with their total file size and their total size on disk. It properly takes account of the disk cluster size and it also properly deals with files over 2GB and over 4 GB. It operates at the same speed as does the Windows "desktop" function itself (when you right click a folder and select properties) so, just like the standard Windows stuff, it takes a lot longer the first time you run it on a very large drive or folder than it does on subsequent runs.

I haven't got much spare time at the moment so it is easier for me to just post the lot rather than extract just the cluster size stuff for you. You should be easily able to get what you want from this code. Paste the following code into a Form containing one Command button and run the code and click the button

Mike

Option Explicit
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
Private Declare Sub CopyMemory Lib "kernel32" _
Alias "RtlMoveMemory" (ByRef Destination As Any, _
Source As Any, ByVal Length As Long)
Private Declare Function SHBrowseForFolder _
Lib "shell32.dll" (bBrowse As BrowseInfo) As Long
Private Declare Function SHGetPathFromIDList _
Lib "shell32.dll" (ByVal lItem As Long, _
ByVal sDir As String) 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 FindClose Lib "kernel32" _
(ByVal hFindFile As Long) As Long
Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Private Const MAX_PATH = 260
Private Type WIN32_FIND_DATA
lngFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
lngFileSizeHigh As Long
lngFileSizeLow As Long
lngReserved0 As Long
lngReserved1 As Long
fileName As String * MAX_PATH
strAlternate As String * 14
End Type
Private Type BrowseInfo
hWndOwner As Long
pidlRoot As Long
sDisplayName As String
sTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
Private Const FILE_ATTRIBUTE_ARCHIVE = &H20
Private Const FILE_ATTRIBUTE_COMPRESSED = &H800
Private Const FILE_ATTRIBUTE_DIRECTORY = &H10
Private Const FILE_ATTRIBUTE_HIDDEN = &H2
Private Const FILE_ATTRIBUTE_NORMAL = &H80
Private Const FILE_ATTRIBUTE_READONLY = &H1
Private Const FILE_ATTRIBUTE_SYSTEM = &H4
Private Const FILE_ATTRIBUTE_TEMPORARY = &H100
Private Const BIF_RETURNONLYFSDIRS As Long = &H1
Private directories As Long
Private folders As Long
Private files As Long
Private totalSize As Currency
Private totalSizeOnDisk As Currency
Private loMask As Long
Private hiMask As Long
Private clusterSize As Currency

Public Sub GetClusterSize(disk As String)
Dim s1 As String, sectorsPerCluster As Long
Dim bytesPerSector As Long, free As Long
Dim total As Long, retVal As Long
Dim bytesperCluster As Long
retVal = GetDiskFreeSpace _
(disk, sectorsPerCluster, bytesPerSector, free, total)
bytesperCluster = sectorsPerCluster * bytesPerSector
loMask = bytesperCluster - 1
hiMask = &HFFFFFFFF - loMask
clusterSize = CCur(bytesperCluster / 10000&)
End Sub

Private Function Browse_Folder() As String
Dim bInf As BrowseInfo
Dim lItem As Long
Dim sDirName As String
Dim hwnd As Long
bInf.hWndOwner = Me.hwnd
bInf.sDisplayName = Space$(MAX_PATH)
bInf.sTitle = "Select Folder"
bInf.ulFlags = BIF_RETURNONLYFSDIRS
lItem = SHBrowseForFolder(bInf)
If lItem Then
sDirName = Space$(MAX_PATH)
If SHGetPathFromIDList(lItem, sDirName) Then
Browse_Folder = Left(sDirName, InStr(sDirName, _
Chr$(0)) - 1)
Else
Browse_Folder = ""
End If
End If
End Function

Private Sub countFiles(folderPath As String, _
recurse As Boolean)
Dim fd As WIN32_FIND_DATA
Dim hFind As Long
Dim strFile As String
Dim strSearch As String
Dim fileSize As Currency
Dim SizeOnDisk As Currency
Dim roundUp As Boolean
If Right$(folderPath, 1) <> "\" Then
folderPath = folderPath & "\"
End If
strSearch = folderPath & "*"
hFind = FindFirstFile(strSearch, fd)
If hFind > 0 Then
Do
If (fd.lngFileAttributes And FILE_ATTRIBUTE_DIRECTORY) _
= FILE_ATTRIBUTE_DIRECTORY Then
If Left$(fd.fileName, 1) = "." Then
' ignore these
Else
' It is a directory
folders = folders + 1
If recurse Then
countFiles folderPath & Left$(fd.fileName, _
InStr(fd.fileName, Chr(0)) - 1), recurse
End If
End If
Else
files = files + 1
If (fd.lngFileSizeLow And loMask) <> 0 Then
roundUp = True
Else
roundUp = False
End If
CopyMemory fileSize, _
fd.ftLastWriteTime.dwHighDateTime, 8
CopyMemory fileSize, fd.lngFileSizeLow, 4
totalSize = totalSize + fileSize
If roundUp Then
fd.lngFileSizeLow = fd.lngFileSizeLow _
And hiMask
End If
CopyMemory SizeOnDisk, _
fd.ftLastWriteTime.dwHighDateTime, 8
CopyMemory SizeOnDisk, fd.lngFileSizeLow, 4
If roundUp Then '
totalSizeOnDisk = totalSizeOnDisk + _
SizeOnDisk + clusterSize
Else
totalSizeOnDisk = totalSizeOnDisk + _
SizeOnDisk
End If
End If
Loop While CBool(FindNextFile(hFind, fd))
Call FindClose(hFind)
End If
End Sub

Private Sub Command1_Click()
Dim sfolder As String, s1 As String
Dim t1 As Single, t2 As Single
Dim Sectors As Long, Bytes As Long
Dim FreeC As Long, TotalC As Long
Dim total As Long, Freeb As Long
Command1.Enabled = False
sfolder = Browse_Folder
Me.Refresh: DoEvents
If sfolder = "" Then
Caption = "No Folder Selected"
Else
GetClusterSize Left$(sfolder, InStr(sfolder, "\"))
directories = 0
folders = 0
files = 0
totalSize = 0
totalSizeOnDisk = 0
s1 = Caption: Caption = "Please wait . . ."
t1 = Timer
countFiles sfolder, True
t2 = Timer
Caption = s1
s1 = Format(files, "###,###,##0") & " files, "
s1 = s1 & Format(folders, "###,###,##0") & " folders."
s1 = s1 & vbCrLf & _
"Total file size = " & _
Format((totalSize * 10000&), "###,###,###,##0")
s1 = s1 & vbCrLf & _
"Total size on disk = " & _
Format((totalSizeOnDisk * 10000&), "###,###,###,##0")
s1 = s1 & vbCrLf & _
"Time taken = " & Format(t2 - t1, "###.00") & " seconds."
MsgBox s1
End If
DoEvents
Command1.Enabled = True
End Sub






.

Relevant Pages

  • Re: Incompatibility between Access 2003 and Access 2002
    ... Private WithEvents mlst As ListBox ... Private mot As ObjectType ... Public DisplayField As String ... Dim prm As DAO.Parameter ...
    (microsoft.public.access.modulesdaovba)
  • Re: FileSystemWatcher advice required please
    ... Private ArchiveImport As String ... Private FilesToProcess As ProcessFiles ... Public Sub Main ... Dim NoVersion As New Collection ...
    (microsoft.public.dotnet.framework)
  • Re: Is there a way to prevent a RichTextBox from scrolling?
    ... Private _isRegex As Boolean ... Public Sub New(ByVal thispattern As String, ... Dim entry As tDict ...
    (microsoft.public.dotnet.framework.windowsforms.controls)
  • MAPI Emails from Access
    ... I realize this code is quite long, but could someone take a look at the sub ... Private Const mcERR_DOH = vbObjectError + 10000 ... Private mstStatus As String ... Dim db As Database, rs As Recordset ...
    (microsoft.public.access.formscoding)
  • Re: vb6 print dialog problem
    ... Private Const HWND_BROADCAST = &HFFFF ... dmDeviceName As String * CCHDEVICENAME ... Private Declare Function WriteProfileString _ ... Dim sTemp As String * 512, ...
    (comp.lang.basic.visual.misc)