フォルダのサイズを取得したい

WindowsXP+VB6.0を使用して、特定フォルダ内のサイズを取得したいのです。FileSystemObjectのFolderオブジェクトのSizeプロパティでは
特定フォルダのプロパティのサイズの値となってしまいます。
取得したいのは「ディスク上のサイズ」の値です。

宜しくお願い致します。

No.6 回答者： Starfish_goo 回答日時： 2008/09/27 23:11

動作確認用に入れた下記処理が残っていました。

削除しといてください。

List1.AddItem CStr(RoundUp(MergeDWORD(lngFileSizeHigh, lngFileSizeLow), lngClusterSize)) & " " & strFolderName & "\" & fil.Name

No.5 回答者： Starfish_goo 回答日時： 2008/09/27 23:07

ちょっとサンプルを作ってみました。

実際に使うには、いろんな環境で確認してから使ってください。

　使用方法は、getFolderSize("c:\temp")のようにパス名を指定して関数を呼んでください。結果は、２GB以上でもOKなようにCurrency型で返ります。

　尚、WindowsのAPIの定義は、APIビューワからコピーしてください。

' 指定したフォルダのディスク上のサイズを求める
Function getFolderSize(strFolderName As String) As Currency
Dim udtVersionInfo As OSVERSIONINFO ' OSのバージョン取得用
Dim fso As FileSystemObject ' FileSystemObject のハンドル
Dim fldr As Folder '　フォルダオブジェクトのハンドル
Dim sfldr As Folder ' サブフォルダのオブジェクトのハンドル
Dim fil As File ' ファイルオブジェクトのハンドル
Dim curSum As Currency ' ファイルサイズの合計
Dim lngFileSizeHigh As Long ' ファイルサイズの上位 DWORD
Dim lngFileSizeLow As Long ' ファイルサイズの下位 DWORD
Dim lngReturnValue As Long ' 戻り値
Dim lngSectorsPerCluster As Long ' セクタ数／クラスタ
Dim lngBytesPerSector As Long ' バイト数／セクタ
Dim lngNumberOfFreeClusters As Long ' 空きクラスタ数
Dim lngTotalNumberOfClusters As Long ' 全クラスタ数
Dim lngClusterSize As Long ' クラスタサイズ

' 合計をクリア
curSum = 0

' OSのプラットフォームを調べる
udtVersionInfo.dwOSVersionInfoSize = Len(udtVersionInfo)
lngReturnValue = GetVersionEx(udtVersionInfo)

' ドライブのクラスタサイズを調べる
lngReturnValue = GetDiskFreeSpace(Left(strFolderName, 3), lngSectorsPerCluster, lngBytesPerSector, lngNumberOfFreeClusters, lngTotalNumberOfClusters)
lngClusterSize = lngSectorsPerCluster * lngBytesPerSector

' FileSystemObject オブジェクトの作成
Set fso = New FileSystemObject
' フォルダオブジェクトのハンドルを取得
Set fldr = fso.GetFolder(strFolderName)

' サブフォルダを列挙し、再帰的に呼び出す
For Each sfldr In fldr.SubFolders
curSum = curSum + getFolderSize(sfldr.Path)
Next sfldr

' ファイルを列挙し、ディスク上のファイルサイズを求める
For Each fil In fldr.Files
If udtVersionInfo.dwPlatformId = "1" Then ' 95系OS
curSum = curSum + RoundUp(fil.Size, lngClusterSize)
Else
If Right(strFolderName, 1) = "\" Then
lngFileSizeLow = GetCompressedFileSize(strFolderName & fil.Name, lngFileSizeHigh)
Else
lngFileSizeLow = GetCompressedFileSize(strFolderName & "\" & fil.Name, lngFileSizeHigh)
End If
curSum = curSum + RoundUp(MergeDWORD(lngFileSizeHigh, lngFileSizeLow), lngClusterSize)
List1.AddItem CStr(RoundUp(MergeDWORD(lngFileSizeHigh, lngFileSizeLow), lngClusterSize)) & " " & strFolderName & "\" & fil.Name
End If
Next fil

' オブジェクトの解放
Set fil = Nothing
Set sfldr = Nothing
Set fldr = Nothing
Set fso = Nothing

' 合計を戻り値にセット
getFolderSize = curSum

End Function

' 2つのDWORDに分割された値をCurrency型に変換
Function MergeDWORD(lngFileSizeHigh As Long, lngFileSizeLow As Long) As Currency

If (lngFileSizeLow And &H80000000) = &H80000000 Then
MergeDWORD = CCur(lngFileSizeHigh) * 4294967296@ _
+ 2147483648@ + CCur(lngFileSizeLow)
Else
MergeDWORD = CCur(lngFileSizeHigh) * 4294967296@ _
+ CCur(lngFileSizeLow)
End If

End Function

' クラスタサイズの倍数に切り上げる
Function RoundUp(curFileSize As Currency, lngClusterSize As Long) As Currency
Dim curMod As Currency ' 余り

curMod = curFileSize Mod lngClusterSize
If curMod <> 0 Then
RoundUp = curFileSize + (lngClusterSize - curMod)
Else
RoundUp = curFileSize
End If

End Function

GetDiskFreeSpace関数について
・Windows 95（OSR2以前）では、正しい値を返しません。
・将来的に使えなくなる場合があります。（Vistaは、OK）
詳しくは、下記を参照
http://msdn.microsoft.com/ja-jp/library/cc429305 …

GetCompressedFileSize関数について
・ファイルを圧縮している場合は、GetCompressedFileSize関数を使う必要があります。
・ファイルサイズがクラスタサイズより小さいと、もとのファイルサイズのままなのでクラスタサイズに切り上げる処理を入れてます。
・95系のOSではサポートしていないので、バージョンのチェックを入れています。

No.4 回答者： argument 回答日時： 2008/09/23 21:52

こんばんわ　takao0429　さん

はい。まぁそれは良いでしょう。実は貴方のために苦心してサンプルソースを考えました。
・・・。すいません前言をやっぱり訂正します。私の興味本意と前回ちょっと適当にクラスタ算出がうまくいかなかったものがなんだか自分に負けた気がしたので遊びで少しロジックを変更して遊んでいたのです。
そうそう貴方はFileSystemObjectを扱えるんでしたね。なので遊びでできたもののうちFileSystemObjectを使って算出するソース張りましょう。あぁ大切な事を言うのを忘れていました。
今からはるソースはVBのソースではなくVBSのソースです。なぜって？
テキストエディタなら何処にでもあるのでいい暇つぶしができるからです。
今から貼るソースをテキストエディタを開いて「test.vbs」と名前をつけて保存してください。
"c:\work"の部分は貴方の好きなフォルダを指定してください。
clustersize は標準値です。貴方のPCのクラスタサイズを私は知りません。

[test.vbs]



treeroot = "c:\work": patharray = Array(treeroot): clustersize = 4096: Set fso = CreateObject("Scripting.FileSystemObject")
For Each fl In fso.GetFolder(treeroot).Files
If fl.Size Mod clustersize Then diskfoldersize = diskfoldersize + (Fix(fl.Size / clustersize) * clustersize + clustersize) Else diskfoldersize = diskfoldersize + fl.Size
Next
Do While 1
temp = "": ReDim patharray2(UBound(patharray)): For i = 0 To UBound(patharray)
Set gf = fso.GetFolder(patharray(i)): fn = "": For Each fl In gf.subfolders: fn = fn & fl.Name & "\": Next: If InStr(fn, "\") > 0 Then patharray2(i) = Split(Left(fn, Len(fn) - 1), "\") Else patharray2(i) = Array("")
For j = 0 To UBound(patharray2(i))
If patharray2(i)(j) = "" Then Exit For
temp = temp & patharray(i) & "\" & patharray2(i)(j) & "/": For Each fl In fso.GetFolder(patharray(i) & "\" & patharray2(i)(j)).Files
If fl.Size Mod clustersize Then diskfoldersize = diskfoldersize + (Fix(fl.Size / clustersize) * clustersize + clustersize) Else diskfoldersize = diskfoldersize + fl.Size
Next: Next: Next: If temp = "" Then Exit Do Else patharray = Split(Left(temp, Len(temp) - 1), "/")
Loop
MsgBox diskfoldersize





さてどうでしょうか？実行してみましたか？
そのフォルダを右クリックしてディスク上のサイズと比較してください。同じ値になっている事でしょう。
オーバーフローした？ならきっと2GBを超えるフォルダを指定したんでしょうね。
あぁ…それにしても見づらい。何が書いてあるかわかりません。
貴方の為に書いたとやっぱり言えませんね。最初に言いましたがこれは遊びでできたものです。これは「FileSystemObjectを使ってもディスク上のサイズを取得できます」というためのサンプルでありそれ以上の価値はありません。もちろん貴方がこれを改変してVBソースに直してもよいでしょう(私は気にしません)。
ただ遊びじゃないのならsubをつくりGetFolderオブジェクトを渡すような再帰的処理にしたほうが綺麗なソースになりますね(CPUは食うかもしれませんが)。

1番さんの補足となりますが私が覚えている限りGetDiskFreeSpaceは2GBを超えると信用性のある値が返らなかったと思いますが…。
まぁ恐らくFAT32あたりの関係でしょうね(知識からの推測ですので間違いかもしれませんが)。
あまぁそもそもGetDiskFreeSpaceExができたせいでGetDiskFreeSpaceはいつ廃止またはサポートされるなくなるかわからないものだったと思います。

No.3 回答者： Starfish_goo 回答日時： 2008/09/23 12:30

圧縮ファイルを使用している場合は、GetCompressedFileSize関数と

クラスタサイズに切り上げる方法の両方に対応する必要がありそう
ですね。
ちなみに、クラスタサイズは、GetDiskFreeSpace関数を使えば
計算することができます。

No.2 回答者： argument 回答日時： 2008/09/22 01:04

こんばんわ　takao0429　さん

まずファイルサイズとディスク上のサイズこれはなんだかわかりますか？
この差の事をクラスタギャップといいます。
そしてこのクラスタとは書き込みの最小単位です。
通常fsoなどではファイル自体のサイズを返します。きっとfsoを考えた方が面倒だったのでしょう(きっと違うでしょう)。

実際考えると面倒です。まぁでも実際に1番さんの言うとおり計算しましょうか
何が面倒でしょうか？それはクラスタはOSやフォーマット形式などにより1クラスタ数が変動するという点にあります。
3.51よりも前のバージョンの Windows NT では NTFS ファイル圧縮がサポートされていないためクラスタのサイズが大きくなります。たとえば
windows95(FAT形式)ならば1クラスタ32KB　1セクタ512Bで64セクタ
windowsXP(NTFS形式)ならば1クラスタ4KB　1セクタ512Bで8セクタ
となります。
ここまでは分かりましたね？ん？よく分からない？
ハードディスクの構造上トラックをセクタで分割していますさらにセクタを分割したのがクラスタです。
そうですね取りあえずOS依存等はマイクロソフトにでも行けば分かります。
http://support.microsoft.com/kb/140365/JA/

さてではどうやって計算しましょうか？
まぁ仮にXPで普通にNTFS形式なら1クラスタは512x8=4096Bです。
クラスタで分割しあまりがあった場合1クラスタ分の要領を加算します。
ためしに簡単にVBSで作ってみたんですがやはりフォルダ内のファイルすべてを列挙しないとだめな様で結構な誤差が結構でました。
もっと処理を詰めねばならない用です面倒ですね。実感しました。

(まぁ処理を詰めても良いでしょうが）さて困りました。まぁ待ってください。之を算出してるのwindowsです。ここで思い至ります。win32APIなんか処理ないのかな・・と。
GetCompressedFileSize
http://msdn.microsoft.com/ja-jp/library/cc429287 …
指定されたファイルがディスク上で実際に占有しているサイズをバイト単位で取得します。ファイルを格納しているボリュームが圧縮機能をサポートしていて、ファイルが圧縮されている場合、圧縮済みのサイズを取得します。
なんだありました。では之で問題解決ですね。

貴方は小難しいクラスタ計算をするかwin32APIを扱えるソースを記述すればこの問題は解決します。

貴方の技量がどれほどあるかは分かりません。ですが上記二つのいづれかの方法をとればフォルダのディスク上のサイズを取得するできる事はわかったでしょう(ソースがほしいと言う場合はこの議題とはまた別件でしょう)。

No.1 回答者： Starfish_goo 回答日時： 2008/09/21 16:20

FileSystemObjectのFolderオブジェクトには、ディスク上のサイズを

求めるプロパティはないので、個々のファイルのサイズを調べて
クラスタサイズの倍数に切り上げて、その合計を計算する必要が
あるのではないかと思います。