[VBnet Registry] RegQueryValueEx: Determine the User's Default Mail Client


	Visual Basic Registry Routines RegQueryValueEx: Determine the User's Default Mail Client

Posted:	Wednesday March 05, 2003
Updated:	Monday December 26, 2011

Applies to:	VB4-32, VB5, VB6
Developed with:	VB6, Windows XP
OS restrictions:	None
Author:	VBnet - Randy Birch

Related:	RegQueryValueEx: Retrieve Email Account Info (Outlook) RegEnumKeyEx: POP3, SMTP, NNTP and LDAP Account Info (Outlook Express) Retrieving the User's Default Email Address (Outlook Express) RegQueryValueEx: Determine the User's Default Mail Client

Prerequisites

None.

Here's a quick routine to retrieve the friendly name of the system's default mail client stored under HKEY_LOCAL_MACHINE.

I've tested this on systems where both Outlook and Outlook Express are installed, and the routine correctly returns which client has been selected as the default for the machine.

If you need more information about the default client see the Related links above.

BAS Module Code

None.

Form Code

Add a single command button (Command1) and a text box (Text1) to a form, along with the following code:

Option Explicit

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright ©1996-2011 VBnet/Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Distribution: You can freely use this code in your own
'               applications, but you may not reproduce 
'               or publish this code on any web site,
'               online service, or distribute as source 
'               on any media without express permission.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Private Const HKEY_LOCAL_MACHINE = &H80000002
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()

   Command1.Caption = "Get Mail Client"

End Sub


Private Sub Command1_Click()

   Text1.Text = GetDefaultMailClient()
      
End Sub


Private Function GetDefaultMailClient() As String

   Dim hKey As Long
   Dim sKey As String
   Dim buff As String

   sKey = "Software\Clients\Mail"
   hKey = OpenRegKey(HKEY_LOCAL_MACHINE, sKey)
      
   If hKey <> 0 Then
   
     'try for the (Default) key value
     'by passing vbnullstring
      buff = GetRegValue(hKey, vbNullString)
      
      RegCloseKey hKey
      
      GetDefaultMailClient = buff

   End If  'hKey
   
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
   Dim result As Long

  'if valid
   If hSubKey <> 0 Then
   
      lpValue = Space$(260)
      lpcbData = Len(lpValue)
      
     'find the passed value if present
      If RegQueryValueEx(hSubKey, _
                               sKeyName, _
                               0&, _
                               0&, _
                               ByVal lpValue, _
                               lpcbData) = ERROR_SUCCESS Then
                               
         GetRegValue = TrimNull(lpValue)
         
      End If

   End If

End Function


Public Function TrimNull(startstr As String) As String

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

Comments

PayPal Link