Option Explicit
'-------------------------------------------------------------------------------------------------------------------------
'[概要]
'   指定されたドライブの種類を調べる。交換可能か行程か、
'   CD-ROMかRAMディスクかネットワークドライブかが判別できる。
'[パラメータ]
'   lpRootPathName   - 情報を取得するディスクのルートディレクトリ名が入った
'                      Nullで終わる文字列へのポインタを指定する。
'                      Nullを指定すると、可憐とディレクトリのあるディスクが指定されたものとみなされる。
'[戻り値]
'   ドライブの種類を識別する値が返ります。
'-------------------------------------------------------------------------------------------------------------------------
Declare Function GetDriveType Lib "kernel32" _
	Alias "GetDriveTypeA" (ByVal lpRootPathName As String) As Long
Public Const DRIVE_NODETERMINE_DRIVETYPE = 0       ''判断不能
Public Const DRIVE_NOEXIST_ROOTDIRECTORY = 1       ''ルートディレクトリなし
Public Const DRIVE_REMOVABLE = 2                   ''ディスク脱着可能
Public Const DRIVE_FIXED = 3                       ''ディスク脱着不能
Public Const DRIVE_REMOTE = 4                      ''リモート
Public Const DRIVE_CDROM = 5                       ''ＣＤ−ＲＯＭ
Public Const DRIVE_RAMDISK = 6                     ''RAMDISK

'-------------------------------------------------------------------------------------------------------------------------
'[概要]
'   ファイルの属性をかえします。
'[パラメータ]
'   lpFileName  - ファイル名やディレクトリ名が入った
'                 Nullで終わる文字列へのポインタを指定する。
'                 最大長はMAX_PATH文字です。
'[戻り値]
'   成功すると、指定したファイルまたはディレクトリの属性が返る。
'-------------------------------------------------------------------------------------------------------------------------
Declare Function GetFileAttributes Lib "kernel32" _
	Alias "GetFileAttributesA" (ByVal lpFileName As String) As Long
Public Const FILE_ATTRIBUTE_READONLY = &H1&         ''読み取り専用です。
Public Const FILE_ATTRIBUTE_HIDDEN = &H2&           ''隠しファイルまたは隠しディレクトリです。
Public Const FILE_ATTRIBUTE_SYSTEM = &H4&           ''オペレーティングシステムのファイルの一部です。
                                                    ''または、オペレーティングシステム専用のファイルです。
Public Const FILE_ATTRIBUTE_DIRECTORY = &H10&       ''ディレクトリです。
Public Const FILE_ATTRIBUTE_ARCHIVE = &H20&         ''アーカイブファイルまたはアーカイブディレクトリです。
                                                    ''この属性は、ファイルのバックアップや削除のためのマークとして使われる。
Public Const FILE_ATTRIBUTE_NORMAL = &H80&          ''特に属性はありません。
Public Const FILE_ATTRIBUTE_TEMPORARY = &H100&      ''テンポラリファイルです。
Public Const FILE_ATTRIBUTE_COMPRESSED = &H800&     ''圧縮ファイルまたは圧縮ディレクトリです。
                                                    ''圧縮ディレクトリ内に
                                                    ''新しく作られるファイルまたはディレクトリは、
                                                    ''デフォルトで圧縮状態になります。

'-------------------------------------------------------------------------------------------------------------------------
'[概要]
'   いくつかの十代なエラーに関して、オペレーティングシステムに処理させるか、
'   呼び出し側のアプリケーションに処理させるかを設定する。
'[パラメータ]
'   uMode           - lpBufferバッファのサイズを指定する。
'   lpBuffer        - バッファへのポインタを指定する。
'                     このバッファに、テンポラリファイル用のディレクトリのパスが格納されます。
'[戻り値]
'   成功すると、バッファに書き込まれた文字数（終端のNull文字を除く）が返ります。
'   lpBufferバッファのサイズが必要なサイズよりも小さかったときは、
'   必要なサイズ（終端のNull文字を含む）が返ります。
'   関数が失敗すると、0が返ります。
'-------------------------------------------------------------------------------------------------------------------------
' エラーに対するオペレーティングシステムの処理方法を指定する関数の宣言
Declare Function SetErrorMode Lib "kernel32" (ByVal uMode As Long) As Long
Public Const SEM_FAILCRITICALERRORS = &H1&
Public Const SEM_NOGPFAULTERRORBOX = &H2&
Public Const SEM_NOOPENFILEERRORBOX = &H8000&

Private Sub Command1_Click()
    Dim strRootPathName       As String
    Dim lngDriveType          As Long
    Dim lngFileAttrivutes     As Long
    Dim lngWin32apiResultCode As Long

    ' ルートディレクトリを指定
    strRootPathName = Text1.Text & ":\"
    ' ドライブの種類を取得
    lngDriveType = GetDriveType(strRootPathName)
    ' ドライブがディスク脱着可能である場合は
    If lngDriveType = DRIVE_REMOVABLE Then
        ' システムエラーを抑制
        lngWin32apiResultCode = SetErrorMode(SEM_FAILCRITICALERRORS)
        ' ルートディレクトリのファイル属性を取得
        lngFileAttrivutes = GetFileAttributes(strRootPathName)
        ' ファイル属性を取得できない場合は
        If lngFileAttrivutes = &HFFFF Then
            Select Case Err.LastDllError
                Case ERROR_NOT_READY
                    Label4.Caption = "装着されていません。"
                Case ERROR_GEN_FAILURE
                    Label4.Caption = "フォーマットされていません。"
                Case Else
                    Label4.Caption = "状態を取得できません。"
            End Select
        Else
            Label4.Caption = "装着されています。"
        End If
        ' システムエラーを既定
        lngWin32apiResultCode = SetErrorMode(0)
    Else
            Label4.Caption = "装着可能なドライブを指定してください。"
    End If
End Sub

Private Sub Command2_Click()
    End
End Sub