(nobody)
8/29/2011 12:49:00 PM
"Mike Williams" <Mike@WhiskyAndCoke.com> wrote in message
news:j3fnb1$o9l$1@dont-email.me...
> . . . or perhaps Windows Properties is reporting some files and folders
> that should not have been legitimately counted, perhaps some data
> connected with your disk compression stuff. At the moment you are jumping
> to a conclusion that may or may not be correct. One of them is apparently
> wrong (or perhaps even both of them). Maybe it is something to do with
> your compressed disk? What happens if you write some VB6 code to randomly
> generate a large number of deeply nested folders and populate them with a
> large number of files of various different sizes? What do both methods
> report then? Do either of them report the exact number of files and
> folders and the exact total file size that you know your VB6 code created?
Here is the Unicode version, which also supports paths with more than
MAX_PATH length. I already fixed the issue with the folder count, and it's
reporting exactly what Windows Explorer is reporting. Here are the minor
changes I made:
- FindFirstFile and WIN32_FIND_DATA declaration.
- Making sure that the path is prefixed with "\\?\". This is not necessary
if you know that the path will not exceed MAX_PATH, but it's good to use
nevertheless. This code is near the beginning of countFiles sub.
- Copying the file name from the byte array to a String variable and
removing the Null. This code is in the next line after the "Do" loop line.
- Removed the InStr in the call to countFiles sub since the Null is already
removed.
Here is the full code:
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 _
"FindFirstFileW" (ByVal lpFileName As Long, lpFindFileData As Any) _
As Long
Private Declare Function FindNextFile Lib "kernel32" Alias _
"FindNextFileW" (ByVal hFindFile As Long, _
lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindClose Lib "kernel32" ( _
ByVal hFindFile As Long) As Long
Private Declare Function lstrlenW Lib "kernel32" ( _
ByVal psString 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
fileName(0 To MAX_PATH * 2 - 1) As Byte
strAlternate(0 To 14 * 2 - 1) As Byte
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
Private MaxSize As Long
Public Sub GetClusterSize(disk As String)
' Note: GetDiskFreeSpace API function cannot report
' sizes of disks greater than 2GB (you must instead
' use the newer GetDiskFreeSpaceEx). However, here
' we are using it only to get the cluster size, so
' it is okay.
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
Dim strFileName As String
Dim posNull As Long
If Right$(folderPath, 1) <> "\" Then
folderPath = folderPath & "\"
End If
If Left$(folderPath, 4) <> "\\?\" Then
folderPath = "\\?\" & folderPath
End If
strSearch = folderPath & "*"
hFind = FindFirstFile(ByVal StrPtr(strSearch), ByVal VarPtr(fd))
If hFind > 0 Then
Do
' Get the Unicode file name from the UDT and remove the null
strFileName = fd.fileName
posNull = InStr(strFileName, Chr(0))
strFileName = Left(strFileName, posNull - 1)
If ( _
fd.lngFileAttributes And FILE_ATTRIBUTE_DIRECTORY) = _
FILE_ATTRIBUTE_DIRECTORY Then
If strFileName = "." Or strFileName = ".." Then
' ignore these
Else
' It is a directory
folders = folders + 1
If recurse Then
countFiles folderPath & strFileName, recurse
End If
End If
Else
files = files + 1
If (fd.lngFileSizeLow And loMask) <> 0 Then
roundUp = True
Else
roundUp = False
End If
fd.lngReserved0 = fd.lngFileSizeHigh
CopyMemory fileSize, fd.lngFileSizeLow, 8
'
totalSize = totalSize + fileSize
If roundUp Then
fd.lngFileSizeLow = fd.lngFileSizeLow And hiMask
End If
CopyMemory SizeOnDisk, fd.lngFileSizeLow, 8
'
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