発掘の趣旨
この記事の元のURL
存在していた時期
2002年1月24日から2005年9月24日まで存在はしていたようだ。
状況
ホームページの構造から、本来VB5.0のサンプルを掲載する予定だったが、途中で断念し、GetDiskFreeSpaceExだけ存在していたようだ。
価値
この記事はGetDiskFreeSpaceExをVB5にしており、VBAに使える。しかしこのサンプルは実はここ以外見つからない。このため発掘する価値があると判断した。
Visual Basic サンプルコード集 VB5.0(SP3)
以降のサンプルコードは、すべて、Visual Basic 5.0(SP3)で確認しています。（現在これしか、使っていないもので） ※すべて・・といってもまだ１つしかありませんが(^^;
２ＧＢ以上のディスクの容量、空き容量を得る （Win95 OSR2以降,98,NT）
２ＧＢ以上のディスクの容量、空き容量を得るコード（Win95 OSR2以降、98,NT）
ドライブなどの容量を得るのに通常は、ＡＰＩ関数のGetDiskFreeSpace関数を使用しますが、2GB以上の大容量では、正しくない値が返されます。
そこで、２GB以上の容量を得るには、Win95 OSR2以降のOSを使用しているなら、GetDiskFreeSpaceEx関数を使用します。
宣言文
Public Declare Function GetDiskFreeSpaceEx Lib "kernel32" Alias _ "GetDiskFreeSpaceExA" (ByVal _
lpDirectoryName As String, _
lpFreeBytesAvailableToCaller As Double, _
lpTotalNumberOfBytes As Double, _
lpTotalNumberOfFreeBytes As Double) As Long
引数
lpDirectoryName ディレクトリ名（０の時、カレントディレクトリ）
lpFreebytesAvailableToCaller （戻り値）ユーザーが使用出来るディスクの空き容量（バイト数）
lpTotalNumberOfBytes （戻り値）指定のディスクの全バイト数
lpTotalNumberOfFreeBytes （戻り値）同、空き容量（バイト数）
戻り値
正常終了の時 ０以外
エラーの時 ０
備考
lpDirectoryName で、ディレクトリ名を指名するとき、最後尾に""をつける。（例： C:)
lpFreebytesAvailableToCaller は、複数のユーザーがコンピュータを使用する場合、ユーザー毎にディスクを割り当てるので、使用可能容量とは異なる戻り値が入るようだ。（わたしは、１人で使っているので、lpTotalNumberOfFreeBytes と同じ値になるので、複数使用の場合の戻り値の実際が分かりませんが・・）
戻り値の型がDouble（倍精度浮動小数点型）である点に注意。
使用例
Dim Re As Long
Dim lpFreeBytesAvailableToCaller As Double
Dim iTotalBytes As Double
Dim iFreeBytes As Double
Dim TotalBytes As Double
Dim FreeBytes As Double
'Ｃドライブの容量を得るとすると、
Re = GetDiskFreeSpaceEx( "c:\", lpFreeBytesAvailableToCaller, iTotalBytes, iFreeBytes)
'全容量
Totalbytes = iTotalBytes / 4.94065645841247E-324
'空き容量
FreeBytes = iiFreeBytes / 4.94065645841247E-324
変数に格納された数値を取り出すのに、ちょっと荒技を使っていますが、上記の方法で、バイト数が取り出せる筈です。試してみてください。この手法は、自作ソフトFileGearWに使っています。FileGearWのメニューの各ドライブ情報をクリックしてみて下さい。
実証コード VBA
''標準モジュール
Option Explicit
# If VBA7 Then
Public Declare PtrSafe Function GetDiskFreeSpaceEx Lib "KERNEL32" Alias _
"GetDiskFreeSpaceExA" (ByVal _
lpDirectoryName As String, _
lpFreeBytesAvailableToCaller As Double, _
lpTotalNumberOfBytes As Double, _
lpTotalNumberOfFreeBytes As Double) As Long
# Else
Public Declare Function GetDiskFreeSpaceEx Lib "KERNEL32" Alias _
"GetDiskFreeSpaceExA" (ByVal _
lpDirectoryName As String, _
lpFreeBytesAvailableToCaller As Double, _
lpTotalNumberOfBytes As Double, _
lpTotalNumberOfFreeBytes As Double) As Long
# End If
Sub Freetestt()
Dim Re As Long
Dim lpFreeBytesAvailableToCaller As Double
Dim iTotalBytes As Double
Dim iFreeBytes As Double
Dim TotalBytes As Double
Dim FreeBytes As Double
'Ｃドライブの容量を得るとすると、
Re = GetDiskFreeSpaceEx("c:\", lpFreeBytesAvailableToCaller, iTotalBytes, iFreeBytes)
'全容量
TotalBytes = iTotalBytes / 4.94065645841247E-324
'空き容量
FreeBytes = iFreeBytes / 4.94065645841247E-324
Debug.Print FreeBytes & "/" & TotalBytes
End Sub