Code:
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' Relatively fast directory scanner. Calculates sub-folders, files
' and sizes. Here test with Windows folder - change to whatever..
' Same info is given in IE Exploder when right-clicking on a folder
' and selecting "properties". Just thought it was fun to do it and
' since it may help someone, I post the result here. [img]http://www.powerbasic.com/support/forums/smile.gif[/img]
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
#COMPILE EXE
#INCLUDE "WIN32API.INC"
GLOBAL DirCount AS LONG, FileCount AS LONG, hDlg AS LONG, Abort AS LONG, clusterSize AS LONG
GLOBAL tSize AS QUAD, aSize AS QUAD
TYPE ExtGetDskFreSpcStruc
ExtFree_Size AS WORD
ExtFree_Level AS WORD
ExtFree_SectorsPerCluster AS DWORD
ExtFree_BytesPerSector AS DWORD
ExtFree_AvailableClusters AS DWORD
ExtFree_TotalClusters AS DWORD
ExtFree_AvailablePhysSectors AS DWORD
ExtFree_TotalPhysSectors AS DWORD
ExtFree_AvailableAllocationUnits AS DWORD
ExtFree_TotalAllocationUnits AS DWORD
ExtFree_Rsvd(2) AS DWORD
END TYPE
DECLARE CALLBACK FUNCTION DlgProc() AS LONG
DECLARE FUNCTION GetClusterSize(zDrive AS ASCIIZ * 4) AS LONG
DECLARE FUNCTION IsOSR2() AS LONG
DECLARE SUB GetFolders(path AS ASCIIZ)
DECLARE SUB NewEvents()
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' Create dialog and controls, etc
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
FUNCTION PBMAIN () AS LONG
DIALOG NEW 0, "Folder info",,, 128, 22, %WS_CAPTION OR %WS_SYSMENU, 0 TO hDlg
CONTROL ADD BUTTON, hDlg, 10, "&Get info", 4, 4, 60, 14, %WS_TABSTOP
CONTROL ADD BUTTON, hDlg, 11, "&Close", 64, 4, 60, 14, %WS_TABSTOP
DIALOG SHOW MODAL hDlg CALL DlgProc
END FUNCTION
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' Main callback
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
CALLBACK FUNCTION DlgProc() AS LONG
IF CBMSG = %WM_COMMAND THEN
IF CBCTL = 10 THEN
LOCAL zPath as ASCIIZ * %MAX_PATH, t AS SINGLE
DIALOG DOEVENTS
MOUSEPTR 11
DirCount = 0 : FileCount = 0 : tSize = 0 : aSize = 0 : t = TIMER
'zPath = "c:\" 'just testing..
CALL GetWindowsDirectory(zPath, %MAX_PATH) 'test with Windows folder
if Right$(zPath, 1) <> "\" then zPath = zPath + "\" 'make sure it ends with \
clusterSize = GetClusterSize(LEFT$(zPath, 3)) 'get cluster size
CALL GetFolders(zPath) 'scan folder and collect data
MOUSEPTR 1
MSGBOX "Took: " + STR$(TIMER - t) + " sec." + $CRLF + $CRLF + _
"Cluster size: " + FORMAT$(clusterSize, "#,###") + " bytes" + $CRLF + _
"Folder: " + zPath + $CRLF + $CRLF + _
STR$(DirCount) + " sub-folders" + $CRLF + _
STR$(FileCount) + " files" + $CRLF + _
FORMAT$(tSize, "###,###,###") + " bytes (" + _
FORMAT$(tSize/(2^20), "0.00") + " MB) actual size" + $CRLF + _
FORMAT$(aSize, "###,###,###") + " bytes (" + _
FORMAT$(aSize/(2^20), "0.00") + " MB) used on drive", _
%MB_ICONINFORMATION, "Folder info"
ELSEIF CBCTL = 11 THEN
DIALOG END CBHNDL
END IF
END IF
END FUNCTION
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' Recursive dir/file scanner
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
SUB GetFolders(path AS ASCIIZ)
LOCAL hSearch AS LONG ' Search Handle
LOCAL tc AS LONG
LOCAL tmpSize AS QUAD
LOCAL WFD AS WIN32_FIND_DATA
hSearch = FindFirstFile(path & "*", WFD) 'is there anything in given folder?
IF hSearch <> %INVALID_HANDLE_VALUE THEN 'if it was,
DO
IF tc = 20 THEN 'allow Windows to breathe now and then..
NewEvents
tc = -1
END IF
INCR tc
IF (WFD.dwFileAttributes AND 16) THEN 'FOLDERS (if directory bit (16) is set)
IF ASC(WFD.cFileName) <> 46 THEN 'not "." or "..", etc.
INCR DirCount 'we have a directory - increase counter
CALL GetFolders(path & WFD.cFileName & "\") 'recursive call - no problema, each
END IF 'nested call gets its own stack space..
ELSE 'FILES
tmpSize = WFD.nFileSizeHigh * (%MAXDWORD + 1) + WFD.nFileSizeLow 'proper way to calc. size
tSize = tSize + tmpSize 'add up for total size
IF tmpSize MOD clusterSize THEN 'calc. "real" size
aSize = aSize + ((tmpSize \ clusterSize) + 1) * clusterSize '(vs. cluster size)
ELSE
aSize = aSize + tmpSize 'a few may equal cluster size..
END IF
INCR FileCount
END IF
LOOP WHILE FindNextFile(hSearch, WFD)
CALL FindClose(hSearch) 'must remember to close search handle
END IF
END SUB
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' Custom-built DoEvents..
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
SUB NewEvents()
LOCAL Msg AS tagMsg
IF PeekMessage(Msg, hDlg, 0, 0, %PM_REMOVE) THEN
TranslateMessage Msg
DispatchMessage Msg
END IF
END SUB
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' Function that returns a given HDD's cluster size.
' This seems to be the way MS has made it "easier" for us to do what
' a few simple Interrupt calls used to be able to do in the past. Sigh!
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
FUNCTION GetClusterSize(zDrive AS ASCIIZ * 4) AS LONG
IF IsOSR2 THEN
LOCAL hDevice AS LONG
LOCAL Regs AS DIOC_REGISTERS
LOCAL STC AS ExtGetDskFreSpcStruc
LOCAL bResult AS LONG
LOCAL cb AS LONG
STC.ExtFree_Level = 0
hDevice = CreateFile("\\.\vwin32", 0, 0, BYVAL %NULL, 0, _
%FILE_FLAG_DELETE_ON_CLOSE, %NULL)
Regs.regEDI = VARPTR(STC)
Regs.regECX = SIZEOF(STC)
Regs.regEDX = VARPTR(zDrive)
Regs.regEAX = &H7303
Regs.regFlags = 1
bResult = DeviceIoControl(hDevice, %VWIN32_DIOC_DOS_DRIVEINFO, _
Regs, SIZEOF(Regs), Regs, SIZEOF(Regs), cb, BYVAL %NULL)
CloseHandle hDevice
FUNCTION = STC.ExtFree_SectorsPerCluster * STC.ExtFree_BytesPerSector
ELSE
LOCAL lpSectorsPerCluster AS DWORD, lpBytesPerSector AS DWORD, _
lpNumberOfFreeClusters AS DWORD, lpTotalNumberOfClusters AS DWORD
CALL GetDiskFreeSpace(zDrive, BYVAL VARPTR(lpSectorsPerCluster), _
BYVAL VARPTR(lpBytesPerSector), _
BYVAL VARPTR(lpNumberOfFreeClusters), _
BYVAL VARPTR(lpTotalNumberOfClusters))
FUNCTION = lpSectorsPerCluster * lpBytesPerSector
END IF
END FUNCTION
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' Function that determines if it is an ORS2 system or not
' (First release of Win95, or Win95 + ORS2/Win98/2000, etc.)
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
FUNCTION IsOSR2() AS LONG
LOCAL os AS OSVERSIONINFO
os.dwOSVersionInfoSize = SIZEOF(os)
CALL GetVersionEx(BYVAL VARPTR(os))
IF os.dwPlatformId = %VER_PLATFORM_WIN32_WINDOWS THEN
IF LOWRD(os.dwBuildNumber) > 1000 THEN ' if it is OSR2 OR later then
FUNCTION = %TRUE ' return true
END IF
END IF
END FUNCTION
------------------
[This message has been edited by Borje Hagsten (edited June 30, 2001).]