VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "cMCI"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit


'=============================================================================================================
'
' cMCI Class Module
' -----------------
'
' Created By  : Kevin Wilson
'               http://www.TheVBZone.com   ( The VB Zone )
'               http://www.TheVBZone.net   ( The VB Zone .net )
'
' Last Update : July 29, 2001
'
' VB Versions : 5.0 / 6.0
'
' Requires    : Sound Card
'
' Description : This class module was created to easily play multimedia files either from a file, or from a
'               resource file that's included in a VB project... all without having to use ActiveX controls
'               that are a pain to redistribute.  This class module also gives you full control over a CD-ROM
'               drive enabling you to play and manipulate audio CD's from it from withing your VB project.
'
'               With this class, you can play the following file types :
'               -  .WAV (WAVE Audio Files)
'               -  .MID (MIDI Sequence Files)
'               -  .AVI (Movie Files)
'               -  CD Audio
'
'               With this class, you can control the following system volumes :
'               -  MASTER Volume
'               -  WAVE Device Volume
'               -  MIDI Device Volume
'               -  CD-ROM Audio Volume
'
'               This class can also be used to extract files from a resource by using the ExtractFromRES method
'
'--------------------------------------------------------------------------------
'                            ~ ABOUT THIS CODE ~
'--------------------------------------------------------------------------------
'
' This class allows you to do the following things, all using the mciSendString
' Windows API alone :
'
'   - Play Wave Files (.WAV) from a file or VB resource
'   - Play MIDI Files (.MID) from a file or VB resource
'   - Play AVI Files (.AVI) from a file or VB resource
'   - Play Audio CD-ROMS
'   - Play Multiple Wave and AVI files simotaniously by using
'     different Device Names (if your sound card supports it)
'   - Play AVI Files inside of other objects given that
'     object's handle alone
'   - Play, Pause, Resume, & Stop Wave, MIDI, and AVI files
'   - Eject and Close the CD-ROM Drive
'   - Play, Pause, Skip Tracks, and Stop Audio CD's on any
'     available CD-ROM drive on your computer given it's letter
'   - Get the status, current playing position, display format,
'     and total number of tracks of an Audio CD-ROM
'   - Extract a file from a VB Resource in your project by
'     it's Type Name and ID Number
'   - Get error messages returned from the mciSendString API
'   - Adjust the volume for the system, WAVE device, MIDI device, & CD-ROM
'
' At this time, this code doesn't support fast forwarding thru
' WAVE, MIDI, AVI, or Audio CD... I may add that ability soon.
' I'm pretty sure this can be accomplished by using the seek
' command and I'll be looking into it.
'
' Also, at this time, this code doesn't support multimedia
' recording... another thing I'd like to add and probibly will.
'
' Visit my web page for updates to this code in the future.
'
'--------------------------------------------------------------------------------
'
' Example Use :
' =============
'
'  ' If you declare the cMCI variable in a sub or function, once the sub
'  ' finishs, the class is terminated and all multimedia is closed.
'  Private MCI As New cMCI
'
'  Private Sub Form_Load()
'
'    Dim MyAnswer As VbMsgBoxResult
'
'    ' Initialize MCI player
'    Set MCI = New cMCI
'    MCI.MCI_ShowErrors = False
'
'    ' Make sure the form is visible
'    Me.Show
'    DoEvents
'
'    ' Play first AVI in the calling form (from a file)
'    MCI.MCI_DeviceID = "AVI1"
'    MCI.MCI_PlayAVI_File "C:\TEMP\1.AVI", , , True, Me.hwnd
'    GoSub ClickOK
'
'    ' Play second AVI in a floating window (from a resource)
'    MCI.MCI_DeviceID = "AVI2"
'    MCI.MCI_PlayAVI_RES "AVI", 1, " TESTING", True
'    GoSub ClickOK
'
'    ' Play first .MID file (from a file)
'    MCI.MCI_DeviceID = "MID1"
'    MCI.MCI_PlayMIDI_File "C:\TEMP\1.MID"
'    GoSub ClickOK
'
'    ' Play second .MID file (from a resource)
'    MCI.MCI_DeviceID = "MID2"
'    MCI.MCI_PlayMIDI_RES "MIDI", 1
'    GoSub ClickOK
'
'    ' Play first .WAV file (from a file)
'    MCI.MCI_DeviceID = "WAV1"
'    MCI.MCI_PlayWAVE_File "C:\TEMP\1.WAV"
'    GoSub ClickOK
'
'    ' Play second .WAV file (from a resource)
'    MCI.MCI_DeviceID = "WAV2"
'    MCI.MCI_PlayWAVE_RES "WAVE", 1
'    GoSub ClickOK
'
'    ' If a CD-ROM drive exists on the system
'    MCI.MCI_DeviceID = "CDROM"
'    If MCI.CheckForCDROM <> 0 Then
'      ' Play track 1 from the CD-ROM
'      MCI.MCI_PlayCDAudio 1
'      GoSub ClickOK
'
'      ' Open then close the CD-ROM drive's door
'      MCI.MCI_CDDoorOpen
'      GoSub ClickOK
'      MCI.MCI_CDDoorClose
'    End If
'
'    Unload Me
'
'    Exit Sub
'
'  ClickOK:
'
'    MyAnswer = MsgBox("Click OK to continue" & Chr(13) & "Click CANCEL to abort", vbOKCancel, "")
'    If MyAnswer = vbCancel Then
'      Unload Me
'      Exit Sub
'    End If
'    Return
'
'  End Sub
'
'=============================================================================================================
'
' LEGAL:
'
' You are free to use this code as long as you keep the above heading information intact and unchanged. Credit
' given where credit is due.  Also, it is not required, but it would be appreciated if you would mention
' somewhere in your compiled program that that your program makes use of code written and distributed by
' Kevin Wilson (www.TheVBZone.com).  Feel free to link to this code via your web site or articles.
'
' You may NOT take this code and pass it off as your own.  You may NOT distribute this code on your own server
' or web site.  You may NOT take code created by Kevin Wilson (www.TheVBZone.com) and use it to create products,
' utilities, or applications that directly compete with products, utilities, and applications created by Kevin
' Wilson, TheVBZone.com, or Wilson Media.  You may NOT take this code and sell it for profit without first
' obtaining the written consent of the author Kevin Wilson.
'
' These conditions are subject to change at the discretion of the owner Kevin Wilson at any time without
' warning or notice.  Copyright© by Kevin Wilson.  All rights reserved.
'
'=============================================================================================================


' Declare Types
Private Type RECT
  Left As Long
  Top As Long
  Right As Long
  Bottom As Long
End Type

Private Const MAXPNAMELEN = 32
Private Const MIXER_LONG_NAME_CHARS = 64
Private Const MIXER_SHORT_NAME_CHARS = 16

Private Type MIXERCONTROLDETAILS_UNSIGNED
  dwValue         As Long
End Type

Private Type MIXERCONTROL
  cbStruct        As Long
  dwControlID     As Long
  dwControlType   As Long
  fdwControl      As Long
  cMultipleItems  As Long
  szShortName     As String * MIXER_SHORT_NAME_CHARS
  szName          As String * MIXER_LONG_NAME_CHARS
  lMinimum        As Long
  lMaximum        As Long
  Reserved(10)    As Long
End Type

Private Type MIXERCONTROLDETAILS
  cbStruct        As Long
  dwControlID     As Long
  cChannels       As Long
  item            As Long
  cbDetails       As Long
  paDetails       As Long
End Type

Private Type MIXERLINE
  cbStruct        As Long
  dwDestination   As Long
  dwSource        As Long
  dwLineID        As Long
  fdwLine         As Long
  dwUser          As Long
  dwComponentType As Long
  cChannels       As Long
  cConnections    As Long
  cControls       As Long
  szShortName     As String * MIXER_SHORT_NAME_CHARS
  szName          As String * MIXER_LONG_NAME_CHARS
  dwType          As Long
  dwDeviceID      As Long
  wMid            As Integer
  wPid            As Integer
  vDriverVersion  As Long
  szPname         As String * MAXPNAMELEN
End Type

Private Type MIXERLINECONTROLS
  cbStruct        As Long
  dwLineID        As Long
  dwControl       As Long
  cControls       As Long
  cbmxctrl        As Long
  pamxctrl        As Long
End Type

' General Constants
Private Const FILE_MAX_PATH As Integer = 255
Private Const FILE_PREFIX As String = "MCI"

' Error Constants
Private Const MMSYSERR_NOERROR = 0
Private Const MCIERR_BASE = 256
Private Const MCIERR_BAD_CONSTANT = (MCIERR_BASE + 34)
Private Const MCIERR_BAD_INTEGER = (MCIERR_BASE + 14)
Private Const MCIERR_BAD_TIME_FORMAT = (MCIERR_BASE + 37)
Private Const MCIERR_CANNOT_LOAD_DRIVER = (MCIERR_BASE + 10)
Private Const MCIERR_CANNOT_USE_ALL = (MCIERR_BASE + 23)
Private Const MCIERR_CREATEWINDOW = (MCIERR_BASE + 91)
Private Const MCIERR_CUSTOM_DRIVER_BASE = (MCIERR_BASE + 256)
Private Const MCIERR_DEVICE_LENGTH = (MCIERR_BASE + 54)
Private Const MCIERR_DEVICE_LOCKED = (MCIERR_BASE + 32)
Private Const MCIERR_DEVICE_NOT_INSTALLED = (MCIERR_BASE + 50)
Private Const MCIERR_DEVICE_NOT_READY = (MCIERR_BASE + 20)
Private Const MCIERR_DEVICE_OPEN = (MCIERR_BASE + 9)
Private Const MCIERR_DEVICE_ORD_LENGTH = (MCIERR_BASE + 55)
Private Const MCIERR_DEVICE_TYPE_REQUIRED = (MCIERR_BASE + 31)
Private Const MCIERR_DRIVER = (MCIERR_BASE + 22)
Private Const MCIERR_DRIVER_INTERNAL = (MCIERR_BASE + 16)
Private Const MCIERR_DUPLICATE_ALIAS = (MCIERR_BASE + 33)
Private Const MCIERR_DUPLICATE_FLAGS = (MCIERR_BASE + 39)
Private Const MCIERR_EXTENSION_NOT_FOUND = (MCIERR_BASE + 25)
Private Const MCIERR_EXTRA_CHARACTERS = (MCIERR_BASE + 49)
Private Const MCIERR_FILE_NOT_FOUND = (MCIERR_BASE + 19)
Private Const MCIERR_FILE_NOT_SAVED = (MCIERR_BASE + 30)
Private Const MCIERR_FILE_READ = (MCIERR_BASE + 92)
Private Const MCIERR_FILE_WRITE = (MCIERR_BASE + 93)
Private Const MCIERR_FILENAME_REQUIRED = (MCIERR_BASE + 48)
Private Const MCIERR_FLAGS_NOT_COMPATIBLE = (MCIERR_BASE + 28)
Private Const MCIERR_GET_CD = (MCIERR_BASE + 51)
Private Const MCIERR_HARDWARE = (MCIERR_BASE + 6)
Private Const MCIERR_ILLEGAL_FOR_AUTO_OPEN = (MCIERR_BASE + 47)
Private Const MCIERR_INTERNAL = (MCIERR_BASE + 21)
Private Const MCIERR_INVALID_DEVICE_ID = (MCIERR_BASE + 1)
Private Const MCIERR_INVALID_DEVICE_NAME = (MCIERR_BASE + 7)
Private Const MCIERR_INVALID_FILE = (MCIERR_BASE + 40)
Private Const MCIERR_MISSING_COMMAND_STRING = (MCIERR_BASE + 11)
Private Const MCIERR_MISSING_DEVICE_NAME = (MCIERR_BASE + 36)
Private Const MCIERR_MISSING_PARAMETER = (MCIERR_BASE + 17)
Private Const MCIERR_MISSING_STRING_ARGUMENT = (MCIERR_BASE + 13)
Private Const MCIERR_MULTIPLE = (MCIERR_BASE + 24)
Private Const MCIERR_MUST_USE_SHAREABLE = (MCIERR_BASE + 35)
Private Const MCIERR_NEW_REQUIRES_ALIAS = (MCIERR_BASE + 43)
Private Const MCIERR_NO_CLOSING_QUOTE = (MCIERR_BASE + 38)
Private Const MCIERR_NO_ELEMENT_ALLOWED = (MCIERR_BASE + 45)
Private Const MCIERR_NO_INTEGER = (MCIERR_BASE + 56)
Private Const MCIERR_NO_WINDOW = (MCIERR_BASE + 90)
Private Const MCIERR_NONAPPLICABLE_FUNCTION = (MCIERR_BASE + 46)
Private Const MCIERR_NOTIFY_ON_AUTO_OPEN = (MCIERR_BASE + 44)
Private Const MCIERR_NULL_PARAMETER_BLOCK = (MCIERR_BASE + 41)
Private Const MCIERR_OUT_OF_MEMORY = (MCIERR_BASE + 8)
Private Const MCIERR_OUTOFRANGE = (MCIERR_BASE + 26)
Private Const MCIERR_PARAM_OVERFLOW = (MCIERR_BASE + 12)
Private Const MCIERR_PARSER_INTERNAL = (MCIERR_BASE + 15)
Private Const MCIERR_SEQ_DIV_INCOMPATIBLE = (MCIERR_BASE + 80)
Private Const MCIERR_SEQ_NOMIDIPRESENT = (MCIERR_BASE + 87)
Private Const MCIERR_SEQ_PORT_INUSE = (MCIERR_BASE + 81)
Private Const MCIERR_SEQ_PORT_MAPNODEVICE = (MCIERR_BASE + 83)
Private Const MCIERR_SEQ_PORT_MISCERROR = (MCIERR_BASE + 84)
Private Const MCIERR_SEQ_PORT_NONEXISTENT = (MCIERR_BASE + 82)
Private Const MCIERR_SEQ_PORTUNSPECIFIED = (MCIERR_BASE + 86)
Private Const MCIERR_SEQ_TIMER = (MCIERR_BASE + 85)
Private Const MCIERR_SET_CD = (MCIERR_BASE + 52)
Private Const MCIERR_SET_DRIVE = (MCIERR_BASE + 53)
Private Const MCIERR_UNNAMED_RESOURCE = (MCIERR_BASE + 42)
Private Const MCIERR_UNRECOGNIZED_COMMAND = (MCIERR_BASE + 5)
Private Const MCIERR_UNRECOGNIZED_KEYWORD = (MCIERR_BASE + 3)
Private Const MCIERR_UNSUPPORTED_FUNCTION = (MCIERR_BASE + 18)
Private Const MCIERR_WAVE_INPUTSINUSE = (MCIERR_BASE + 66)
Private Const MCIERR_WAVE_INPUTSUNSUITABLE = (MCIERR_BASE + 72)
Private Const MCIERR_WAVE_INPUTUNSPECIFIED = (MCIERR_BASE + 69)
Private Const MCIERR_WAVE_OUTPUTSINUSE = (MCIERR_BASE + 64)
Private Const MCIERR_WAVE_OUTPUTSUNSUITABLE = (MCIERR_BASE + 70)
Private Const MCIERR_WAVE_OUTPUTUNSPECIFIED = (MCIERR_BASE + 68)
Private Const MCIERR_WAVE_SETINPUTINUSE = (MCIERR_BASE + 67)
Private Const MCIERR_WAVE_SETINPUTUNSUITABLE = (MCIERR_BASE + 73)
Private Const MCIERR_WAVE_SETOUTPUTINUSE = (MCIERR_BASE + 65)
Private Const MCIERR_WAVE_SETOUTPUTUNSUITABLE = (MCIERR_BASE + 71)

' Drive Identification Constants
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 Const DRIVE_UNKNOWN = 0

' Volume Constants
Private Const MIXERLINE_COMPONENTTYPE_DST_FIRST = &H0&
Private Const MIXERLINE_COMPONENTTYPE_SRC_FIRST = &H1000&
Private Const MIXER_GETLINEINFOF_COMPONENTTYPE = &H3&
Private Const MIXER_GETLINECONTROLSF_ONEBYTYPE = &H2&
Private Const MIXER_SETCONTROLDETAILSF_VALUE = &H0&
Private Const MIXERCONTROL_CT_CLASS_FADER = &H50000000
Private Const MIXERCONTROL_CT_UNITS_UNSIGNED = &H30000
Private Const MIXERCONTROL_CONTROLTYPE_FADER = (MIXERCONTROL_CT_CLASS_FADER Or MIXERCONTROL_CT_UNITS_UNSIGNED)
Private Const MIXERCONTROL_CONTROLTYPE_VOLUME = (MIXERCONTROL_CONTROLTYPE_FADER + 1)
Private Const MIXERLINE_COMPONENTTYPE_DST_DIGITAL = (MIXERLINE_COMPONENTTYPE_DST_FIRST + 1)
Private Const MIXERLINE_COMPONENTTYPE_DST_HEADPHONES = (MIXERLINE_COMPONENTTYPE_DST_FIRST + 5)
Private Const MIXERLINE_COMPONENTTYPE_DST_LAST = (MIXERLINE_COMPONENTTYPE_DST_FIRST + 8)
Private Const MIXERLINE_COMPONENTTYPE_DST_LINE = (MIXERLINE_COMPONENTTYPE_DST_FIRST + 2)
Private Const MIXERLINE_COMPONENTTYPE_DST_MONITOR = (MIXERLINE_COMPONENTTYPE_DST_FIRST + 3)
Private Const MIXERLINE_COMPONENTTYPE_DST_SPEAKERS = (MIXERLINE_COMPONENTTYPE_DST_FIRST + 4)
Private Const MIXERLINE_COMPONENTTYPE_DST_TELEPHONE = (MIXERLINE_COMPONENTTYPE_DST_FIRST + 6)
Private Const MIXERLINE_COMPONENTTYPE_DST_UNDEFINED = (MIXERLINE_COMPONENTTYPE_DST_FIRST + 0)
Private Const MIXERLINE_COMPONENTTYPE_DST_VOICEIN = (MIXERLINE_COMPONENTTYPE_DST_FIRST + 8)
Private Const MIXERLINE_COMPONENTTYPE_DST_WAVEIN = (MIXERLINE_COMPONENTTYPE_DST_FIRST + 7)
Private Const MIXERLINE_COMPONENTTYPE_SRC_ANALOG = (MIXERLINE_COMPONENTTYPE_SRC_FIRST + 10)
Private Const MIXERLINE_COMPONENTTYPE_SRC_AUXILIARY = (MIXERLINE_COMPONENTTYPE_SRC_FIRST + 9)
Private Const MIXERLINE_COMPONENTTYPE_SRC_COMPACTDISC = (MIXERLINE_COMPONENTTYPE_SRC_FIRST + 5)
Private Const MIXERLINE_COMPONENTTYPE_SRC_DIGITAL = (MIXERLINE_COMPONENTTYPE_SRC_FIRST + 1)
Private Const MIXERLINE_COMPONENTTYPE_SRC_LAST = (MIXERLINE_COMPONENTTYPE_SRC_FIRST + 10)
Private Const MIXERLINE_COMPONENTTYPE_SRC_LINE = (MIXERLINE_COMPONENTTYPE_SRC_FIRST + 2)
Private Const MIXERLINE_COMPONENTTYPE_SRC_MICROPHONE = (MIXERLINE_COMPONENTTYPE_SRC_FIRST + 3)
Private Const MIXERLINE_COMPONENTTYPE_SRC_PCSPEAKER = (MIXERLINE_COMPONENTTYPE_SRC_FIRST + 7)
Private Const MIXERLINE_COMPONENTTYPE_SRC_SYNTHESIZER = (MIXERLINE_COMPONENTTYPE_SRC_FIRST + 4)
Private Const MIXERLINE_COMPONENTTYPE_SRC_TELEPHONE = (MIXERLINE_COMPONENTTYPE_SRC_FIRST + 6)
Private Const MIXERLINE_COMPONENTTYPE_SRC_UNDEFINED = (MIXERLINE_COMPONENTTYPE_SRC_FIRST + 0)
Private Const MIXERLINE_COMPONENTTYPE_SRC_WAVEOUT = (MIXERLINE_COMPONENTTYPE_SRC_FIRST + 8)

' Declare Variables
Private strTempPath    As String
Private strTempFile    As String
Private strDeviceID    As String
Private strDevice()    As String
Private lngDevices     As Long
Private strTemp_File() As String
Private lngTemp_Files  As Long
Private strTemp_Info() As String
Private lngTemp_Infos  As Long
Private ReturnValue    As Long
Private lngLastError   As Long
Private boolShowErrors As Boolean
Private boolMCIIsOpen  As Boolean
Private boolShutItDown As Boolean
Private CDFormat       As String
Private VolCtrl_Sys    As MIXERCONTROL
Private VolCtrl_Wav    As MIXERCONTROL
Private VolCtrl_Mid    As MIXERCONTROL
Private VolCtrl_CD     As MIXERCONTROL
Private VolMin_Sys     As Long
Private VolMax_Sys     As Long
Private VolMin_Wav     As Long
Private VolMax_Wav     As Long
Private VolMin_Mid     As Long
Private VolMax_Mid     As Long
Private VolMin_CD      As Long
Private VolMax_CD      As Long
Private hMixer         As Long

' Declare API Functions/Subs
Private Declare Sub CopyStructFromPtr Lib "KERNEL32" Alias "RtlMoveMemory" (struct As Any, ByVal ptr As Long, ByVal cb As Long)
Private Declare Sub CopyPtrFromStruct Lib "KERNEL32" Alias "RtlMoveMemory" (ByVal ptr As Long, struct As Any, ByVal cb As Long)
Private Declare Function FindWindow Lib "USER32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetTempPath Lib "KERNEL32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Private Declare Function GetTempFileName Lib "KERNEL32" Alias "GetTempFileNameA" (ByVal lpszPath As String, ByVal lpPrefixString As String, ByVal wUnique As Long, ByVal lpTempFileName As String) As Long
Private Declare Function GetWindowRect Lib "USER32" (ByVal hWnd As Long, lpRect As RECT) As Long
Private Declare Function SetWindowText Lib "USER32" Alias "SetWindowTextA" (ByVal hWnd As Long, ByVal LPString As String) As Long
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 MoveWindow Lib "USER32" (ByVal hWnd As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long
Private Declare Function GetDriveTypeA Lib "KERNEL32" (ByVal nDrive As String) As Long
Private Declare Function mixerClose Lib "winmm.dll" (ByVal hMixer As Long) As Long
Private Declare Function mixerGetLineControls Lib "winmm.dll" Alias "mixerGetLineControlsA" (ByVal hMixerObj As Long, pMixerLc As MIXERLINECONTROLS, ByVal fdwControls As Long) As Long
Private Declare Function mixerGetLineInfo Lib "winmm.dll" Alias "mixerGetLineInfoA" (ByVal hMixerObj As Long, pMixerL As MIXERLINE, ByVal fdwInfo As Long) As Long
Private Declare Function mixerOpen Lib "winmm.dll" (ByRef phMixer As Long, ByVal uMxId As Long, ByVal dwCallback As Long, ByVal dwInstance As Long, ByVal fdwOpen As Long) As Long
Private Declare Function mixerSetControlDetails Lib "winmm.dll" (ByVal hMixerObj As Long, pMixerCD As MIXERCONTROLDETAILS, ByVal fdwDetails As Long) As Long
Private Declare Function GlobalAlloc Lib "KERNEL32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalLock Lib "KERNEL32" (ByVal hMem As Long) As Long
Private Declare Function GlobalFree Lib "KERNEL32" (ByVal hMem As Long) As Long


'=============================================================================================================
'                           CLASS INITIALIZATIONS
'=============================================================================================================


' This is the first thing that executes in the Class module
Private Sub Class_Initialize()
On Error Resume Next
  
  Dim ReturnOK As Boolean
  
  ' Set the default Device ID name to "TheDevice"
  strDeviceID = "TheDevice"
  
  ' Set the default CD display to milliseconds
  CDFormat = "m"
  
  ' Record the device name so it can be shut down later
  lngDevices = lngDevices + 1
  ReDim strDevice(lngDevices) As String
  strDevice(lngDevices) = strDeviceID
  
  ' Open the volume mixer with deviceID 0
  If mixerOpen(hMixer, 0, 0, 0, 0) <> MMSYSERR_NOERROR Then
    If boolShowErrors = True Then
      MsgBox "An error occured while trying to access the volume mixer.", vbOKOnly + vbExclamation, "  Error Opening Volume Mixer"
    End If
  End If
  
  ' Get SYSTEM VOLUME information
  ReturnOK = False
  ReturnOK = MCI_VolumeGet(hMixer, MIXERLINE_COMPONENTTYPE_DST_SPEAKERS, MIXERCONTROL_CONTROLTYPE_VOLUME, VolCtrl_Sys)
  If ReturnOK = True Then
    VolMax_Sys = VolCtrl_Sys.lMaximum
    VolMin_Sys = VolCtrl_Sys.lMinimum
  End If
  
  ' Get WAVE VOLUME information
  ReturnOK = False
  ReturnOK = MCI_VolumeGet(hMixer, MIXERLINE_COMPONENTTYPE_SRC_WAVEOUT, MIXERCONTROL_CONTROLTYPE_VOLUME, VolCtrl_Wav)
  If ReturnOK = True Then
    VolMax_Wav = VolCtrl_Wav.lMaximum
    VolMin_Wav = VolCtrl_Wav.lMinimum
  End If
  
  ' Get MIDI VOLUME information
  ReturnOK = False
  ReturnOK = MCI_VolumeGet(hMixer, MIXERLINE_COMPONENTTYPE_SRC_SYNTHESIZER, MIXERCONTROL_CONTROLTYPE_VOLUME, VolCtrl_Mid)
  If ReturnOK = True Then
    VolMax_Mid = VolCtrl_Mid.lMaximum
    VolMin_Mid = VolCtrl_Mid.lMinimum
  End If
  
  ' Get CD-ROM VOLUME information
  ReturnOK = False
  ReturnOK = MCI_VolumeGet(hMixer, MIXERLINE_COMPONENTTYPE_SRC_COMPACTDISC, MIXERCONTROL_CONTROLTYPE_VOLUME, VolCtrl_CD)
  If ReturnOK = True Then
    VolMax_CD = VolCtrl_CD.lMaximum
    VolMin_CD = VolCtrl_CD.lMinimum
  End If
  
End Sub

' This is the last thing that executes in the Class module before it's destroyed
Private Sub Class_Terminate()
On Error Resume Next
  
  Dim MyCounter As Long
  
  boolShutItDown = True
  Close
  
  ' Close all devices that have been opened
  For MyCounter = 0 To lngDevices
    If strDevice(MyCounter) <> "" Then
      strDeviceID = strDevice(MyCounter)
      MCI_Stop
      MCI_Close
    End If
  Next
  
  ' Delete all the temp files that have been created by this program
  CleanUpTempFiles
  
  ' Close the mixer
  mixerClose hMixer
  
  ' Free up the variable arrays
  Erase strDevice
  Erase strTemp_File
  Erase strTemp_Info
  
End Sub


'=============================================================================================================
'                             CLASS PROPERTIES
'=============================================================================================================


' Returns what the current position format is set to
' *NOTE: Valid options are 'm', 'msf', & 'tmsf'
Public Property Get MCI_CDDisplayFormat() As String
On Error Resume Next
  
  MCI_CDDisplayFormat = CDFormat
  
End Property

' Sets what the current position format is set to
' *NOTE: Valid options are 'm', 'msf', & 'tmsf'
Public Property Let MCI_CDDisplayFormat(ByVal NewValue As String)
On Error Resume Next
    
  Dim ReturnString As String * 255
  
  If UCase(NewValue) <> "M" And UCase(NewValue) <> "MSF" And UCase(NewValue) <> "TMSF" Then
    If boolShowErrors = True Then
      MsgBox "MCI_CDDisplayFormat value can only be one of the following:" & Chr(13) & Chr(13) & "'m'  =  Milliseconds" & Chr(13) & "'msf'  =  Min, Sec, Frame" & Chr(13) & "'tmsf'  =  Track, Min, Sec, Frame", vbOKOnly + vbExclamation, "  Invalid Property"
    End If
    CDFormat = "m"
    Exit Property
  End If
  
  ReturnValue = mciSendString("set " & strDeviceID & " time format " & LCase(NewValue), 0&, 0, 0)
  ' Check if errors occured
  If ReturnValue <> 0 And ReturnValue <> 289 And ReturnValue <> 263 Then
    MCI_GetErrorMsg ReturnValue
    Exit Property
  End If
  
  CDFormat = NewValue
  
End Property

' Return how many tracks are on the current Audio CD-ROM
Public Property Get MCI_CDNumberOfTracks() As Integer
On Error Resume Next
  
  Dim ReturnString As String * 255
  
  ReturnValue = mciSendString("status " & strDeviceID & " number of tracks", ReturnString, 255, 0)
  ' Check if errors occured
  If ReturnValue <> 0 And ReturnValue <> 289 And ReturnValue <> 263 Then
    MCI_GetErrorMsg ReturnValue
    Exit Property
  End If
  
  If InStr(ReturnString, Chr(0)) > 1 Then
    MCI_CDNumberOfTracks = CInt(Left(ReturnString, (InStr(ReturnString, Chr(0)) - 1)))
  End If
  
End Property

' Returns what the current status of the CD-ROM drive is
Public Property Get MCI_CDStatus() As String
On Error Resume Next
  
  Dim ReturnString As String * 255
  
  ReturnValue = mciSendString("status " & strDeviceID & " ready", ReturnString, 255, 0)
  
  ' Check if errors occured
  If ReturnValue <> 0 And ReturnValue <> 289 And ReturnValue <> 263 Then
    MCI_GetErrorMsg ReturnValue
    Exit Property
  End If
  
  If UCase(Left(ReturnString, (InStr(ReturnString, Chr(0)) - 1))) = "TRUE" Then
    MCI_CDStatus = "Ready"
  Else
    
    ReturnValue = mciSendString("status " & strDeviceID & " mode", ReturnString, 255, 0)
    
    ' Check if errors occured
    If ReturnValue <> 0 And ReturnValue <> 289 And ReturnValue <> 263 Then
      MCI_GetErrorMsg ReturnValue
      Exit Property
    End If
    
    MCI_CDStatus = Left(ReturnString, (InStr(ReturnString, Chr(0)) - 1))
  
  End If
  
End Property

' Returns the current reading position of the Audio CD-ROM
Public Property Get MCI_CDPosition(Optional ReturnTrackPos As Boolean = False, Optional CurrentTrack As Integer) As String
On Error Resume Next
  
  Dim ReturnString As String * 255
  
  If ReturnTrackPos = True Then
    ReturnValue = mciSendString("status " & strDeviceID & " position track " & CStr(CurrentTrack), ReturnString, 255, 0)
  Else
    ReturnValue = mciSendString("status " & strDeviceID & " position", ReturnString, 255, 0)
  End If
  
  ' Check if errors occured
  If ReturnValue <> 0 And ReturnValue <> 289 And ReturnValue <> 263 Then
    MCI_GetErrorMsg ReturnValue
    Exit Property
  End If
  
  MCI_CDPosition = Left(ReturnString, (InStr(ReturnString, Chr(0)) - 1))
  
End Property

' Returns the last error that occured
' if the value is returned as 0, there has been no error encountered yet
Public Property Get MCI_LastError() As Long
On Error Resume Next
  
  MCI_LastError = lngLastError
  
End Property

' Returns the current Device ID name
' The default is set to "TheDevice" in the Class_Initialize event
Public Property Get MCI_DeviceID() As String
On Error Resume Next
  
  MCI_DeviceID = strDeviceID
  
End Property

' Sets the Device ID name to use
Public Property Let MCI_DeviceID(ByVal NewValue As String)
On Error Resume Next
  
  If NewValue <> "" Then
    ' Set the new device name
    strDeviceID = NewValue
    ' Record the device name so it can be shut down later
    lngDevices = lngDevices + 1
    ReDim Preserve strDevice(lngDevices) As String
    strDevice(lngDevices) = NewValue
  Else
    If boolShowErrors = True Then
      MsgBox "Invalid Device ID Specified :" & Chr(13) & "You can't specify BLANK as your Device ID.", vbOKOnly + vbExclamation, "  Invlid Device ID"
    End If
  End If
  
End Property

' Returns if the program will show error messages when errors occur
' False = the default
Public Property Get MCI_ShowErrors() As Boolean
On Error Resume Next
  
  MCI_ShowErrors = boolShowErrors
  
End Property

' Sets if the program will show error messages when errors occur
Public Property Let MCI_ShowErrors(ByVal NewValue As Boolean)
On Error Resume Next
  
  boolShowErrors = NewValue
  
End Property

Public Property Let MCI_VolumeSystem(ByVal NewValue As Long)
  
  ' Make sure value passed is valid
  If NewValue > VolMax_Sys Then
    NewValue = VolMax_Sys
  ElseIf NewValue < VolMin_Sys Then
    NewValue = VolMin_Sys
  End If
  
  ' Set the mixer's volume
  MCI_VolumeSet hMixer, VolCtrl_Sys, NewValue
  
End Property

Public Property Get MCI_VolumeSystem_Max() As Long
  
  MCI_VolumeSystem_Max = VolMax_Sys
  
End Property

Public Property Get MCI_VolumeSystem_Min() As Long
  
  MCI_VolumeSystem_Min = VolMin_Sys
  
End Property

Public Property Let MCI_VolumeWAVE(ByVal NewValue As Long)
  
  ' Make sure value passed is valid
  If NewValue > VolMax_Wav Then
    NewValue = VolMax_Sys
  ElseIf NewValue < VolMin_Wav Then
    NewValue = VolMin_Sys
  End If
  
  ' Set the mixer's volume
  MCI_VolumeSet hMixer, VolCtrl_Wav, NewValue
  
End Property

Public Property Get MCI_VolumeWAVE_Max() As Long
  
  MCI_VolumeWAVE_Max = VolMax_Wav
  
End Property

Public Property Get MCI_VolumeWAVE_Min() As Long
  
  MCI_VolumeWAVE_Min = VolMin_Wav
  
End Property

Public Property Let MCI_VolumeMIDI(ByVal NewValue As Long)
  
  ' Make sure value passed is valid
  If NewValue > VolMax_Mid Then
    NewValue = VolMax_Sys
  ElseIf NewValue < VolMin_Mid Then
    NewValue = VolMin_Sys
  End If
  
  ' Set the mixer's volume
  MCI_VolumeSet hMixer, VolCtrl_Mid, NewValue
  
End Property

Public Property Get MCI_VolumeMIDI_Max() As Long
  
  MCI_VolumeMIDI_Max = VolMax_Mid
  
End Property

Public Property Get MCI_VolumeMIDI_Min() As Long
  
  MCI_VolumeMIDI_Min = VolMin_Mid
  
End Property

Public Property Let MCI_VolumeCD(ByVal NewValue As Long)
  
  ' Make sure value passed is valid
  If NewValue > VolMax_CD Then
    NewValue = VolMax_CD
  ElseIf NewValue < VolMin_CD Then
    NewValue = VolMin_CD
  End If
  
  ' Set the mixer's volume
  MCI_VolumeSet hMixer, VolCtrl_CD, NewValue
  
End Property

Public Property Get MCI_VolumeCD_Max() As Long
  
  MCI_VolumeCD_Max = VolMax_CD
  
End Property

Public Property Get MCI_VolumeCD_Min() As Long
  
  MCI_VolumeCD_Min = VolMin_CD
  
End Property


'=============================================================================================================
'                                CLASS METHODS
'=============================================================================================================


' Function to find the MCI Error message based on the mciSendString return value
Public Function MCI_GetErrorMsg(mciSendStringResult As Long)
On Error Resume Next
  
  Dim ErrMsg As String
  
  Select Case mciSendStringResult
    Case MCIERR_BAD_CONSTANT
      ErrMsg = "Bad Constant"
    Case MCIERR_BAD_INTEGER
      ErrMsg = "Bad Gnteger"
    Case MCIERR_BAD_TIME_FORMAT
      ErrMsg = "Bad Time Format"
    Case MCIERR_CANNOT_LOAD_DRIVER
      ErrMsg = "Can't Load Driver"
    Case MCIERR_CANNOT_USE_ALL
      ErrMsg = "Can Not Use All"
    Case MCIERR_CREATEWINDOW
      ErrMsg = "Create Window"
    Case MCIERR_CUSTOM_DRIVER_BASE
      ErrMsg = "Custom Driver Base"
    Case MCIERR_DEVICE_LENGTH
      ErrMsg = "Device Length"
    Case MCIERR_DEVICE_LOCKED
      ErrMsg = "Device Locked"
    Case MCIERR_DEVICE_NOT_INSTALLED
      ErrMsg = "Device Not Installed"
    Case MCIERR_DEVICE_NOT_READY
      ErrMsg = "Device Not Ready"
    Case MCIERR_DEVICE_OPEN
      ErrMsg = "Device Open"
    Case MCIERR_DEVICE_ORD_LENGTH
      ErrMsg = "Device ord length"
    Case MCIERR_DEVICE_TYPE_REQUIRED
      ErrMsg = "Device Type Required"
    Case MCIERR_DRIVER
      ErrMsg = "Driver"
    Case MCIERR_DRIVER_INTERNAL
      ErrMsg = "Driver Internal"
    Case MCIERR_DUPLICATE_ALIAS
      ErrMsg = "Duplicate Alias"
    Case MCIERR_DUPLICATE_FLAGS
      ErrMsg = "Duplicate Flags"
    Case MCIERR_EXTENSION_NOT_FOUND
      ErrMsg = "Extension Not Found"
    Case MCIERR_EXTRA_CHARACTERS
      ErrMsg = "Extra Characters"
    Case MCIERR_FILE_NOT_FOUND
      ErrMsg = "File Not Found"
    Case MCIERR_FILE_NOT_SAVED
      ErrMsg = "File Not Saved"
    Case MCIERR_FILE_READ
      ErrMsg = "File Read"
    Case MCIERR_FILE_WRITE
      ErrMsg = "File Write"
    Case MCIERR_FILENAME_REQUIRED
      ErrMsg = "Filename Required"
    Case MCIERR_FLAGS_NOT_COMPATIBLE
      ErrMsg = "Flags Not Compatible"
    Case MCIERR_GET_CD
      ErrMsg = "Get CD"
    Case MCIERR_HARDWARE
      ErrMsg = "Hardware"
    Case MCIERR_ILLEGAL_FOR_AUTO_OPEN
      ErrMsg = "Illegal For Auto Open"
    Case MCIERR_INTERNAL
      ErrMsg = "Internal"
    Case MCIERR_INVALID_DEVICE_ID
      ErrMsg = "Invalid Device ID"
    Case MCIERR_INVALID_DEVICE_NAME
      ErrMsg = "Invalid Device Name"
    Case MCIERR_INVALID_FILE
      ErrMsg = "Invalid File"
    Case MCIERR_MISSING_COMMAND_STRING
      ErrMsg = "Missing Command String"
    Case MCIERR_MISSING_DEVICE_NAME
      ErrMsg = "Missing Device Name"
    Case MCIERR_MISSING_PARAMETER
      ErrMsg = "Missing Parameter"
    Case MCIERR_MISSING_STRING_ARGUMENT
      ErrMsg = "Missing String Arguments"
    Case MCIERR_MULTIPLE
      ErrMsg = "Multiple"
    Case MCIERR_MUST_USE_SHAREABLE
      ErrMsg = "Must Use Shareable"
    Case MCIERR_NEW_REQUIRES_ALIAS
      ErrMsg = "New Requires Alias"
    Case MCIERR_NO_CLOSING_QUOTE
      ErrMsg = "No Closing Quote"
    Case MCIERR_NO_ELEMENT_ALLOWED
      ErrMsg = "No Element Allowed"
    Case MCIERR_NO_INTEGER
      ErrMsg = "No Integer"
    Case MCIERR_NO_WINDOW
      ErrMsg = "No Window"
    Case MCIERR_NONAPPLICABLE_FUNCTION
      ErrMsg = "Nonapplicable Function"
    Case MCIERR_NOTIFY_ON_AUTO_OPEN
      ErrMsg = "Notify On Auto Open"
    Case MCIERR_NULL_PARAMETER_BLOCK
      ErrMsg = "Null Parameter Block"
    Case MCIERR_OUT_OF_MEMORY
      ErrMsg = "Out Of Memory"
    Case MCIERR_OUTOFRANGE
      ErrMsg = "Out of Range"
    Case MCIERR_PARAM_OVERFLOW
      ErrMsg = "Param Overflow"
    Case MCIERR_PARSER_INTERNAL
      ErrMsg = "Parser Internal"
    Case MCIERR_SEQ_DIV_INCOMPATIBLE
      ErrMsg = "Seq - Div Incompatible"
    Case MCIERR_SEQ_NOMIDIPRESENT
      ErrMsg = "Seq - No Midi Present"
    Case MCIERR_SEQ_PORT_INUSE
      ErrMsg = "Seq - Port In Use"
    Case MCIERR_SEQ_PORT_MAPNODEVICE
      ErrMsg = "Seq - Port Map No Device"
    Case MCIERR_SEQ_PORT_MISCERROR
      ErrMsg = "Seq - Port Misc Error"
    Case MCIERR_SEQ_PORT_NONEXISTENT
      ErrMsg = "Seq - Port Nonexistent"
    Case MCIERR_SEQ_PORTUNSPECIFIED
      ErrMsg = "Seq - Port Unspecified"
    Case MCIERR_SEQ_TIMER
      ErrMsg = "Seq - Timer"
    Case MCIERR_SET_CD
      ErrMsg = "Set CD"
    Case MCIERR_SET_DRIVE
      ErrMsg = "Set Drive"
    Case MCIERR_UNNAMED_RESOURCE
      ErrMsg = "Unnamed Resource"
    Case MCIERR_UNRECOGNIZED_COMMAND
      ErrMsg = "Unrecognized Command"
    Case MCIERR_UNRECOGNIZED_KEYWORD
      ErrMsg = "Unrecognized Keyword"
    Case MCIERR_UNSUPPORTED_FUNCTION
      ErrMsg = "Unsupported Function"
    Case MCIERR_WAVE_INPUTSINUSE
      ErrMsg = "Wave - Input In Use"
    Case MCIERR_WAVE_INPUTSUNSUITABLE
      ErrMsg = "Wave - Input Unsuitable"
    Case MCIERR_WAVE_INPUTUNSPECIFIED
      ErrMsg = "Wave - Input Unspecified"
    Case MCIERR_WAVE_OUTPUTSINUSE
      ErrMsg = "Wave - Output In Use"
    Case MCIERR_WAVE_OUTPUTSUNSUITABLE
      ErrMsg = "Wave - Output unsuitable"
    Case MCIERR_WAVE_OUTPUTUNSPECIFIED
      ErrMsg = "Wave - Output unspecified"
    Case MCIERR_WAVE_SETINPUTINUSE
      ErrMsg = "Wave - Set Input In Use"
    Case MCIERR_WAVE_SETINPUTUNSUITABLE
      ErrMsg = "Wave - Set Input Unsuitable"
    Case MCIERR_WAVE_SETOUTPUTINUSE
      ErrMsg = "Wave - Set Output In Use"
    Case MCIERR_WAVE_SETOUTPUTUNSUITABLE
      ErrMsg = "Wave - Set Output Unsuitable"
  End Select
  
  If boolShowErrors = True Then
    If ErrMsg <> "" Then
      MsgBox "The mciSendString function encountered the following error :" & Chr(13) & Chr(13) & ErrMsg, vbOKOnly + vbExclamation, "  Multimedia Error Occured"
    Else
      MsgBox "The mciSendString function encountered an unspecified error.", vbOKOnly + vbExclamation, "  Unspecified Error Occured"
    End If
  End If
  
End Function

' Open the CD-ROM door
Public Function MCI_CDDoorOpen() As Boolean
On Error GoTo ErrorTrap
  
  If CheckForCDROM = 0 Then
    If boolShowErrors = True Then
      MsgBox "There were no CD-ROM drives detected on your machine." & Chr(13) & "Can't open CD-ROM door.", vbOKOnly + vbExclamation, "  No CD-ROM To Open"
      Exit Function
    End If
  End If
  
  MCI_Stop
  MCI_Close
  
  ReturnValue = mciSendString("Set cdaudio door open wait", 0&, 0, 0)
  
  ' Check if errors occured while opening
  If ReturnValue <> 0 Then
    MCI_GetErrorMsg ReturnValue
    Exit Function
  End If
  
  MCI_CDDoorOpen = True
  
  Exit Function
  
ErrorTrap:
  
  If Err.Number = 0 Then      ' No Error
    Resume Next
  ElseIf Err.Number = 20 Then ' Resume Without Error
    Resume Next
  Else                        ' Other Error
    ErrMsg Err.Source, Err.Number, Err.Description
  End If

End Function

' Close the CD-ROM door
Public Function MCI_CDDoorClose() As Boolean
On Error GoTo ErrorTrap
  
  If CheckForCDROM = 0 Then
    If boolShowErrors = True Then
      MsgBox "There were no CD-ROM drives detected on your machine." & Chr(13) & "Can't close CD-ROM door.", vbOKOnly + vbExclamation, "  No CD-ROM To Close"
      Exit Function
    End If
  End If
  
  ReturnValue = mciSendString("Set cdaudio door closed wait", 0&, 0, 0)
  
  ' Check if errors occured while opening
  If ReturnValue <> 0 Then
    MCI_GetErrorMsg ReturnValue
    Exit Function
  End If
  
  MCI_CDDoorClose = True
  
  Exit Function
  
ErrorTrap:
  
  If Err.Number = 0 Then      ' No Error
    Resume Next
  ElseIf Err.Number = 20 Then ' Resume Without Error
    Resume Next
  Else                        ' Other Error
    ErrMsg Err.Source, Err.Number, Err.Description
  End If

End Function

' Play an Audio CD-ROM by the specified drive
Public Function MCI_PlayCDAudio(TrackToPlay As Integer, Optional CDDriveLetter As String = "") As Boolean
On Error GoTo ErrorTrap
  
  Dim intTracks As Integer
  Dim ReturnString As String * 255
  
  ' Check for valid drive letter
  If CDDriveLetter <> "" Then
    If Len(CDDriveLetter) > 1 Or IsNumeric(CDDriveLetter) = True Then
      If boolShowErrors = True Then
        MsgBox "Invalid CD-ROM drive specified to play.", vbOKOnly + vbExclamation, "  Invalid CD-ROM Drive"
        Exit Function
      End If
    ' Check if computer has a CD-ROM to play
    ElseIf CheckDriveType(CDDriveLetter) <> "CD-ROM" Then
      If boolShowErrors = True Then
        MsgBox "Drive letter specified is not a CD-ROM drive.", vbOKOnly + vbExclamation, "  Invalid CD-ROM Drive"
        Exit Function
      End If
    End If
  End If
  
  ' Close the MCI device if it's currently open
  MCI_Stop
  MCI_Close
  
  ' Open the CD Audio device
  If CDDriveLetter <> "" Then
    ReturnValue = mciSendString("open " & LCase(CDDriveLetter) & ": type cdaudio alias " & strDeviceID, 0&, 0, 0)
  Else
    ReturnValue = mciSendString("open cdaudio alias " & strDeviceID, 0&, 0, 0)
  End If
  ' Check if errors occured while opening
  If ReturnValue <> 0 And ReturnValue <> 289 And ReturnValue <> 263 Then
    MCI_GetErrorMsg ReturnValue
    Exit Function
  End If
  
  ' Set the position format
  boolMCIIsOpen = True
  mciSendString "set " & strDeviceID & " time format " & CDFormat, 0&, 0, 0
  
  ' Check how many tracks are on the Audio CD-ROM
  mciSendString "status " & strDeviceID & " number of tracks", ReturnString, 255, 0
  If InStr(ReturnString, Chr(0)) > 1 Then
    intTracks = CInt(Left(ReturnString, (InStr(ReturnString, Chr(0)) - 1)))
  End If
  
  ' Play the track specified
  If TrackToPlay > intTracks Then
    ReturnValue = mciSendString("play " & strDeviceID & " from " & intTracks, 0&, 0, 0)
  ElseIf TrackToPlay = 1 Or TrackToPlay = intTracks Then
    ReturnValue = mciSendString("play " & strDeviceID & " from " & TrackToPlay, 0&, 0, 0)
  Else
    ReturnValue = mciSendString("play " & strDeviceID & " from " & TrackToPlay & " to " & TrackToPlay + 1, 0&, 0, 0)
  End If
  ' Check for errors while playing
  If ReturnValue <> 0 And ReturnValue <> 289 And ReturnValue <> 263 Then
    MCI_GetErrorMsg ReturnValue
    Exit Function
  End If
  
  MCI_PlayCDAudio = True
  
  Exit Function
  
ErrorTrap:
  
  If Err.Number = 0 Then      ' No Error
    Resume Next
  ElseIf Err.Number = 20 Then ' Resume Without Error
    Resume Next
  Else                        ' Other Error
    ErrMsg Err.Source, Err.Number, Err.Description
  End If
  
End Function

' Play a .WAV file from a VB Resource in your project
Public Function MCI_PlayWAVE_RES(RES_Type As String, RES_ID As Long) As Boolean
On Error GoTo ErrorTrap
  
  ' Close the MCI device if it's currently open
  If boolMCIIsOpen = True Then
    MCI_Stop
    MCI_Close
    boolMCIIsOpen = False
  End If
  
  ' Extract the .WAV file from the resource using the given info on it
  If ExtractFromRES(RES_Type, RES_ID) = False Then
    Exit Function
  End If
  
  ' Open the WAVE device
  ReturnValue = mciSendString("open waveaudio!" & strTempFile & " alias " & strDeviceID, 0&, 0, 0)
  ' Check if errors occured while opening
  If ReturnValue <> 0 And ReturnValue <> 289 And ReturnValue <> 263 Then
    MCI_GetErrorMsg ReturnValue
    Exit Function
  End If
  
  boolMCIIsOpen = True
  
  ' The notify tells the MCI command to return control to the application
  ReturnValue = mciSendString("play " & strDeviceID & " notify", 0&, 0, 0)
  ' Check for errors while playing
  If ReturnValue <> 0 And ReturnValue <> 289 And ReturnValue <> 263 Then
    MCI_GetErrorMsg ReturnValue
    Exit Function
  End If
  
  MCI_PlayWAVE_RES = True
  
  Exit Function
  
ErrorTrap:
  
  If Err.Number = 0 Then      ' No Error
    Resume Next
  ElseIf Err.Number = 20 Then ' Resume Without Error
    Resume Next
  Else                        ' Other Error
    ErrMsg Err.Source, Err.Number, Err.Description
  End If
  
End Function

' Play a .WAV file from the specified file on the hard drive
Public Function MCI_PlayWAVE_File(WAVEFilePath As String) As Boolean
On Error GoTo ErrorTrap
  
  ' Close the MCI device if it's currently open
  If boolMCIIsOpen = True Then
    MCI_Stop
    MCI_Close
    boolMCIIsOpen = False
  End If
  
  ' Make sure file exists
  If Dir(WAVEFilePath) = "" Then
    If boolShowErrors = True Then
      MsgBox WAVEFilePath & Chr(13) & Chr(13) & "The specified file does not exist.", vbOKOnly + vbExclamation, "  File Not Found"
    End If
    Exit Function
  End If
  
  ' Open the WAVE device
  ReturnValue = mciSendString("open waveaudio!" & WAVEFilePath & " alias " & strDeviceID, 0&, 0, 0)
  ' Check if errors occured while opening
  If ReturnValue <> 0 And ReturnValue <> 289 And ReturnValue <> 263 Then
    MCI_GetErrorMsg ReturnValue
    Exit Function
  End If
  
  boolMCIIsOpen = True
  
  ' The notify tells the MCI command to return control to the application
  ReturnValue = mciSendString("play " & strDeviceID & " notify", 0&, 0, 0)
  ' Check for errors while playing
  If ReturnValue <> 0 And ReturnValue <> 289 And ReturnValue <> 263 Then
    MCI_GetErrorMsg ReturnValue
    Exit Function
  End If
  
  MCI_PlayWAVE_File = True
  
  Exit Function
  
ErrorTrap:
  
  If Err.Number = 0 Then      ' No Error
    Resume Next
  ElseIf Err.Number = 20 Then ' Resume Without Error
    Resume Next
  Else                        ' Other Error
    ErrMsg Err.Source, Err.Number, Err.Description
  End If
  
End Function

' Play a .MID file from a VB Resource in your project
Public Function MCI_PlayMIDI_RES(RES_Type As String, RES_ID As Long) As Boolean
On Error GoTo ErrorTrap
  
  ' Close the MCI device if it's currently open
  If boolMCIIsOpen = True Then
    MCI_Stop
    MCI_Close
    boolMCIIsOpen = False
  End If
  
  ' Extract the .MID file from the resource using the given info on it
  If ExtractFromRES(RES_Type, RES_ID) = False Then
    Exit Function
  End If
  
  ' Open the MIDI device
  ReturnValue = mciSendString("open sequencer!" & strTempFile & " alias " & strDeviceID, 0&, 0, 0)
  ' Check if errors occured while opening
  If ReturnValue <> 0 And ReturnValue <> 289 And ReturnValue <> 263 Then
    MCI_GetErrorMsg ReturnValue
    Exit Function
  End If
  
  boolMCIIsOpen = True
  
  ' The notify tells the MCI command to return control to the application
  ReturnValue = mciSendString("play " & strDeviceID & " notify", 0&, 0, 0)
  ' Check for errors while playing
  If ReturnValue <> 0 And ReturnValue <> 289 And ReturnValue <> 263 Then
    MCI_GetErrorMsg ReturnValue
    Exit Function
  End If
  
  MCI_PlayMIDI_RES = True
  
  Exit Function
  
ErrorTrap:
  
  If Err.Number = 0 Then      ' No Error
    Resume Next
  ElseIf Err.Number = 20 Then ' Resume Without Error
    Resume Next
  Else                        ' Other Error
    ErrMsg Err.Source, Err.Number, Err.Description
  End If
  
End Function

' Play a .MID file from the specified file on the hard drive
Public Function MCI_PlayMIDI_File(MIDIFilePath As String) As Boolean
On Error GoTo ErrorTrap
  
  ' Close the MCI device if it's currently open
  If boolMCIIsOpen = True Then
    MCI_Stop
    MCI_Close
    boolMCIIsOpen = False
  End If
  
  ' Make sure file exists
  If Dir(MIDIFilePath) = "" Then
    If boolShowErrors = True Then
      MsgBox MIDIFilePath & Chr(13) & Chr(13) & "The specified file does not exist.", vbOKOnly + vbExclamation, "  File Not Found"
    End If
    Exit Function
  End If
  
  ' Open the MIDI device
  ReturnValue = mciSendString("open sequencer!" & MIDIFilePath & " alias " & strDeviceID, 0&, 0, 0)
  ' Check if errors occured while opening
  If ReturnValue <> 0 And ReturnValue <> 289 And ReturnValue <> 263 Then
    MCI_GetErrorMsg ReturnValue
    Exit Function
  End If
  
  boolMCIIsOpen = True
  
  ' The notify tells the MCI command to return control to the application
  ReturnValue = mciSendString("play " & strDeviceID & " notify", 0&, 0, 0)
  ' Check for errors while playing
  If ReturnValue <> 0 And ReturnValue <> 289 And ReturnValue <> 263 Then
    MCI_GetErrorMsg ReturnValue
    Exit Function
  End If
  
  MCI_PlayMIDI_File = True
  
  Exit Function
  
ErrorTrap:
  
  If Err.Number = 0 Then      ' No Error
    Resume Next
  ElseIf Err.Number = 20 Then ' Resume Without Error
    Resume Next
  Else                        ' Other Error
    ErrMsg Err.Source, Err.Number, Err.Description
  End If
  
End Function

' Play an .AVI file from a VB Resource in your project
Public Function MCI_PlayAVI_RES(RES_Type As String, RES_ID As Long, Optional WindowName As String = "", Optional CenterWindow As Boolean = False, Optional PlayInObject As Boolean = False, Optional ParentObjectHandle As Long = 0) As Boolean
On Error GoTo ErrorTrap
  
  Dim TheHandle As Long
  Dim WindowInfo As RECT
  Dim AVIHeight As Long
  Dim AVIWidth As Long
  
  ' Close the MCI device if it's currently open
  If boolMCIIsOpen = True Then
    MCI_Stop
    MCI_Close
    boolMCIIsOpen = False
  End If
  
  ' Extract the .AVI file from the resource using the given info on it
  If ExtractFromRES(RES_Type, RES_ID) = False Then
    Exit Function
  End If
  
  ' Open the AVI device
  If PlayInObject = True Then
    ReturnValue = mciSendString("open AVIvideo!" & strTempFile & " alias " & strDeviceID & " parent " & ParentObjectHandle & " style child", 0&, 0, 0)
  Else
    ReturnValue = mciSendString("open AVIvideo!" & strTempFile & " alias " & strDeviceID, 0&, 0, 0)
  End If
  ' Check if errors occured while opening
  If ReturnValue <> 0 And ReturnValue <> 289 And ReturnValue <> 263 Then
    MCI_GetErrorMsg ReturnValue
    Exit Function
  End If
  
  boolMCIIsOpen = True
  
  ' The notify tells the MCI command to return control to the application
  ReturnValue = mciSendString("play " & strDeviceID & " notify", 0&, 0, 0)
  ' Check for errors while playing
  If ReturnValue <> 0 And ReturnValue <> 289 And ReturnValue <> 263 Then
    MCI_GetErrorMsg ReturnValue
    Exit Function
  End If
  
  ' Get the AVI window's handle
  TheHandle = FindWindow(vbNullString, StripFileName(strTempFile))
  If TheHandle = 0 Then
    TheHandle = FindWindow("AVIWnd", vbNullString)
  End If
  If TheHandle = 0 Then
    GoTo Finished
  End If
  
  ' Change the window's caption
  If WindowName <> "" And PlayInObject = False Then
    SetWindowText TheHandle, WindowName
  End If
  
  ' Get the AVI window's dimentions - Center window
  If CenterWindow = True And PlayInObject = False Then
    ReturnValue = GetWindowRect(TheHandle, WindowInfo)
    If ReturnValue <> 0 Then
      AVIHeight = WindowInfo.Bottom - WindowInfo.Top
      AVIWidth = WindowInfo.Right - WindowInfo.Left
      MoveWindow TheHandle, ((Screen.Width / Screen.TwipsPerPixelX) - AVIWidth) / 2, ((Screen.Height / Screen.TwipsPerPixelY) - AVIHeight) / 2, AVIWidth, AVIHeight, True
    End If
  End If
  
Finished:
  
  MCI_PlayAVI_RES = True
  
  Exit Function
    
ErrorTrap:
  
  If Err.Number = 0 Then      ' No Error
    Resume Next
  ElseIf Err.Number = 20 Then ' Resume Without Error
    Resume Next
  Else                        ' Other Error
    ErrMsg Err.Source, Err.Number, Err.Description
  End If
  
End Function

' Play an .AVI file from the specified file on the hard drive
Public Function MCI_PlayAVI_File(AVIFilePath As String, Optional WindowName As String = "", Optional CenterWindow As Boolean = False, Optional PlayInObject As Boolean = False, Optional ParentObjectHandle As Long = 0) As Boolean
On Error GoTo ErrorTrap
  
  Dim TheHandle As Long
  Dim WindowInfo As RECT
  Dim AVIHeight As Long
  Dim AVIWidth As Long
  
  ' Close the MCI device if it's currently open
  If boolMCIIsOpen = True Then
    MCI_Stop
    MCI_Close
    boolMCIIsOpen = False
  End If
  
  ' Make sure file exists
  If Dir(AVIFilePath) = "" Then
    If boolShowErrors = True Then
      MsgBox AVIFilePath & Chr(13) & Chr(13) & "The specified file does not exist.", vbOKOnly + vbExclamation, "  File Not Found"
    End If
    Exit Function
  End If
  
  ' Open the AVI device
  If PlayInObject = True Then
    ReturnValue = mciSendString("open AVIvideo!" & AVIFilePath & " alias " & strDeviceID & " parent " & ParentObjectHandle & " style child", 0&, 0, 0)
  Else
    ReturnValue = mciSendString("open AVIvideo!" & AVIFilePath & " alias " & strDeviceID, 0&, 0, 0)
  End If
  ' Check if errors occured while opening
  If ReturnValue <> 0 And ReturnValue <> 289 And ReturnValue <> 263 Then
    MCI_GetErrorMsg ReturnValue
    Exit Function
  End If
  
  boolMCIIsOpen = True
  
  ' The notify tells the MCI command to return control to the application
  ReturnValue = mciSendString("play " & strDeviceID & " notify", 0&, 0, 0)
  ' Check for errors while playing
  If ReturnValue <> 0 And ReturnValue <> 289 And ReturnValue <> 263 Then
    MCI_GetErrorMsg ReturnValue
    Exit Function
  End If
  
  If PlayInObject = True Then
    GoTo Finished
  End If
  
  ' Get the AVI window's handle
  TheHandle = FindWindow(vbNullString, StripFileName(AVIFilePath))
  If TheHandle = 0 Then
    TheHandle = FindWindow("AVIWnd", vbNullString)
  End If
  If TheHandle = 0 Then
    GoTo Finished
  End If
  
  ' Change the window's caption
  If WindowName <> "" Then
    SetWindowText TheHandle, WindowName
  End If
  
  ' Get the AVI window's dimentions - Center window
  If CenterWindow = True Then
    ReturnValue = GetWindowRect(TheHandle, WindowInfo)
    If ReturnValue <> 0 Then
      AVIHeight = WindowInfo.Bottom - WindowInfo.Top
      AVIWidth = WindowInfo.Right - WindowInfo.Left
      MoveWindow TheHandle, ((Screen.Width / Screen.TwipsPerPixelX) - AVIWidth) / 2, ((Screen.Height / Screen.TwipsPerPixelY) - AVIHeight) / 2, AVIWidth, AVIHeight, True
    End If
  End If
  
Finished:
  
  MCI_PlayAVI_File = True
  
  Exit Function
    
ErrorTrap:
  
  If Err.Number = 0 Then      ' No Error
    Resume Next
  ElseIf Err.Number = 20 Then ' Resume Without Error
    Resume Next
  Else                        ' Other Error
    ErrMsg Err.Source, Err.Number, Err.Description
  End If
  
End Function

' Pause the current device
Public Function MCI_Pause() As Boolean
On Error GoTo ErrorTrap
  
  ' Puase the device
  ReturnValue = mciSendString("pause " & strDeviceID, 0&, 0, 0)
  ' Check if errors occured
  If ReturnValue <> 0 And ReturnValue <> 289 And ReturnValue <> 263 Then
    MCI_GetErrorMsg ReturnValue
    Exit Function
  End If
  
  MCI_Pause = True
  
  Exit Function
  
ErrorTrap:
  
  If Err.Number = 0 Then      ' No Error
    Resume Next
  ElseIf Err.Number = 20 Then ' Resume Without Error
    Resume Next
  Else                        ' Other Error
    ErrMsg Err.Source, Err.Number, Err.Description
  End If

End Function

' Resume the current device if it's been paused
' *NOTE: CD-ROM Audio does not support RESUME so PAUSE acts like STOP
Public Function MCI_Resume() As Boolean
On Error GoTo ErrorTrap
  
  ' Resume the device
  ReturnValue = mciSendString("resume " & strDeviceID, 0&, 0, 0)
  ' Check if errors occured
  If ReturnValue <> 0 And ReturnValue <> 289 And ReturnValue <> 263 Then
    MCI_GetErrorMsg ReturnValue
    Exit Function
  End If
  
  MCI_Resume = True
  
  Exit Function
  
ErrorTrap:
  
  If Err.Number = 0 Then      ' No Error
    Resume Next
  ElseIf Err.Number = 20 Then ' Resume Without Error
    Resume Next
  Else                        ' Other Error
    ErrMsg Err.Source, Err.Number, Err.Description
  End If
  
End Function

' Stop the currently playing device
Public Function MCI_Stop() As Boolean
On Error GoTo ErrorTrap
  
  boolMCIIsOpen = False
  
  ' Stop the device
  ReturnValue = mciSendString("stop " & strDeviceID, 0&, 0, 0)
  ' Check if errors occured
  If ReturnValue <> 0 And ReturnValue <> 289 And ReturnValue <> 263 And boolShutItDown = False Then
    MCI_GetErrorMsg ReturnValue
    Exit Function
  End If
  
  MCI_Stop = True
  
  Exit Function
  
ErrorTrap:
  
  If Err.Number = 0 Then      ' No Error
    Resume Next
  ElseIf Err.Number = 20 Then ' Resume Without Error
    Resume Next
  Else                        ' Other Error
    ErrMsg Err.Source, Err.Number, Err.Description
  End If

End Function

' Close the current open device
Public Function MCI_Close() As Boolean
On Error GoTo ErrorTrap
  
  boolMCIIsOpen = False
  
  ' Close the device
  ReturnValue = mciSendString("close " & strDeviceID, 0&, 0, 0)
  ' Check if errors occured
  If ReturnValue <> 0 And ReturnValue <> 289 And ReturnValue <> 263 And boolShutItDown = False Then
    MCI_GetErrorMsg ReturnValue
    Exit Function
  End If
  
  MCI_Close = True
  
  Exit Function
  
ErrorTrap:
  
  If Err.Number = 0 Then      ' No Error
    Resume Next
  ElseIf Err.Number = 20 Then ' Resume Without Error
    Resume Next
  Else                        ' Other Error
    ErrMsg Err.Source, Err.Number, Err.Description
  End If

End Function

' This function attempts to obtain a mixer control
Private Function MCI_VolumeGet(ByVal hMixer As Long, ByVal ComponentType As Long, ByVal CtrlType As Long, ByRef MxC As MIXERCONTROL) As Boolean
On Error Resume Next
  
  Dim ReturnCode As Long
  Dim MxLC       As MIXERLINECONTROLS
  Dim MxL        As MIXERLINE
  Dim hMem       As Long
  
  MxL.cbStruct = Len(MxL)
  MxL.dwComponentType = ComponentType
  
  ' Get a line corresponding to the component type
  ReturnCode = mixerGetLineInfo(hMixer, MxL, MIXER_GETLINEINFOF_COMPONENTTYPE)
  
  If ReturnCode = MMSYSERR_NOERROR Then
    With MxLC
      .cbStruct = Len(MxLC)
      .dwLineID = MxL.dwLineID
      .dwControl = CtrlType
      .cControls = 1
      .cbmxctrl = Len(MxC)
    End With
    
    ' Allocate a buffer for the control
    hMem = GlobalAlloc(&H40, Len(MxC))
    MxLC.pamxctrl = GlobalLock(hMem)
    MxC.cbStruct = Len(MxC)
    
    ' Get the control
    ReturnCode = mixerGetLineControls(hMixer, MxLC, MIXER_GETLINECONTROLSF_ONEBYTYPE)
    
    If ReturnCode = MMSYSERR_NOERROR Then
      MCI_VolumeGet = True
      
      ' Copy the control into the destination structure
      CopyStructFromPtr MxC, MxLC.pamxctrl, Len(MxC)
    Else
      MCI_VolumeGet = False
    End If
    
    GlobalFree hMem
    
    Exit Function
  
  End If
  
  MCI_VolumeGet = False

End Function

' Sets the volume control
Private Function MCI_VolumeSet(ByVal hMixer As Long, MxC As MIXERCONTROL, ByVal Volume As Long) As Boolean
On Error Resume Next
  
  Dim ReturnCode As Long
  Dim MxCD       As MIXERCONTROLDETAILS
  Dim Vol        As MIXERCONTROLDETAILS_UNSIGNED
  Dim hMem       As Long
  
  With MxCD
    .item = 0
    .dwControlID = MxC.dwControlID
    .cbStruct = Len(MxCD)
    .cbDetails = Len(Vol)
  End With
  
  ' Allocate a buffer for the control value buffer.
  hMem = GlobalAlloc(&H40, Len(Vol))
  MxCD.paDetails = GlobalLock(hMem)
  MxCD.cChannels = 1
  Vol.dwValue = Volume
  
  ' Copy the data into the control value buffer.
  CopyPtrFromStruct MxCD.paDetails, Vol, Len(Vol)
  
  ' Set the control value.
  ReturnCode = mixerSetControlDetails(hMixer, MxCD, MIXER_SETCONTROLDETAILSF_VALUE)
  GlobalFree hMem
  
  If ReturnCode = MMSYSERR_NOERROR Then
    MCI_VolumeSet = True
  Else
    MCI_VolumeSet = False
  End If

End Function

' Function to extract files from a VB resource included in your project
Public Function ExtractFromRES(RES_Type As String, RES_ID As Long, Optional FileToExtractTo As String = "") As Boolean
On Error GoTo ErrorTrap
  
  Dim ResFile() As Byte    ' File Byte Array
  Dim FileNum As Long      ' File Handle
  Dim strTemp As String
  Dim Ret As String
  
  ' Check if a Type name has been specified
  If RES_Type = "" Then
    If boolShowErrors = True Then
      MsgBox "No type name has been specified.  Can't retrieve the file from the resource.", vbOKOnly + vbExclamation, "  No File Specified To Extract"
    End If
    ExtractFromRES = False
    Exit Function
  End If
  
  ' See if user has previously extracted this resource file
  Ret = SearchForTempFile(RES_Type, RES_ID)
  
  ' If HAS NOT, create it
  If Ret = "" Then
    If FileToExtractTo <> "" Then                ' Check if user specified a file to extract to
      strTemp = FileToExtractTo                  ' Specify the user's file
    Else
      strTemp = CreateTempFile(RES_Type, RES_ID) ' Create temp file
    End If
    GoSub CreateTempFile
  ' If user HAS but it's not there anymore, create new one
  ElseIf Dir(Ret) = "" Then
    If FileToExtractTo <> "" Then                ' Check if user specified a file to extract to
      strTemp = FileToExtractTo                  ' Specify the user's file
    Else
      strTemp = CreateTempFile(RES_Type, RES_ID) ' Create temp file
    End If
  ' If user HAS and it's still there, use it
  Else
    strTempFile = Ret
  End If
  
  ExtractFromRES = True
  
  Exit Function
  
CreateTempFile:
  
  ' Load RES File into a Byte Array
  ResFile = LoadResData(RES_ID, RES_Type)
  
  ' Save the RES file to the new temp file
  Close
  FileNum = FreeFile
  Open strTemp For Binary As #FileNum      ' Open Temp File
    Put #FileNum, 1, ResFile()             ' Insert Byte Array into Temp File
  Close #FileNum                           ' Close Temp File
  
  Return
  
ErrorTrap:
  
  If Err.Number = 0 Then      ' No Error
    Resume Next
  ElseIf Err.Number = 20 Then ' Resume Without Error
    Resume Next
  Else                        ' Other Error
    ErrMsg Err.Source, Err.Number, Err.Description
  End If
  
End Function

' Function to display error messages if encountered
Private Function ErrMsg(ErrorSource As String, ErrorNumber As Long, ErrorDescription As String)
On Error Resume Next
  
  Dim Form As Form
  
  ' Error 0 = No Error  /  Error 20 = Resume Without Error
  If ErrorNumber = 0 Or ErrorNumber = 20 Then
    Exit Function
  End If
  
  ' If user wants error messages shown, display one
  If boolShowErrors = True Then
    MsgBox ErrorSource & " just encountered the following error :" & Chr(13) & Chr(13) & "Error Number = " & CStr(ErrorNumber) & Chr(13) & "Error Description = " & ErrorDescription, vbOKOnly + vbExclamation, "  Error  -  " & ErrorDescription
  End If
  lngLastError = ErrorNumber
  Err.Clear
  
  ' Unload all the forms and exit the program
'  For Each Form In Forms
'    Unload Form
'    Set Form = Nothing
'  Next
'
'  End
  
End Function

' Function that strips the file name from the end of a full path statement
' This function is used in the AVI functions to determine the AVI Video
' window's default caption
Private Function StripFileName(FullPath As String) As String
On Error Resume Next
  
  Dim MyCounter As Integer
  Dim CharLeft As String
  Dim CharRight As String
  
  For MyCounter = 0 To Len(FullPath)
    CharRight = Right(FullPath, MyCounter)
    CharLeft = Left(CharRight, 1)
    If CharLeft = "\" Then
      StripFileName = Right(CharRight, (Len(CharRight) - 1))
      Exit Function
    End If
  Next
  
End Function

' This is the routine that uses the Windows API to create a unique
' temporary in the system's temp directory
Private Function CreateTempFile(RES_Type As String, RES_ID As Long) As String
On Error Resume Next
  
  Dim Result As Long       ' API Result Returned
  Dim strThePath As String * FILE_MAX_PATH
  Dim strTheFile As String * FILE_MAX_PATH
  
  ' Get Temp Path and File Name
  Result = GetTempPath(FILE_MAX_PATH, strThePath)
  Result = GetTempFileName(strThePath, FILE_PREFIX, 0, strTheFile)
  
  ' Strip off null strings from end
  strTempPath = Left(strThePath, InStr(strThePath, Chr(0)) - 1)
  strTempFile = Left(strTheFile, InStr(strTheFile, Chr(0)) - 1)
  
  ' Store the information of the temp files that have been created
  lngTemp_Files = lngTemp_Files + 1
  lngTemp_Infos = lngTemp_Infos + 1
  ReDim Preserve strTemp_File(lngTemp_Files) As String
  ReDim Preserve strTemp_Info(lngTemp_Infos) As String
  strTemp_File(lngTemp_Files) = strTempFile
  strTemp_Info(lngTemp_Infos) = RES_Type & "|" & CStr(RES_ID)
  
  ' Return the current temp file path
  CreateTempFile = strTemp_File(lngTemp_Files)
  DoEvents
  
End Function

' Function used to see if a resource has already been extracted,
' and if it has, find out what it's name is
' * NOTE - This doesn't work if the user specifies the file to be
'          extracted because this assumes the user wants to keep the file
Private Function SearchForTempFile(RES_Type As String, RES_ID As Long) As String
On Error Resume Next
  
  Dim MyCounter As Long
  Dim MyCounter1 As Long
  Dim CharLeft As String
  Dim CharRight As String
  Dim TheInfo As String
  Dim TheType As String
  Dim TheID As String
  
  If lngTemp_Infos = 0 Then
    SearchForTempFile = ""
    Exit Function
  Else
    For MyCounter = 0 To lngTemp_Infos
      TheInfo = strTemp_Info(MyCounter)
      If TheInfo <> "" Then
        GoSub StripRES_ID
        If TheType = RES_Type And TheID = CStr(RES_ID) Then
          SearchForTempFile = strTemp_File(MyCounter)
          Exit Function
        End If
      End If
    Next
  End If
  
  Exit Function
  
StripRES_ID:
  
  For MyCounter1 = 0 To Len(TheInfo)
    CharRight = Right(TheInfo, MyCounter1)
    CharLeft = Left(CharRight, 1)
    If CharLeft = "|" Then
      TheID = Right(CharRight, (Len(CharRight) - 1))
      TheType = Left(TheInfo, (Len(TheInfo) - Len(CharRight)))
      Return
    End If
  Next
  
  Return
  
End Function

' This routine goes out to the temp directory and deletes all the temp
' files that it created when extracting the files from the VB Resource
Private Function CleanUpTempFiles()
On Error Resume Next
  
  Dim MyCounter As Long
  
  ' If no temp files created, exit without doing anything
  If lngTemp_Files = 0 Then
    Exit Function
  End If
  
  For MyCounter = 0 To lngTemp_Files
    If strTemp_File(MyCounter) <> "" Then
      If Dir(strTemp_File(MyCounter)) <> "" Then
        Kill strTemp_File(MyCounter)
      End If
    End If
  Next
  
End Function

' Function checks to see how many CD-ROM drives are installed
' on your machine, and if there are returns how many
Public Function CheckForCDROM() As Integer
On Error Resume Next
  
  Dim MyCounter As Integer
  Dim CDDrives As Integer
  
  ' Chr(65) = "A"   Chr(90) = "Z"
  For MyCounter = 65 To 90
    If CheckDriveType(Chr(MyCounter)) = "CD-ROM" Then
      CDDrives = CDDrives + 1
    End If
  Next
  
  CheckForCDROM = CDDrives
  
End Function

' Checks the specified drive letter to see what kind of drive it is
Public Function CheckDriveType(DriveLetter As String) As String
On Error Resume Next
  
  Dim Ret As Long
  
  If Len(DriveLetter) > 1 Or DriveLetter = "" Then
    CheckDriveType = "Invalid Drive Letter"
  End If
  
  Ret = GetDriveTypeA(DriveLetter & ":\")
  Select Case Ret
    Case 0 ' Cannot be determined
      CheckDriveType = "Unknown"
    Case 1 ' The root directory does not exist
      CheckDriveType = "Unknown"
    Case DRIVE_CDROM
      CheckDriveType = "CD-ROM"
    Case DRIVE_REMOVABLE
      CheckDriveType = "Removable"
    Case DRIVE_FIXED
      CheckDriveType = "Fixed"
    Case DRIVE_REMOTE
      CheckDriveType = "Remote"
  End Select
  
End Function