Atlanta Custom Software Development 

 
   Search        Code/Page
 

User Login
Email

Password

 

Forgot the Password?
Services
» Web Development
» Maintenance
» Data Integration/BI
» Information Management
Programming
  Database
Automation
OS/Networking
Graphics
Links
Tools
» Regular Expr Tester
» Free Tools


Click here to copy the following block
Option Explicit

'API constants
Private Const MAX_PATH = 260
Private Const INVALID_HANDLE_VALUE = -1
Private Const FILE_ATTRIBUTE_DIRECTORY = &H10

'API types
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

'API function calls
Private Declare Function FindFirstFile Lib "kernel32.dll" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindNextFile Lib "kernel32.dll" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindClose Lib "kernel32.dll" (ByVal hFindFile As Long) As Long

'Truncate a string returned by API calls to the first null char Chr(0)
Private Function APItoString(s As String) As String
  Dim x As Integer

  x = InStr(s, Chr(0))
  If x <> 0 Then
    APItoString = Left(s, x - 1)
  Else
    APItoString = s
  End If
End Function

Private Function DirSpace(sPath As String, Optional indent As Integer = 1) As Long
  Dim f As WIN32_FIND_DATA
  Dim hFile As Long
  Dim hSize As Long

  Dim foldersize As Long
  Dim DirIdx As Long
  Dim DirIdxText As String
  DirSpace = 0

  DirIdxText = "<" & sPath & ">"
  If indent = 1 Then List1.AddItem DirIdxText

  'Add the slash to the search path
  If Right(sPath, 1) <> "\" Then sPath = sPath & "\"

  'start a file enum in the specified path
  hFile = FindFirstFile(sPath & "*.*", f)
  If hFile = INVALID_HANDLE_VALUE Then Exit Function
  
  '//////////////////////////////////////////////////////////////////////////
  '//Process for the first file/folder in specified path. In most cases except
  '//root (i.e. A: C: etc) it will be "." or ".." so this whole block will be skipped
  '//////////////////////////////////////////////////////////////////////////
  If (f.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) = 0 Then
    'Count file size
    DirSpace = DirSpace + f.nFileSizeLow
    List1.AddItem Space(indent + 4) & APItoString(f.cFileName) & " [" & f.nFileSizeLow & "]"
  ElseIf Left(f.cFileName, 1) <> "." Then
    'call the DirSpace with subdirectory
    List1.AddItem Space(indent + 4) & "[+] " & APItoString(f.cFileName)
    DirIdx = List1.NewIndex  '//Store this index so when we done with files and folder of this dir we can update size
    indent = indent + 4
    foldersize = DirSpace(sPath & APItoString(f.cFileName), indent)
    DirSpace = DirSpace + foldersize
    List1.List(DirIdx) = List1.List(DirIdx) & " [" & foldersize & "]"
    indent = indent - 4
  End If
  
  '//////////////////////////////////////////////////////////////////////////
  'Enumerate all other files
  '//////////////////////////////////////////////////////////////////////////
  Do While FindNextFile(hFile, f)
    If (f.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) = 0 Then
      'Count file size
      DirSpace = DirSpace + f.nFileSizeLow
      List1.AddItem Space(indent + 4) & APItoString(f.cFileName) & " [" & f.nFileSizeLow & "]"
    ElseIf Left(f.cFileName, 1) <> "." Then
      'call the DirSpace with subdirectory
      List1.AddItem Space(indent + 4) & "[+] " & APItoString(f.cFileName)
      DirIdx = List1.NewIndex  '//Store this index so when we done with files and folder of this dir we can update size
      indent = indent + 4
      foldersize = DirSpace(sPath & APItoString(f.cFileName), indent)
      DirSpace = DirSpace + foldersize
      List1.List(DirIdx) = List1.List(DirIdx) & " [" & foldersize & "]"
      indent = indent - 4
    End If
  Loop

  'Close the file search
  FindClose (hFile)
End Function

Private Sub Command1_Click()
  Dim totalSize As Long, sPath As String
  sPath = Environ$("windir")
  'sPath = "C:\"

  totalSize = DirSpace(sPath)
  MsgBox totalSize & " bytes in " & sPath
  List1.List(0) = List1.List(0) & " [" & totalSize & "]"
End Sub


Submitted By : Nayan Patel  (Member Since : 5/26/2004 12:23:06 PM)

Job Description : He is the moderator of this site and currently working as an independent consultant. He works with VB.net/ASP.net, SQL Server and other MS technologies. He is MCSD.net, MCDBA and MCSE. In his free time he likes to watch funny movies and doing oil painting.
View all (893) submissions by this author  (Birth Date : 7/14/1981 )


Home   |  Comment   |  Contact Us   |  Privacy Policy   |  Terms & Conditions   |  BlogsZappySys

© 2008 BinaryWorld LLC. All rights reserved.