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 |
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).
