Re: file sizes

<jackthelad5@xxxxxxxxxxx> wrote in message news:1172153029.051540.271140@xxxxxxxxxxxxxxxxxxxxxxxxxxxxxx

can anyone tell me how to count the total size of
some files in a folder using VB6.

Here's some code that will do it for you. You can count either the files in the selected folder only or you can include all files in all subfolders within that folder. In common with all such routines (including the folder "properties" in Windows Explorer) the amount of time taken to perform the calculation is very much less the second time you use it on a specific folder than it is the first time. Paste the code into a VB Form containing a Command Button. By the way, you would be well advised to hide your email address from the newsgroup (assuming it is your real email address) or you will invite lots of spam your way.

Mike

Option Explicit
' Code (by Mike Williams) to calculate the total size
' of files in a folder and also the total size occupied
' by those files on the disk.
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 sectorsPerCluster As Long, bytesPerSector As Long
Dim bytespercluster As Long, free As Long, total As Long
Dim retVal 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
' Let the user browse for a folder. Return the
' selected folder. Return an empty string if
' the user cancels.
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 findFiles(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 & "\"
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 folder
folders = folders + 1
If recurse Then
findFiles folderPath & Left$(fd.fileName, _
InStr(fd.fileName, Chr(0)) - 1), recurse
End If
End If
Else
' It is a file
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
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
If sfolder = "" Then
Caption = "No Folder Selected"
Else
GetClusterSize Left$(sfolder, InStr(sfolder, "\"))
directories = 0
folders = 0
files = 0
totalSize = 0
totalSizeOnDisk = 0
t1 = Timer
findFiles sfolder, True ' True = recursive
t2 = Timer
Dim s1 As String
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 ' get rid of any queued button clicks
Command1.Enabled = True
End Sub



.