'File for the MSIM notify sound
Private sNotifySound As String

Private Const HKEY_CURRENT_USER = &H80000001
Private Const REG_SZ As Long = 1
Private Const ERROR_SUCCESS As Long = 0
Private Const STANDARD_RIGHTS_READ As Long = &H20000
Private Const KEY_QUERY_VALUE As Long = &H1
Private Const KEY_ENUMERATE_SUB_KEYS As Long = &H8
Private Const KEY_NOTIFY As Long = &H10
Private Const SYNCHRONIZE As Long = &H100000
Private Const KEY_READ As Long = ((STANDARD_RIGHTS_READ Or _
                                   KEY_QUERY_VALUE Or _
                                   KEY_ENUMERATE_SUB_KEYS Or _
                                   KEY_NOTIFY) And _
                                   (Not SYNCHRONIZE))

Private Declare Function RegOpenKeyEx Lib "advapi32.dll" _
   Alias "RegOpenKeyExA" _
  (ByVal hKey As Long, _
   ByVal lpSubKey As String, _
   ByVal ulOptions As Long, _
   ByVal samDesired As Long, _
   phkResult As Long) As Long
   
Private Declare Function RegQueryValueEx Lib "advapi32.dll" _
   Alias "RegQueryValueExA" _
  (ByVal hKey As Long, _
   ByVal lpValueName As String, _
   ByVal lpReserved As Long, _
   lpType As Long, _
   lpData As Any, _
   lpcbData As Long) As Long
   
Private Declare Function RegCloseKey Lib "advapi32.dll" _
  (ByVal hKey As Long) As Long

Private Declare Function lstrlenW Lib "kernel32" _
  (ByVal lpString As Long) As Long



Private Sub Form_Load()
     
  'obtain from the registry the sound
  'the user has associated with
  'Microsoft Windows Messenger
  'notification messages.
   sNotifySound = GetMsimNotifySound()

End Sub

  
Private Sub cmdShowMessage_Click()
    
   Dim msg As String

  'sMsg: string to display
  'ico: Image to display in the notify window -
  '     can be icon or a bitmap
  'ImageX: X coordinate of image relative to
  '     upper left corner of the form
  'ImageY: Y coordinate of image relative to
  '     upper left corner of the form
  'Duration: specify the duration
  'BgColour1: Colour of gradient background (top)
  'BgColour2: Colour of gradient background (bottom)
  'ImgTransColour: specifies the transparency colour
  '     for bitmap image. Ignored for icons
  'msShowTime: milliseconds between reveal increments, default=50
  'msHangTime: milliseconds form remains on-screen, default=4000
  'msHideTime: milliseconds between hide increments, default=50
  'bPlacement: True for top right, false for top left

  'sSound: Path of the sound to be played

   msg = "A newer version of SomeProgram is available." & _
          vbNewLine & vbNewLine & _
         "Click here to install it now."
   
   Call frmNotify.ShowMessage(sMsg:=msg, _
                              img:=Image1.Picture, _
                              ImageX:=88, _
                              ImageY:=4, _
                              BgColour1:=RGB(133, 112, 243), _
                              BgColour2:=RGB(255, 255, 255), _
                              ImgTransColour:=RGB(255, 0, 0), _
                              msShowTime:=10, _
                              msHangTime:=4000, _
                              msHideTime:=10, _
                              bPlacement:=False, _
                              sSound:=sNotifySound)

  'here's the same call without 
  'the inline variable names
  'Call frmNotify.ShowMessage(msg, _
                              Image1.Picture, _
                              88, _
                              4, _
                              RGB(133, 112, 243), _
                              RGB(255, 255, 255), _
                              RGB(255, 0, 0), _
                              10, _
                              4000, _
                              10, _
                              False, _
                              sNotifySound)

End Sub


Private Function GetMsimNotifySound() As String

   Dim hKey As Long
   Dim sKey As String
   
  'valid values for the second-last member
  'of this string are:
  'MSMSGS_ContactOnline
  'MSMSGS_NewAlert
  'MSMSGS_NewMail
  'MSMSGS_NewMessage
  '
  'You could also use sounds listed under
  'current user \ Schemes \ apps such as"
  'HKEY_CURRENT_USER\AppEvents\Schemes\ _
                     Apps\.Default\MailBeep\.Current
  
   sKey = "AppEvents\Schemes\Apps\MSMSGS\MSMSGS_ContactOnline\.Current"
   hKey = OpenRegKey(HKEY_CURRENT_USER, sKey)

   If hKey <> 0 Then

      GetMsimNotifySound = GetRegValue(hKey, vbNullString)
      
      RegCloseKey hKey
   
   End If

End Function

Private Function OpenRegKey(ByVal hKey As Long, _
                            ByVal lpSubKey As String) As Long

  Dim hSubKey As Long

  If RegOpenKeyEx(hKey, _
                  lpSubKey, _
                  0, _
                  KEY_READ, _
                  hSubKey) = ERROR_SUCCESS Then

      OpenRegKey = hSubKey

  End If

End Function


Private Function GetRegValue(hSubKey As Long, _
                             sKeyName As String) As String

   Dim lpValue As String   'name of the value to retrieve
   Dim lpcbData As Long    'length of the retrieved value

  'if valid
   If hSubKey <> 0 Then
   
     'determine the length of the
     'desired registry string
      If RegQueryValueEx(hSubKey, _
                         sKeyName, _
                         0, _
                         0, _
                         ByVal 0, _
                         lpcbData) = 0 Then
   
    
        'pad a string long enough to
        'accomdate the return value and
        'its terminating null
         lpValue = Space$(lpcbData + 1)
         lpcbData = Len(lpValue)
         
        'retrieve & return the value
         If RegQueryValueEx(hSubKey, _
                                  sKeyName, _
                                  0&, _
                                  0&, _
                                  ByVal lpValue, _
                                  lpcbData) = ERROR_SUCCESS Then
                                  
            GetRegValue = TrimNull(lpValue)
            
         End If  'RegQueryValueEx
      End If  'RegQueryValueEx
   End If  'hSubKey

End Function


Public Function TrimNull(startstr As String) As String

   TrimNull = Left$(startstr, lstrlenW(StrPtr(startstr)))
   
End Function