CDデバイス名からRecorderUniqueID取得、トレーEJECT処理

前回の投稿で使用したCDデバイス名一覧から選択したCDデバイスを特定する処理です

前投稿[CDデバイス一覧取得]のソースがある前提で

引数に選択したCDデバイス名を指定すれば対応するデバイスのIDを取得します

--------------------------------------------------------------------------------

    ''' <summary>
    ''' RecorderUniqueID取得
    ''' </summary>
    Public Function GetCDDevID(sProductId As String) As String
        Dim strRet As String = String.Empty
        Dim objDiscMaster As IMAPI2.MsftDiscMaster2 = Nothing
        Try
            'デバイス検索
            objDiscMaster = New IMAPI2.MsftDiscMaster2
            For Each sDev As String In objDiscMaster
                Dim objDev As New IMAPI2.MsftDiscRecorder2
                Try
                    objDev.InitializeDiscRecorder(sDev)
                    If Trim(objDev.ProductId) = sProductId Then
                        strRet = sDev
                        Exit For
                    End If
                Catch ex As Exception
                    Throw ex
                Finally
                    MarshalObject(objDev)
                End Try
            Next
        Catch ex As Exception
            Throw ex
        Finally
            MarshalObject(objDiscMaster)
        End Try
        Return strRet
    End Function

--------------------------------------------------------------------------------

これだけだと面白くないのでCDトレーのEJECTをさせる処理を

引数に選択したCDデバイス名を指定すれば対応するデバイスのトレーを開きます

--------------------------------------------------------------------------------

    ''' <summary>

    ''' EJECT TRAY

    ''' </summary>

    ''' <param name="sProductId">Device名</param>

    Public Sub TrayEJECT(sProductId As String)

        Dim objRecorder As New IMAPI2.MsftDiscRecorder2

        Dim sRecorderUniqueID As String = GetCDDevID(sProductId)

        Try

            If Not String.IsNullOrWhiteSpace(sRecorderUniqueID) Then

                'デバイス決定

                objRecorder.InitializeDiscRecorder(sRecorderUniqueID)

                'EJECT

                objRecorder.EjectMedia()

            End If

        Catch ex As Exception

            Throw ex

        Finally

            MarshalObject(objRecorder)

        End Try

    End Sub

--------------------------------------------------------------------------------

CDデバイス一覧取得

ネタが無いので小出しで

手が空いて何もすることが無いので以前作成したCD-R/RW のPGをWindows10,VB2019に移植。

とは言っても変えるところはw

IMAPI2はインストールした記憶が無いのでWindows10に初期から入ってる？

コンボボックスにCDドライブを表示させたいので一覧を取得する処理から

まず、必要な参照をImportsしておく

--------------------------------------------------------------------------------

Imports IMAPI2

Imports IMAPI2FS

Imports System.Runtime.InteropServices

--------------------------------------------------------------------------------

定番のCOM開放処理を作成

--------------------------------------------------------------------------------
    ''' <summary>
    ''' COMオブジェクト解放
    ''' </summary>
    ''' <param name="obj">対象オブジェクト</param>
    Private Sub MarshalObject(ByVal obj As Object)
        Try
            If (Not obj Is Nothing) AndAlso (Marshal.IsComObject(obj)) Then
                Marshal.ReleaseComObject(obj)
            End If
        Catch ex As Exception
            Throw ex
        Finally
            obj = Nothing
        End Try

    End Sub

--------------------------------------------------------------------------------

CDデバイス一覧取得

--------------------------------------------------------------------------------

    ''' <summary>

    ''' CDデバイス名一覧取得

    ''' </summary>

    Public Function GetCDDevName() As List(Of String)

        Dim lstRet As New List(Of String)

        Dim objDiscMaster As MsftDiscMaster2 = Nothing

        Dim objDev As MsftDiscRecorder2 = Nothing

        'デバイス一覧取得

        Try

            objDiscMaster = New MsftDiscMaster2

            For Each sDev As String In objDiscMaster

                objDev = New MsftDiscRecorder2

                objDev.InitializeDiscRecorder(sDev)

                lstRet.Add(Trim(objDev.ProductId))

                MarshalObject(objDev)

            Next

        Catch ex As Exception

            Throw ex

        Finally

            MarshalObject(objDev)

            MarshalObject(objDiscMaster)

        End Try

        Return lstRet

    End Function

--------------------------------------------------------------------------------

GetCDDevName() の戻り値を ComboBox の DataSource に設定すれば表示するはず

覚書の為、検証できていないので参考程度でお願いします

VB.NETからCD-Rにデータ書込み

先日、PGのリプレースを依頼された。
PGは単純なんだけど、現状FDに出力するファイルをCD-Rに出力して欲しいと。

結構めんどくさいw
単純にCD-RドライブにCOPYって訳にもいかないようだし。

で、定番 ググってみた。
IMAPI2 なるAPIがあるようだ。（対象がWin7でVB2010だったから)

ただほとんどの情報は英語。まあ仕方ない。
無い頭を無理やり使って意訳w

で、出来たのが次のソース。
かなり簡略化してコメントもアバウト。
エラー処理などほぼ無視w
--------------------------------------------------------
参照  COM
  IMAPI2
  IMAPI2FS
--------------------------------------------------------
'CD-R書込み関連参照設定
Imports IMAPI2
Imports IMAPI2FS
Imports System.Runtime.InteropServices
Module modX
    Public Function fncBURNdata() As Boolean
        Dim bRet As Boolean = False
        Dim sRecorderId As String = String.Empty            'RecorderID
        Dim objDiscMaster As IMAPI2.MsftDiscMaster2 = Nothing   'DiscMaster2 Object connects
        Dim objRecorder As IMAPI2.MsftDiscRecorder2 = Nothing   'Recorder for BURNing device
        Dim DataWriter As IMAPI2.MsftDiscFormat2Data = Nothing  '
        Dim BurnRet As IMAPI2FS.FileSystemImageResult = Nothing '
        Dim Image As IMAPI2FS.MsftFileSystemImage = Nothing     '
        Dim ImageStreem As IMAPI2.IStream = Nothing             '
        'CD-R書込み
        Try
            'デバイス検索
            objDiscMaster = New IMAPI2.MsftDiscMaster2
            sRecorderId = ""
            For Each sDev As String In objDiscMaster
                Dim objDev As New IMAPI2.MsftDiscRecorder2
                Try
                    objDev.InitializeDiscRecorder(sDev)
                    If Trim(objDev.ProductId) = %デバイス名% Then
                        sRecorderId = sDev
                        Exit For
                    End If
                Catch ex As Exception
                    Throw ex
                Finally
                    MarshalObject(objDev)
                End Try
            Next
            'デバイス決定
            objRecorder = New IMAPI2.MsftDiscRecorder2
            objRecorder.InitializeDiscRecorder(sRecorderId)
            'メディア初期化
            Dim bRetErase As Boolean = fncEraseDisc(objRecorder)
            'ISOイメージ種別指定(Longファイル名使用可能)
            Image = New IMAPI2FS.MsftFileSystemImage
            Image.FileSystemsToCreate = (FsiFileSystems.FsiFileSystemISO9660 Or
                                          FsiFileSystems.FsiFileSystemJoliet)
            'CD-Rボリューム名設定
            Image.VolumeName = %ボリューム名%
            'ISO作成元フォルダ指定
            Image.Root.AddTree(%作成元フォルダパス%, False)
            'ISOイメージ作成
            DataWriter = New IMAPI2.MsftDiscFormat2Data
            DataWriter.Recorder = objRecorder
            DataWriter.ClientName = %本PG名%
            DataWriter.ForceMediaToBeClosed = True
            BurnRet = Image.CreateResultImage()
            'ISOイメージ書込み
            ImageStreem = DirectCast(BurnRet.ImageStream, IMAPI2.IStream)
            DataWriter.Write(ImageStreem)
            'メディア取り出し
            objRecorder.EjectMedia()
        Catch ex As System.Runtime.InteropServices.COMException
            '書込みエラー
            MsgBox(ex.Message ,
                   MsgBoxStyle.OkOnly Or MsgBoxStyle.Exclamation,
                   "エラー")
            bRet = False
        Catch ex As Exception
            '書込みエラー
            MsgBox(ex.Message ,
                   MsgBoxStyle.OkOnly Or MsgBoxStyle.Exclamation,
                   "エラー")
            bRet = False
        Finally
            '各ＣＯＭオブジェクト開放
            MarshalObject(ImageStreem)
            MarshalObject(BurnRet)
            MarshalObject(DataWriter)
            MarshalObject(Image)
            MarshalObject(objRecorder)
            MarshalObject(objDiscMaster)
        End Try
        Return bRet
    End Function
    Private Sub MarshalObject(ByVal obj As Object)
        Try
            If (Not obj Is Nothing) AndAlso (Marshal.IsComObject(obj)) Then
                Marshal.ReleaseComObject(obj)
            End If
        Catch ex As Exception
        Finally
            obj = Nothing
        End Try
    End Sub

    Public Function fncEraseDisc(ByVal Recorder As IMAPI2.MsftDiscRecorder2) As Boolean
        Dim Format As New IMAPI2.MsftDiscFormat2Erase
        Try
            Format.Recorder = Recorder
            If Not Format.IsCurrentMediaSupported(Recorder) Then
                Return False
            End If
            Format.ClientName = %本PG名%
            Format.EraseMedia()
        Catch ex As Exception
            'ここでのエラーはひとまず無視
        Finally
            'ＣＯＭオブジェクト開放
            MarshalObject(Format)
        End Try
        Return True
    End Function
End Module
--------------------------------------------------------
そうそうXP等で動かす時はIMAPI2をインストールする必要がある。
Win7は何も必要ないけど
XPだとIMAPI2をMSからダウンロードしてインストールしてね。
%～%は各環境に合わせれば良いと思います^^;