ドライブレターの取得とドライブタイプ
|
ドライブ文字( A:, C:, D: ... )は GetLogicalDrives() ＡＰＩで取得できます。 GetLogicalDrives() の戻り値をビット操作することにより求めることができます。 ０１２３４５６７８９ＡＢＣＤＥＦ０１２３４５６７８９ＡＢＣＤＥＦ ｜｜＋− A: ｜＋−− B: ＋−−− C: ・ ・ 該当するビットが '1' のときそのドライブがインストールされていること示しますが ドライブが有効かどうかは不明です。 サンプルは以下のとおりです。 *----*----*----*----*----*----*----* フォームモジュールに貼り付けて実行してみてください。 Option Explicit Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Dest As Any, ByVal lpSrc As Long, ByVal Length As Long) Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long Private Declare Function GetLogicalDrives Lib "kernel32" () As Long Private Const DRIVE_CDROM = 5 Private Const DRIVE_FIXED = 3 Private Const DRIVE_RAMDISK = 6 Private Const DRIVE_REMOTE = 4 Private Const DRIVE_REMOVABLE = 2 Private Function BitTestDWord(ByVal dw As Long, ByVal Test As Integer) As Boolean Dim b(3) As Byte, TestPos(1) As Byte If Test >= 0 And Test <= 31 Then b(0) = GetByte(dw, 3) b(1) = GetByte(dw, 2) b(2) = GetByte(dw, 1) b(3) = GetByte(dw, 0) TestPos(0) = Test \ 8 TestPos(1) = Test Mod 8 TestPos(1) = 2 ^ (7 - TestPos(1)) BitTestDWord = IIf((b(TestPos(0)) And TestPos(1)) <> 0, True, False) Else BitTestDWord = False End If End Function Private Function GetByte(ByVal v As Variant, ByVal Index As Integer) As Byte Dim b(3) As Byte, w As Integer, dw As Long If VarType(v) = vbInteger Then If Index >= 0 And Index <= 1 Then w = CInt(v) CopyMemory b(0), VarPtr(w), 2 GetByte = b(Index) Else GetByte = 0 End If ElseIf VarType(v) = vbLong Then If Index >= 0 And Index <= 3 Then dw = CLng(v) CopyMemory b(0), VarPtr(dw), 4 GetByte = b(Index) Else GetByte = 0 End If Else GetByte = 0 End If End Function Private Sub Form_Click() Dim i&, c&, dwDrv&, sDrv$, msg$ dwDrv = GetLogicalDrives() msg = "" c = 0 For i = 31 To 0 Step -1 If BitTestDWord(dwDrv, CInt(i)) Then sDrv = Chr$(c + &H41&) & ":\" Select Case GetDriveType(sDrv) Case DRIVE_CDROM msg = msg & Left$(sDrv, Len(sDrv) - 1) & " CDROM" & vbCr Case DRIVE_FIXED msg = msg & Left$(sDrv, Len(sDrv) - 1) & " FIXED" & vbCr Case DRIVE_RAMDISK msg = msg & Left$(sDrv, Len(sDrv) - 1) & " RAMDISK" & vbCr Case DRIVE_REMOTE msg = msg & Left$(sDrv, Len(sDrv) - 1) & " REMOTE" & vbCr Case DRIVE_REMOVABLE msg = msg & Left$(sDrv, Len(sDrv) - 1) & " REMOVABLE" & vbCr Case Else msg = msg & Left$(sDrv, Len(sDrv) - 1) & " UNKNOWN" & vbCr End Select End If c = c + 1 Next MsgBox msg End Sub |
動作確認
Windows95 + Visual Basic 5このサンプルを使用しての感想や、質問は 掲示板や、 らくがき帳に書きとめて頂けるとうれしいです。