Module mMediaControl

    '--- ABOUT ---
    'Name:      MediaControl Module for VB.NET
    'Descr.:    A versatile module to simplify playing audio and video in VB.NET
    '           Fully commented and accompanied by sample project and in-file manual.
    '           This version is now also compatible with Visual Basic .NET 2005.
    'Language:  Visual Basic .NET 2003 (Version: 7.1.3088)
    'Author:    Alexander Smakman
    '           Mail: alex@smakkie.com (mailto:alex@smakkie.com?subject=About%20mMediaControl)
    'Licence:   Free to use, free to change, free to redistribute.
    '           Always include this header, keep it at the top of module.
    '           When you change the module and (re)release it uncompiled, please
    '           update the manual and send a copy of the module and manual to the author.
    '           When (re)releasing as (part of) a commercial product, please contact author.
    'Version:   2.2.06-06-19
    'Date:      May 19th, 2006.

    '--- MANUAL ---
    '
    '>>> 1 - Introduction <<<
    '
    '| 1.1 | What is this?
    'This is a module that you can use to play media files more easily.
    'It works pretty easy once you get to know it. To get to know it,
    'please read the rest of this manual.
    ' 
    '| 1.2 | How do I use it?
    'To use it, add the module file to a project. Right-click the project's
    'name in bold in the Solution Explorer. Select "Add..." > "Add Existing
    'Item..." and select the module. Now you can use the module.
    '
    '>>> 2 - Instructions <<<
    '
    '| 2.1 | The use of aliasses
    'This module uses aliasses for playing files. This is for playing more
    'than one file at a time. Useful in games and audio software. To control
    'a specific time you need to set a alias, using mediaAlias. If you call
    'mediaAlias("Name") the active alias is set to Name. Now, you can open a
    'file and play it.
    'To open another file at the same time call mediaAlias("DifferentName")
    'then open and play another (or the same) file.
    'Once an active alias is set, it does not change until a different one is
    'set, so if you use one alias. You can call mediaAlias at the start of the
    'program and then never use it again. :-)
    '
    '| 2.2 | Catching errors
    'Two public variables have been assigned to be loaded with the error
    'info when an error occurs: mediaErrorCode and mediaErrorInfo.
    'When a function succeeds mediaErrorCode will be zero. If there was
    'an error, mediaErrorCode will contain the error's code and mediaErrorInfo
    'will contain more information about the error.
    'To display a messagebox with error information when a function fails,
    'you can use code like this:
    '   mediaPlay()
    '   If mediaErrorCode Then
    '       MsgBox("Error " & mediaErrorCode & " - " & mediaErrorInfo)
    '       Exit Sub
    '   End If
    '
    '| 2.3 | Retrieving values
    'To retrieve values like the length of your file, you can use the
    '"mediaGet"-functions. They can be used like any normal function:
    '   Dim lLength As Long
    '   lLength = mediaGetLength()
    '
    '| 2.4 | How to use the functions
    'Each function has it's own little piece of help info written
    'at the top of the function. Read those, and you should be able
    'to figure it out. Also, check out the sample project to see
    'how to use the functions.
    '
    'Enjoy.

    Private sAlias As String = ""
    Public mediaErrorCode As Long
    Public mediaErrorInfo As String

    Private Declare Function GetShortPathName Lib "kernel32.dll" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer As Integer) As Integer
    Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Integer, ByVal hwndCallback As Integer) As Integer
    Private Declare Function mciGetErrorString Lib "winmm.dll" Alias "mciGetErrorStringA" (ByVal dwError As Integer, ByVal lpstrBuffer As String, ByVal uLength As Integer) As Integer

    Public Function mediaAlias(Optional ByVal SetAlias As String = "") As String

        '--- HELP ---
        'Sets or gets the alias of the file we want to work with.
        'You may use a..z, A..Z and 0..9 for the alias.
        'Spaces are not allowed and will be removed.
        '
        'Call mediaAlias() to get the active alias as return value.
        'Call mediaAlias("SomeString") to set the active alias to 'SomeString'.

        '--- CODE ---
        'Remove all spaces in the alias.
        SetAlias = Replace(SetAlias, " ", "")

        If SetAlias = "" Then
            'Get active alias.
            Return sAlias
        Else
            Dim i As Integer
            Dim chr As Integer

            'Check if the alias contains any invalid characters
            For i = 1 To Len(SetAlias)
                'Get i-th character.
                chr = Asc(Mid(SetAlias, i, 1))
                'Ascii values are: 0..9 = 48..57, A..Z = 65..90 and a..z = 97..122
                If chr < 48 Or (chr > 57 And chr < 65) Or (chr > 90 And chr < 97) Or chr > 122 Then
                    'Invalid character detected
                    mediaErrorCode = 1002
                    mediaErrorInfo = "Invalid character(s) in alias."
                    Return ""
                    Exit Function
                End If
            Next

            'No invalid characters found. Set active alias.
            sAlias = SetAlias
        End If

        'Function was called succesfully
        mediaErrorCode = 0
        mediaErrorInfo = Nothing
        Return ""

    End Function

    Public Sub mediaOpen(ByVal Filename As String, Optional ByVal ObjectHandle As String = Nothing)

        '--- HELP ---
        'Opens file and loads it under the active alias.
        'If ObjectHandle is not specified, a video will open in a new screen.
        'For playing video inside your application, you need ObjectHandle.
        'By specifying the handle of an object, you can play video in that object.
        'To play a video on your form use: mediaOpen("C:\SomeVideo.avi", Me.Handle.ToString())
        'It is VERY IMPORTANT to include the .ToString part or the function will result in error.

        '--- CODE ---
        'If no alias is set, load error details and exit function.
        If NoAlias() Then Exit Sub

        'The mciSendsString function does not accept spaces,
        'so short filename (a.k.a. DOS filename) is needed.
        Dim sShortFilename As String = Space(255)
        GetShortPathName(Filename, sShortFilename, 255)
        sShortFilename = Trim(Replace(sShortFilename, Chr(0), ""))

        If sShortFilename = "" Then
            mediaErrorCode = 1003
            mediaErrorInfo = "File does not exist."
            Exit Sub
        End If

        'Send mci string.
        Dim iReturn As Integer
        If ObjectHandle = Nothing Then
            iReturn = mciSendString("open " & sShortFilename & " type mpegvideo alias " & sAlias, "", 0, 0)
        Else
            iReturn = mciSendString("open " & sShortFilename & " type mpegvideo alias " & sAlias & " parent " & ObjectHandle & " style child", "", 0, ObjectHandle)
        End If

        'Retrieve error information
        If iReturn Then GetError(iReturn) : Exit Sub

        'Set time format to milliseconds
        iReturn = mciSendString("set " & sAlias & " time format milliseconds", "", 0, 0)
        If iReturn Then GetError(iReturn) : Exit Sub

        mediaErrorCode = 0
        mediaErrorInfo = Nothing

    End Sub

    Public Sub mediaPlay(Optional ByVal FromTime As Integer = -1, Optional ByVal ToTime As Integer = -1)

        '--- Help ---
        'Plays your media file from FromTime to ToTime.
        'Times are in milliseconds.
        'If FromTime is not specified, the file will play from start.
        'If ToTime is not specified, the file will play until end.
        'For some video files the files will not stop playing until they've
        'reached the end, when you specify ToTime. I have not yet found a solution for this.

        '--- Code ---
        If NoAlias() Then Exit Sub

        'Determine what values are set and send the play-command accordingly.
        Dim iReturn As Integer
        If FromTime = -1 And ToTime = -1 Then
            iReturn = mciSendString("play " & sAlias, "", 0, 0)
        ElseIf FromTime = -1 And ToTime <> -1 Then
            iReturn = mciSendString("play " & sAlias & " to " & ToTime, "", 0, 0)
        ElseIf FromTime <> -1 And ToTime = -1 Then
            iReturn = mciSendString("play " & sAlias & " from " & FromTime, "", 0, 0)
        Else
            iReturn = mciSendString("play " & sAlias & " from " & FromTime & " to " & ToTime, "", 0, 0)
        End If

        'Retrieve error information
        If iReturn Then GetError(iReturn) : Exit Sub

        mediaErrorCode = 0
        mediaErrorInfo = Nothing

    End Sub

    Public Sub mediaPause()

        '--- Help ---
        'Plauses your media file.

        '--- Code ---
        'If no alias is set, exit function with an error.
        If NoAlias() Then Exit Sub

        Dim iReturn As Integer
        iReturn = mciSendString("pause " & sAlias, "", 0, 0)

        'Retrieve error information
        If iReturn Then GetError(iReturn) : Exit Sub

        mediaErrorCode = 0
        mediaErrorInfo = Nothing

    End Sub

    Public Sub mediaResume()

        '--- Help ---
        'Resumes your media file after it has been paused.

        '--- Code ---
        'If no alias is set, exit function with an error.
        If NoAlias() Then Exit Sub

        Dim iReturn As Integer
        iReturn = mciSendString("resume " & sAlias, "", 0, 0)

        'Retrieve error information
        If iReturn Then GetError(iReturn) : Exit Sub

        mediaErrorCode = 0
        mediaErrorInfo = Nothing

    End Sub

    Public Sub mediaStop()

        '--- Help ---
        'Stops your media file after it has been paused.

        '--- Code ---
        'If no alias is set, exit function with an error.
        If NoAlias() Then Exit Sub

        Dim iReturn As Integer
        iReturn = mciSendString("stop " & sAlias, "", 0, 0)

        'Retrieve error information
        If iReturn Then GetError(iReturn) : Exit Sub

        mediaErrorCode = 0
        mediaErrorInfo = Nothing

    End Sub

    Public Sub mediaClose()

        '--- Help ---
        'Closes your media file.
        'After using this function, you need to use mediaOpen to play the file again.

        '--- Code ---
        'If no alias is set, exit function with an error.
        If NoAlias() Then Exit Sub

        Dim iReturn As Integer
        iReturn = mciSendString("close " & sAlias, "", 0, 0)

        'Retrieve error information
        If iReturn Then GetError(iReturn) : Exit Sub

        mediaErrorCode = 0
        mediaErrorInfo = Nothing

    End Sub

    Public Sub mediaCloseAll()

        '--- Help ---
        'Closes all your media file.
        'After using this function, you need to use mediaOpen to play the file(s) again.

        '--- Code ---
        Dim iReturn As Integer
        iReturn = mciSendString("close all", "", 0, 0)

        'Retrieve error information
        If iReturn Then GetError(iReturn) : Exit Sub

        mediaErrorCode = 0
        mediaErrorInfo = Nothing

    End Sub

    Public Sub mediaSetPosition(ByVal lPosition As Long)

        '--- Help ---
        'Sets the playback position of your media file in milliseconds.

        '--- Code ---
        Dim iReturn As Integer
        iReturn = mciSendString("seek " & sAlias & " to " & lPosition, "", 0, 0)

        'Retrieve error information
        If iReturn Then GetError(iReturn) : Exit Sub

        mediaErrorCode = 0
        mediaErrorInfo = Nothing

    End Sub

    Public Sub mediaSetVolume(ByVal lVolume As Long)

        '--- Help ---
        'Sets volume of playback, 0 is silence, 1000 is full volume.
        'This is a linear scale.
        '1000 is default.

        '--- Code ---
        Dim iReturn As Integer
        iReturn = mciSendString("setaudio " & sAlias & " volume to " & lVolume, "", 0, 0)

        'Retrieve error information
        If iReturn Then GetError(iReturn) : Exit Sub

        mediaErrorCode = 0
        mediaErrorInfo = Nothing

    End Sub

    Public Sub mediaSetDimentions(ByVal lX As Long, ByVal lY As Long, ByVal lWidth As Long, ByVal lHeight As Long)

        '--- Help ---
        'Sets the playback position of your media file in milliseconds.
        'The file may cause after changing position, calling mediaPlay()
        'will resume playback of the file.

        '--- Code ---
        Dim iReturn As Integer
        iReturn = mciSendString("put " & sAlias & " window at " & lX & " " & lY & " " & lWidth & " " & lHeight, "", 0, 0)

        'Retrieve error information
        If iReturn Then GetError(iReturn) : Exit Sub

        mediaErrorCode = 0
        mediaErrorInfo = Nothing

    End Sub

    Public Function mediaGetLength() As Long

        '--- Help ---
        'Returns the length of your media file in milliseconds.

        '--- Code ---
        'If no alias is set, exit function with an error.
        If NoAlias() Then Exit Function

        Dim iReturn As Integer
        Dim sBack As String = Space(128)
        iReturn = mciSendString("status " & sAlias & " length", sBack, 128, 0)

        'Retrieve error information
        If iReturn Then GetError(iReturn) : Exit Function

        Return Val(Trim(Replace(sBack, Chr(0), "")))

        mediaErrorCode = 0
        mediaErrorInfo = Nothing

    End Function

    Public Function mediaGetPosition() As Long

        '--- Help ---
        'Returns the current playback position of your media file in milliseconds.

        '--- Code ---
        'If no alias is set, exit function with an error.
        If NoAlias() Then Exit Function

        Dim iReturn As Integer
        Dim sBack As String = Space(128)
        iReturn = mciSendString("status " & sAlias & " position", sBack, 128, 0)

        'Retrieve error information
        If iReturn Then GetError(iReturn) : Exit Function

        Return Val(Trim(Replace(sBack, Chr(0), "")))

        mediaErrorCode = 0
        mediaErrorInfo = Nothing

    End Function

    Public Function mediaGetVolume() As Long

        '--- Help ---
        'Returns the volume of playback, 0 is silence, 1000 is full volume.
        'This is a linear scale.
        '1000 is default.

        '--- Code ---
        'If no alias is set, exit function with an error.
        If NoAlias() Then Exit Function

        Dim iReturn As Integer
        Dim sBack As String = Space(128)
        iReturn = mciSendString("status " & sAlias & " volume", sBack, 128, 0)

        'Retrieve error information
        If iReturn Then GetError(iReturn) : Exit Function

        Return Val(Trim(Replace(sBack, Chr(0), "")))

        mediaErrorCode = 0
        mediaErrorInfo = Nothing

    End Function

    Public Function mediaGetStatus() As String

        '--- Help ---
        'Returns the status of the media files, this can be:
        '"not ready", "playing", "paused" or "stopped"

        '--- Code ---
        'If no alias is set, exit function with an error.
        If NoAlias() Then Exit Function

        Dim iReturn As Integer
        Dim sBack As String = Space(128)
        iReturn = mciSendString("status " & sAlias & " mode", sBack, 128, 0)

        'Retrieve error information
        If iReturn Then GetError(iReturn) : Return "" : Exit Function

        Return Trim(Replace(sBack, Chr(0), ""))

        mediaErrorCode = 0
        mediaErrorInfo = Nothing

    End Function

    Public Function mediaGetFrameRate() As Double

        '--- Help ---
        'Video only!
        'Returns the amount of frames played per second.

        '--- Code ---
        'If no alias is set, exit function with an error.
        If NoAlias() Then Exit Function

        Dim iReturn As Integer
        Dim sBack As String = Space(128)
        iReturn = mciSendString("status " & sAlias & " frame rate", sBack, 128, 0)

        'Retrieve error information
        If iReturn Then GetError(iReturn) : Exit Function

        Return Val(Trim(Replace(sBack, Chr(0), "")))

        mediaErrorCode = 0
        mediaErrorInfo = Nothing

    End Function

    Public Function mediaGetFramesDropped() As Long

        '--- Help ---
        'Video only!
        'Returns the amount frames that have not been shown, this should
        'remain zero, but may start counting on slow machines or at times
        'of high processor demand.

        '--- Code ---
        'If no alias is set, exit function with an error.
        If NoAlias() Then Exit Function

        Dim iReturn As Integer
        Dim sBack As String = Space(128)
        iReturn = mciSendString("status " & sAlias & " frames skipped", sBack, 128, 0)

        'Retrieve error information
        If iReturn Then GetError(iReturn) : Exit Function

        Return Val(Trim(Replace(sBack, Chr(0), "")))

        mediaErrorCode = 0
        mediaErrorInfo = Nothing

    End Function

    Public Function mediaGetDimentions() As Rectangle

        '--- Help ---
        'Video only!
        'Returns the size and place of your video in pixels.
        'If you want to display the position and size in a
        'messagebox, you could do that like this:
        '   Dim rectDimentions As Rectangle
        '   rectDimentions = mediaGetDimentions()
        '   MsgBox("Left: " & rectDimentions.X & _
        '          "Top: " & rectDimentions.Y & _
        '          "Width: " & rectDimentions.Width & _
        '          "Height: " & rectDimentions.Height)

        '--- Code ---
        'If no alias is set, exit function with an error.
        If NoAlias() Then Exit Function

        Dim iReturn As Integer
        Dim sBack As String = Space(128)
        iReturn = mciSendString("where " & sAlias & " window", sBack, 128, 0)

        'Retrieve error information
        If iReturn Then GetError(iReturn) : Exit Function

        Dim sDimentions() As String
        sDimentions = Split(sBack, " ")
        mediaGetDimentions.X = sDimentions(0)
        mediaGetDimentions.Y = sDimentions(1)
        mediaGetDimentions.Width = sDimentions(2)
        mediaGetDimentions.Height = sDimentions(3)

        mediaErrorCode = 0
        mediaErrorInfo = Nothing

    End Function

    Private Function NoAlias() As Boolean

        If sAlias = "" Then
            Return True
            mediaErrorCode = 1001
            mediaErrorInfo = "No alias has been set."
        Else
            Return False
        End If

    End Function

    Private Sub GetError(ByVal ErrorCode As Long)

        mediaErrorCode = ErrorCode

        'Request error info
        mediaErrorInfo = Space(128)
        mciGetErrorString(mediaErrorCode, mediaErrorInfo, Len(mediaErrorInfo))
        mediaErrorInfo = Trim(Replace(mediaErrorInfo, Chr(0), ""))

        If mediaErrorInfo = "" Then 'Error code is unknown
            mediaErrorInfo = "No error information is available."
        End If

    End Sub

End Module
