Option Strict Off
Option Explicit On

Imports System.Runtime.InteropServices

Module MySound

        'MCI文字列
        'http://eternalwindows.jp/winmm/mci/mci02.html
        
        Declare Function sndPlaySound Lib "winmm.dll"  Alias "sndPlaySoundA"(ByVal lpszSoundName As String, ByVal uFlags As Integer) As Integer
        
        Private Const SND_SYNC As Integer = &H0
        Private Const SND_ASYNC As Integer = &H1
        Private Const SND_NODEFAULT As Integer = &H2
        Private Const SND_MEMORY As Integer = &H4
        Private Const SND_LOOP As Integer = &H8
        Private Const SND_NOSTOP As Integer = &H10
        
    <DllImport("winmm.dll", _
        CharSet:=System.Runtime.InteropServices.CharSet.Auto)> _
    Private Function mciSendString(ByVal command As String, _
        ByVal buffer As String, _
        ByVal bufferSize As Integer, ByVal hwndCallback As IntPtr) As Integer
    End Function


        Dim Com As String
        
        Public Const SOUND_ALIAS As String = "MySound"
        
        
        '■PlaySound　−　サウンドファイルを開く
        '■引数：strFileName ファイルパス
        '　　　　strAlias    MCI名
        Public Sub OpenSound(ByRef strFileName As String, ByRef strAlias As String)
        Try
            Com = "open " & """" & strFileName & """" & " alias " & strAlias & " type MPEGVideo"
            Call mciSendString(Com, "", 0, 0)
        Catch
            MsgBox(Err.Number & " " & Err.Description)
        End Try

    End Sub
        
        '■CloseSound　−　サウンドファイルを閉じる
        '■引数：strAlias   MCI名
        Public Sub CloseSound(ByRef strAlias As String)
        Try
            Call mciSendString("close """ & strAlias & """", "", 0, 0)
        Catch
            MsgBox(Err.Number & " " & Err.Description)
        End Try
    End Sub
        
        '■PlaySound　−　サウンドを再生する
        '■引数：strAlias   MCI名
        Public Sub PlaySound(ByRef strAlias As String)
        Try
            Call mciSendString("play " & strAlias, "", 0, 0)
        Catch
            MsgBox(Err.Number & " " & Err.Description)
        End Try
                
        End Sub
        
        '■PauseSound　−　サウンドの再生を一時停止する
        '■引数：strAlias   MCI名
        Public Sub PauseSound(ByRef strAlias As String)
        Try
            Call mciSendString("pause " & strAlias, "", 0, 0)
        Catch
            MsgBox(Err.Number & " " & Err.Description)
        End Try
        End Sub
        
        '■ResumeSound　−　一時停止の続きからサウンドの再生をする
        '■引数：strAlias   MCI名
        Public Sub ResumeSound(ByRef strAlias As String)
        Try
            Call mciSendString("resume " & strAlias, "", 0, 0)
        Catch
            MsgBox(Err.Number & " " & Err.Description)
        End Try
        End Sub
        
        '■StopSound　−　サウンドの再生を停止する
        '■引数：strAlias   MCI名
        Public Sub StopSound(ByRef strAlias As String)
        Try
            Call mciSendString("stop " & strAlias, "", 0, 0)
        Catch
            MsgBox(Err.Number & " " & Err.Description)
        End Try
        End Sub
        
        '■GetLength　−　ファイルの長さを秒単位で返す。
        '■引数：strAlias   MCI名
        Public Function GetSoundLength(ByRef strAlias As String) As Double
                
                Dim strStatus As New VB6.FixedLengthString(256)
                Dim MCICommandString As String
                
        Try
            MCICommandString = "status " & strAlias & " length"
            Call mciSendString(MCICommandString, strStatus.Value, Len(strStatus.Value), 0)
            GetSoundLength = Val(strStatus.Value) / 1000
        Catch
            MsgBox(Err.Number & " " & Err.Description)
        End Try

    End Function
        
        '■GetPosition　−　再生中のファイルの位置を秒単位で返す。
        '■引数：strAlias   MCI名
        Public Function GetSoundPosition(ByRef strAlias As String) As Double
                
                Dim strStatus As New VB6.FixedLengthString(256)
                Dim MCICommandString As String
                
        Try
            MCICommandString = "status " & strAlias & " position"
            mciSendString(MCICommandString, strStatus.Value, Len(strStatus.Value), 0)

            GetSoundPosition = Val(strStatus.Value) / 1000
        Catch
            MsgBox(Err.Number & " " & Err.Description)
        End Try
        End Function
        
        '■SetPosition　−　ファイルの再生位置を指定する。
        '■引数：strAlias   MCI名
        '■      Position   再生位置を秒単位で指定する
        Public Sub SetSoundPosition(ByRef strAlias As String, ByRef Position As Double)
                
                Dim NewPosition As Integer
                
        Try
            NewPosition = Position * 1000
            Call mciSendString("seek " & strAlias & " to " & NewPosition, "", 0, 0)
            Call mciSendString("play " & strAlias, "", 0, 0)
        Catch
            MsgBox(Err.Number & " " & Err.Description)
        End Try
        End Sub
        
        '■GetSoundStatus　−　現在の再生状態を取得する
        '■引数：strAlias   MCI名
        '■戻り値：再生中のとき"PLAYING"、停止中のとき"STOPPED"、一時停止中のとき"PAUSED"
        Public Function GetSoundStatus(ByRef strAlias As String) As String
                
                Dim MCICommandString As String

        GetSoundStatus = ""
        Try
            Dim strStatus As New VB6.FixedLengthString(256)
            MCICommandString = "status " & strAlias & " mode"
            Call mciSendString(MCICommandString, strStatus.Value, Len(strStatus.Value), 0)
            GetSoundStatus = GetString(strStatus.Value)
        Catch
            MsgBox(Err.Number & " " & Err.Description)
        End Try
        End Function
        
        
        '■SetVolume　−　音量を取得
        '■引数：strAlias   MCI名
        Public Function GetSoundVolume(ByRef strAlias As String) As Double
                
                Dim strStatus As New VB6.FixedLengthString(256)
                
        Try
            Call mciSendString("status " & strAlias & " volume ", strStatus.Value, Len(strStatus.Value), 0)
            GetSoundVolume = Val(GetString(strStatus.Value))
        Catch
            MsgBox(Err.Number & " " & Err.Description)
        End Try
        End Function
        
        '■SetVolume　−　音量をセット
        '■引数：strAlias   MCI名
        '■      Vol   音量を指定する
        Public Sub SetSoundVolume(ByRef strAlias As String, ByRef Vol As Double)
        Try
            Call mciSendString("setaudio " & strAlias & " volume to " & Vol, "", 0, 0)
        Catch
            MsgBox(Err.Number & " " & Err.Description)
        End Try
    End Sub
        
    Public Function GetString(ByRef strBuf As String) As String
        '
        ' Null位置までの文字列を取得する
        '
        Dim p As Integer
        p = InStr(1, strBuf, vbNullChar) - 1
        If p < 0 Then p = 0
        GetString = Left(strBuf, p)
    End Function
End Module