Visual Basic Registry Routines
RegQueryValueEx: User Default Email Address (Internet Account Manager)
     
Posted:   Sunday July 07, 2002
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.

This code is a subset of that in RegEnumKeyEx: POP3, SMTP, NNTP and LDAP Account Info (Outlook Express) which retrieves the user's default email account and queries the registry under that account for the SMTP or POP3 email address. This code works for accounts using the Internet Account Manager registry key; for Outlook, which uses a different key, please see RegQueryValueEx: Retrieve Email Account Info (Outlook).
 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_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()

   Command1.Caption = "Get Email Address"

End Sub


Private Sub Command1_Click()

   Text1.Text = GetDefaultEmailAddress()
      
End Sub


Private Function GetDefaultAccount() As String

   Dim hKey As Long
   Dim sKey As String
   
   sKey = "Software\Microsoft\Internet Account Manager"
   hKey = OpenRegKey(HKEY_CURRENT_USER, sKey)

   If hKey <> 0 Then

      GetDefaultAccount = GetRegValue(hKey, "Default Mail Account")
      
      RegCloseKey hKey
   
   End If

End Function


Private Function GetDefaultEmailAddress() As String

   Dim hKey As Long
   Dim sKey As String
   Dim tmp As String
   
   Dim sAccount As String
   Dim sDefAddress As String
   
   sAccount = GetDefaultAccount()
   
   If Len(sAccount) Then
   
      sKey = "Software\Microsoft\Internet Account Manager"
      hKey = OpenRegKey(HKEY_CURRENT_USER, sKey & "\Accounts\" & sAccount)
      
      If hKey <> 0 Then
      
        'try for the SMTP email address
         tmp = GetRegValue(hKey, "SMTP Email Address")
         
         If Len(tmp) > 0 Then
            GetDefaultEmailAddress = tmp
            Exit Function
         Else
         
           'not there, so try for the SMTP reply address
            tmp = GetRegValue(hKey, "SMTP Reply To Email Address")
         
            If Len(tmp) > 0 Then
               GetDefaultEmailAddress = tmp
               Exit Function
            Else
            
             'not there, so try for the POP3 reply address
               tmp = GetRegValue(hKey, "POP3 Email Address")
            
               If Len(tmp) > 0 Then
                  GetDefaultEmailAddress = tmp
                  Exit Function
               Else
   
                 'not there, so try for the POP3 reply address
                  tmp = GetRegValue(hKey, "POP3 Reply To Email Address")
                  
                  If Len(tmp) > 0 Then
                     GetDefaultEmailAddress = tmp
                     Exit Function
                  Else
                     GetDefaultEmailAddress = ""
                  End If  'tmp=POP3 reply
               End If  'tmp=POP3
            End If  'tmp=SMTP reply
         End If  'tmp=SMTP
      
         RegCloseKey hKey
         
      End If  'if Len()
   End If  '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
Make payments with PayPal - it's fast, free and secure!

 
 
 
 

Copyright 1996-2011 VBnet and Randy Birch. All Rights Reserved.
Terms of Use  |  Your Privacy

 

Hit Counter