즐겁게 개발을...

개발보다 게임이 더 많이 올라오는 것 같은...

개발/Visual Basic 6.0

[2022.07] 재귀 호출을 이용한 폴더 크기 구하는 함수

다물칸 2022. 7. 22. 18:04
728x90

OS에서 제공하는 한 무한 하위폴더를 포함한 폴더의 크기를 구합니다.

아래 Fcount함수는 하우투뱅크에서 퍼왔으나 출처를 보면 알다시피 프랑스의 한 개발자분이 API없이 해당폴더의

파일들 사이즈를 구하는 함수입니다. 그외 다른 기능도 있죠?

아래 함수는 FCount함수를 이용해서 재귀호출을 사용해 하위폴더의 파일들 사이즈를 구하는 함수를 만들어보았습니다.

아래 두 함수를 모듈에 넣고

Ex) GetDIRSize("C:\Windows")

처럼 하시면 됩니다.

윈도우 탐색기보단 느립니다. 재귀호출 사용하는 부분이 느린건지...

 

Private Function FCount(ByVal FichiersRecherches As String, _
Optional ByVal Filtres As Integer = vbNormal + vbReadOnly + vbHidden + vbSystem, _
Optional ByVal GiveTotalSize As Integer = False, _
Optional ByVal bGiveStringOfFiles As Integer = False) As Variant
'-------------------------------------------------------------------------------
' FCount 함수' Author : Christian BAY
' Mail : swic.cb@free.fr
' Country : France
'-------------------------------------------------------------------------------
' 부탁: 이 루틴 보다 잘 만든 것이 있으면 위 메일로 보내 달라고 함
' ---------------------------------------------------------------------------------
' 리턴 값 형식: variant type
' WildCards (*?) 사용가능-파일 혹은 디렉토리
' 리턴 값이 < 0 : 에러 발생. 에러 리턴 값 Err.Number * -1
' 적용 예 :
'   파일이 있는지 테스트 :   if FCount("C:\MyPath\TEST.TXT")>0 then...
'   파일 갯수 카운트 :    lngNbOfFiles = FCount("C:\*.TXT")
'   디렉토리 있는지 테스트 :  if FCount(strPath,vbdirectory)>0 then...
'   숨김 속성 디렉토리 있는가? :  if FCount(strPath,vbDirectory + vbHidden)>0 then...
'   지정되렉토리의 총 파일 크기 :  dblTotalSize = FCount("C:\MyPath\*.*",,true)
'                      vbNormal + vbReadOnly + vbHidden + vbSystem 속성 파일 포함
'    지정디렉토리의.TXT 파일의 총 사이즈 :
'          dblTotalSize = FCount("C:\MyPath\*.TXT", vbNormal, , True)     
'   vbReadOnly + vbHidden + vbSystem 속성 파일 포함
'   폴드의 전 파일 이름 얻기 :  strMyFiles = FCount("C:\MyPath\*.*",,,true)       
' 파일 이름은 vbCr로 구분 됨
'   폴드의  .TXT 파일 이름 배열로 얻는 방법
'    aMyArray = Split(FCount("C:\MyPath\*.TXT", , , True), vbCr)
'   하위폴더는 구하지 못한웨
'---------------------------------------------------------------------------------------    
Dim NFc As Double   
Dim a As String   
Dim B As String   
Dim totalSize As Double   
Dim getPath As String   
Dim strStringOfFiles As String       
 
If GiveTotalSize = True And bGiveStringOfFiles = True Then       
' can't ask 2 <> things at the same time !        
FCount = -1        
Exit Function   
End If        
 
Do Until InStr(Len(getPath) + 1, FichiersRecherches, "\") = 0        
getPath = Left(FichiersRecherches, InStr(Len(getPath) + 1, FichiersRecherches, "\"))    
Loop        
 
If GiveTotalSize Then       
' routine doesn't give size for a directory        
If (Filtres And vbDirectory) = vbDirectory Then           
FCount = 0            
Exit Function       
End If   
End If        
 
NFc = 0    
 
On Local Error GoTo ErrFCount         
 
a = Dir(FichiersRecherches, Filtres)    
If a = "" Then GoTo FinFCount         
If GiveTotalSize Then       
NFc = CDbl(FileLen(getPath & a))    
ElseIf bGiveStringOfFiles Then       
strStringOfFiles = strStringOfFiles & IIf(strStringOfFiles > "", vbCr, "") & a    
Else       
NFc = 1    
End If   
 
Do        B = Dir        
If B = "" Then Exit Do       
If GiveTotalSize Then           
NFc = NFc + CDbl(FileLen(getPath & B))        
ElseIf bGiveStringOfFiles Then           
strStringOfFiles = strStringOfFiles & vbCr & B        
Else           
NFc = NFc + 1        
End If   
Loop    
 
FinFCount:    
If bGiveStringOfFiles Then       
FCount = strStringOfFiles    
Else       
FCount = NFc    
End If   
Exit Function    
ErrFCount:    
If GiveTotalSize Then       
NFc = 0    
ElseIf bGiveStringOfFiles Then       
strStringOfFiles = ""   
Else       
NFc = -1 * Err    
End If   
Resume FinFCount
End Function
 
Public Function GetDirSize(strFolderPath As String) As Double
On Error Resume Next   
 
Dim strFileName As String   
Dim FolderArray()  As String   
Dim FolderCount As Integer   
Dim strFilePath As String   
Dim strFileTitle As String   
Dim i As Integer   
Dim FolderPath As String        
Dim dblSubSize      As Double   
Dim dblTotalSize    As Double   
Dim sFolderPath     As String        
 
'** 루트 폴더의 파일들 크기를 구한다.    
 
FolderPath = strFolderPath    
If Right(FolderPath, 1) <> "\" Then       
FolderPath = FolderPath + "\"    
End If        
 
dblTotalSize = FCount(FolderPath & "*.*", , True)         '** 폴더를 검색해서 하위폴더 크기를 구한다.    
strFileName = Dir(FolderPath, vbNormal + vbDirectory) '디렉토리 포함 검색    
 
If strFileName = "" Then '비어있으면        
Exit Function   
Else       
FolderCount = -1 '초기값 설정        
 
Do           
If GetAttr(FolderPath & strFileName) And vbDirectory Then '폴더면                
If strFileName <> "." And strFileName <> ".." Then '내용있는 폴더면                    
FolderCount = FolderCount + 1 '배열 첨자를 더하고                    
ReDim Preserve FolderArray(FolderCount) As String '배열 재설정                    
FolderArray(FolderCount) = FolderPath & strFileName '변수에 값저장                
End If           
End If           
 
strFileName = Dir            
 
If strFileName = "" Then Exit Do       
 
Loop                
For i = 0 To FolderCount            
sFolderPath = FolderArray(i)            
If Right(sFolderPath, 1) <> "\" Then               
sFolderPath = sFolderPath + "\"            
End If                        
dblSubSize = dblSubSize + GetDirSize(sFolderPath)  '재귀호출        
Next i    
End If   
GetDirSize = dblTotalSize + dblSubSize    
 
Debug.Print FolderPath & "-->" & GetDirSize
End Function
반응형

'개발 > Visual Basic 6.0' 카테고리의 다른 글

[2022.07] Logger 클래스  (0) 2022.07.22
[2022.07] 시프트 연산  (0) 2022.07.22
[2022.07] 디빅도리2  (1) 2022.07.22
[2022.07] 프로그램 리소스 파일들 압축기법 예제소스  (0) 2022.07.22
[2022.07] Clipboard 객체  (0) 2022.07.22