複数のCD-ROMドライブがある場合(mciSendString)はどうする？

質問

複数のCD-ROMドライブがある場合に以下のコードを実行すると
接続されているCD-ROMドライブの接続順で一番若いドライブ
私のパソコンだとE：ドライブ（外付け,内蔵はQ:）の情報を取得しますが
Q:ドライブの情報を取得するためには、どのようなコードを記述すれば
いいのでしょうか？（外付けをはずすというのは考えないで）

rtnstr = String(256, 0)
Rtn = mciSendString("open cdaudio", rtnstr, 256, 0)

Rtn = mciSendString("set cdaudio time format tmsf", rtnstr, 256, 0)

'全トラック数を取得する
Rtn = mciSendString("status cdaudio number of tracks", rtnstr, 256, 0)
全トラック数 = Val(rtnstr)

'ＣＤの全演奏時間
Rtn = mciSendString("status cdaudio length", rtnstr, 256, 0)
全演奏時間 = rtnstr

回答No.1

TAGOSAKU7 · ベストアンサー

たしかにMCIに命令だけを投げると、OSに登録されている中で、一番若いIDを持つCDドライブに命令が行くようですね。
これを回避する方法は、パスを指定するとよいらしいです。
んで、エイリアスを使用した方が、扱いやすくなると思います。

CDROMをドライブに挿入して、以下を試してみてください。

Option Explicit

Public Const DEF_ALS_NAME　 As String = "CD"　　'エイリアス 文字列を使用する
Public Const DEF_BUFF_SIZE　As Long = &HFF&　　 'バッファサイズ

'情報を取得するときのフォーマット
Public Enum DSP_MCI_FORMAT
　　MCI_FMT_MSF　　　　　　 'Min/Sec/FRAME　　　(分/秒/フレーム)
　　MCI_FMT_TMSF　　　　　　'TRACK:Min:Sec:FRAME(トラック/分/秒/フレーム)
　　MCI_FMT_MS　　　　　　　'ms　　　　　　　　 (ミリ秒)
End Enum

'CDトラック情報構造体
Public Type CD_TRACK_INFO
　　typLen　As String　　　 '曲長
　　typPos　As String　　　 '曲開始位置
End Type

Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long
Private Declare Function mciGetErrorString Lib "winmm.dll" Alias "mciGetErrorStringA" (ByVal dwError As Long, ByVal lpstrBuffer As String, ByVal uLength As Long) As Long

Public Sub Main()
　　Dim strCDDrive　As String　　　　　 'CDROMドライブ
　　Dim lngAllCount As Long　　　　　　 '曲数
　　Dim strAllLen　 As String　　　　　 'CD全体の長さ
　　Dim TrackInfo() As CD_TRACK_INFO　　'各トラック情報

　　Dim lngTraucID　As Long　　　　　　 'デバッグ用
　　Dim strWk　　　 As String

　　strCDDrive = "G"　　'Gドライブを指定
　　lngTraucID = 3　　　'3曲目を再生する

　　'開く
　　If Not MCI_OpenDevise(strCDDrive, DEF_ALS_NAME) Then
　　　　GoTo PGMEND
　　End If

　　'トラック数を取得
　　If Not MCI_GetTrackCount(DEF_ALS_NAME, lngAllCount) Then
　　　　GoTo PGMEND
　　End If

　　'時間形式をセット
　　If Not MCI_SetFormat(DEF_ALS_NAME, MCI_FMT_MSF) Then
　　　　GoTo PGMEND
　　End If

　　'全体の長さを取得する
　　If Not MCI_GetAllLength(DEF_ALS_NAME, strAllLen) Then
　　　　GoTo PGMEND
　　End If

　　'各曲情報を取得する
　　If Not MCI_GetTrackInfo(DEF_ALS_NAME, lngAllCount, TrackInfo) Then
　　　　GoTo PGMEND
　　End If

　　'時間形式をセット
　　If Not MCI_SetFormat(DEF_ALS_NAME, MCI_FMT_TMSF) Then
　　　　GoTo PGMEND
　　End If

　　'曲を再生する
　　If Not MCI_PlaySound(DEF_ALS_NAME, lngTraucID) Then
　　　　GoTo PGMEND
　　End If

　　'デバッグ用
　　strWk = "[トラック数] : " & lngAllCount & vbCrLf
　　strWk = strWk & "[全体のサイズ] : " & strAllLen & vbCrLf
　　strWk = strWk & "[再生中の曲番] : " & lngTraucID & "曲目" & vbCrLf
　　strWk = strWk & "[再生中の曲サイズ] : " & TrackInfo(lngTraucID).typLen & vbCrLf
　　strWk = strWk & "[再生中の曲開始位置] : " & TrackInfo(lngTraucID).typPos
　　MsgBox strWk, , "OKを押すと停止します"

　　'曲を停止する
　　Call MCI_StopSound(DEF_ALS_NAME)

PGMEND:
　　'最後には閉じる
　　Call MCI_CloseDevise(DEF_ALS_NAME)
End Sub

'デバイスオープン
Public Function MCI_OpenDevise(inDrive As String, inAlsName As String, Optional ShareMode As Boolean = True) As Boolean
　　Dim lngSts　As Long
　　Dim strWk　 As String

　　'とりあえず指定のエイリアスのデバイス閉じておく
　　Call MCI_CloseDevise(DEF_ALS_NAME)

　　strWk = "OPEN " & inDrive & ": TYPE CDAUDIO ALIAS " & inAlsName
　　'共有モード指定時
　　If ShareMode Then
　　　　strWk = strWk & " WAIT SHAREABLE"
　　End If
　　'デバイスオープン
　　lngSts = mciSendString(strWk, vbNullString, 0, 0)
　　'エラーチェック
　　If (lngSts <> 0) Then
　　　　Call MCI_GetErr(lngSts)
　　　　Exit Function
　　End If
　　MCI_OpenDevise = True
End Function

'デバイスクローズ
Public Sub MCI_CloseDevise(inAlsName As String)
　　Call mciSendString("STOP " & inAlsName, vbNullString, 0, 0)
　　Call mciSendString("CLOSE " & inAlsName, vbNullString, 0, 0)
End Sub

'トラック数を取得する
Public Function MCI_GetTrackCount(inAlsName As String, outCount As Long) As Boolean
　　Dim lngSts　As Long
　　Dim strBuff As String * DEF_BUFF_SIZE
　　'トラック数を取得
　　lngSts = mciSendString("STATUS " & inAlsName & " NUMBER OF TRACKS", strBuff, DEF_BUFF_SIZE, 0)
　　'エラーチェック
　　If (lngSts <> 0) Then
　　　　Call MCI_GetErr(lngSts)
　　　　Exit Function
　　End If
　　'取得値を返す
　　outCount = MacroBuffString(strBuff)
　　MCI_GetTrackCount = True
End Function

'全体の長さを取得する
Public Function MCI_GetAllLength(inAlsName As String, outLength As String) As Boolean
　　Dim lngSts　As Long
　　Dim strBuff As String * DEF_BUFF_SIZE
　　lngSts = mciSendString("STATUS " & inAlsName & " LENGTH", strBuff, 1024, 0)
　　'エラーチェック
　　If (lngSts <> 0) Then
　　　　Call MCI_GetErr(lngSts)
　　　　Exit Function
　　End If
　　'取得値を返す
　　outLength = MacroBuffString(strBuff)
　　MCI_GetAllLength = True
End Function

'曲情報を取得する
Public Function MCI_GetTrackInfo(inAlsName As String, inCount As Long, outTracuInfo() As CD_TRACK_INFO) As Boolean
　　Dim lngSts　As Long
　　Dim strBuff As String * DEF_BUFF_SIZE
　　Dim i　　　 As Long

　　'CDトラック情報構造体を拡張
　　ReDim outTracuInfo(inCount) As CD_TRACK_INFO

　　'曲数ループ
　　For i = 1 To inCount
　　　　With outTracuInfo(i)
　　　　　　'// 再生時間取得
　　　　　　lngSts = mciSendString("STATUS " & inAlsName & " LENGTH TRACK " & i, strBuff, DEF_BUFF_SIZE, 0)
　　　　　　'エラーチェック
　　　　　　If (lngSts <> 0) Then
　　　　　　　　Call MCI_GetErr(lngSts)
　　　　　　　　Exit Function
　　　　　　End If
　　　　　　.typLen = MacroBuffString(strBuff)

　　　　　　'// 開始位置取得
　　　　　　lngSts = mciSendString("STATUS " & inAlsName & " POSITION TRACK " & i, strBuff, DEF_BUFF_SIZE, 0)
　　　　　　'エラーチェック
　　　　　　If (lngSts <> 0) Then
　　　　　　　　Call MCI_GetErr(lngSts)
　　　　　　　　Exit Function
　　　　　　End If
　　　　　　.typPos = MacroBuffString(strBuff)
　　　　End With
　　Next i
　　lngSts = mciSendString("STATUS " & inAlsName & " LENGTH", strBuff, 1024, 0)
　　'取得値を返す
　　MCI_GetTrackInfo = True
End Function

'時間形式をセット
Public Function MCI_SetFormat(inAlsName As String, Optional inMCIDspType As DSP_MCI_FORMAT = MCI_FMT_TMSF) As Boolean
　　Dim lngSts　　　As Long
　　Dim strFormat　 As String

　　'時間形式を取得
　　Select Case inMCIDspType
　　　　Case DSP_MCI_FORMAT.MCI_FMT_MSF:　　strFormat = "MSF"
　　　　Case DSP_MCI_FORMAT.MCI_FMT_TMSF:　 strFormat = "TMSF"
　　　　Case DSP_MCI_FORMAT.MCI_FMT_MS:　　 strFormat = "MS"
　　End Select

　　'時間形式をセット
　　lngSts = mciSendString("SET " & inAlsName & " TIME FORMAT " & strFormat, vbNullString, 0, 0)
　　'エラーチェック
　　If (lngSts <> 0) Then
　　　　Call MCI_GetErr(lngSts)
　　　　Exit Function
　　End If
　　MCI_SetFormat = True
End Function

'曲を再生する
Public Function MCI_PlaySound(inAlsName As String, inSoundID As Long) As Boolean
　　Dim lngSts　　　As Long
　　lngSts = mciSendString("PLAY " & inAlsName & " FROM " & inSoundID & ":00:00", vbNullString, 0, 0)
　　'エラーチェック
　　If (lngSts <> 0) Then
　　　　Call MCI_GetErr(lngSts)
　　　　Exit Function
　　End If
　　MCI_PlaySound = True
End Function

'曲を停止する
Public Sub MCI_StopSound(inAlsName As String)
　　Call mciSendString("STOP " & inAlsName, vbNullString, 0, 0)
End Sub

'MCIで起きたエラーを表示する
Public Sub MCI_GetErr(inSts As Long)
　　Dim strBuff As String * DEF_BUFF_SIZE
　　Call mciGetErrorString(inSts, strBuff, DEF_BUFF_SIZE)
　　MsgBox strBuff
End Sub

'バッファ文字列から、有効な左部分の文字を取得する
Public Function MacroBuffString(inBuff As String) As Variant
　　MacroBuffString = Left$(inBuff, InStr(inBuff, vbNullChar) - 1)
End Function

お礼

回答ありがあとうございました。
早速、回答のコードを試したところ、うまくいきました。

回答No.2

TAGOSAKU7

言い忘れ。

CD_TRACK_INFO構造体
typLen
typPos
には
分：秒：フレーム
で値が入っています。

お礼

補足ありがとうございます。