発掘の趣旨

この記事の元の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