'===========================================================================
'    ファイル名    : basDiskSpace.bas
'    ファイル説明  : ディスク容量を求める関数
'    作成者        : Uz
'    作成日        : 1998/02/05 (Thu)
'    修正日        : 1998/02/05 (Thu)
'    備考          : なし
'===========================================================================

' -- API関数宣言
Declare Function GetDiskFreeSpace Lib "kernel32" Alias "GetDiskFreeSpaceA" ( _
    ByVal lpRootPathName As String, _
    lpSectorsPerCluster As Long, _
    lpBytesPerSector As Long, _
    lpNumberOfFreeClusters As Long, _
    lpTtoalNumberOfClusters As Long _
) As Long

'///////////////////////////////////////////////////////////////////////////
'      関数名    : GetDiskSpace
'      目的説明  : ディスク容量を返す
'      前提条件  : なし
'      結果      : なし
'      引数      : String   strDriveName    : 求めるドライブ名
'                  Long     lngFlag         : フラグ    0：全容量
'                                                       1：空き容量
'      戻り値    : Double
'      備考      ; なし
'///////////////////////////////////////////////////////////////////////////
Public Function GetDiskSpace(ByVal strDriveName As String, ByVal lngFlag As Long) As Double
    Dim lpRootPathName As String            ' ルートディレクトリ名
    Dim lpSectorsPerCluster As Long         ' クラスタあたりのセクタ数
    Dim lpBytesPerSector As Long            ' セクタあたりのバイト数
    Dim lpNumberOfFreeClusters As Long      ' 空きクラスタ数
    Dim lpTotalNumberOfClusters As Long     ' 総クラスタ数
    
    On Error GoTo ErrorHandle
    
    lpRootPathName = strDriveName
    Call GetDiskFreeSpace(lpRootPathName, _
                          lpSectorsPerCluster, _
                          lpBytesPerSector, _
                          lpNumberOfFreeClusters, _
                          lpTotalNumberOfClusters)
    If lngFlag = 0 Then
        'ディスク全容量を求める
        GetDiskSpace = lpTotalNumberOfClusters * lpSectorsPerCluster * lpBytesPerSector
    ElseIf lngFlag = 1 Then
        'ディスク空き容量を求める
        GetDiskSpace = lpNumberOfFreeClusters * lpSectorsPerCluster * lpBytesPerSector
    Else
        GetDiskSpace = -1
    End If
    Exit Function
ErrorHandle:
    GetDiskSpace = -1
End Function

'===========================================================================
'    ファイル名    : frmMain.frm
'    ファイル説明  : テストフォーム
'    作成者        : Uz
'    作成日        : 1998/02/05 (Thu)
'    修正日        : 1998/02/05 (Thu)
'    備考          : なし
'===========================================================================
Private Sub drvDrive_Change()
    Dim lngSize As Long
    
    lngSize = GetDiskSpace(Left(drvDrive.Drive, 1), 1)
    If lngSize = -1 Then
        lblFree.Caption = "ERROR"
    Else
        lblFree.Caption = CStr(lngSize / 1024 / 1024) & "MB"
    End If
    
    lngSize = GetDiskSpace(Left(drvDrive.Drive, 1), 0)
    If lngSize = -1 Then
        lblTotal.Caption = "ERROR"
    Else
        lblTotal.Caption = CStr(lngSize / 1024 / 1024) & "MB"
    End If
End Sub

Private Sub Form_Load()
    drvDrive.Drive = "c:\"
End Sub