デフォルトのE-Mailアドレスを取得          <TOP>


RegOpenKeyEx レジストリのキーのハンドルを確保
RegQueryValueEx レジストリの値を取得
RegCloseKey レジストリのハンドルを解放
 

注)OSにより、サブキーの位置が異なる場合があります。

 

'================================================================
'= デフォルトのE-Mailアドレスを取得
'=    (GetDefaultEmailAdd.bas)
'================================================================
#include "Windows.bi"

#define HKEY_CURRENT_USER -2147483647   '現在Windowsにログインしているユーザーの情報
#define REG_SZ 1                        'ヌル終端文字列
#define ERROR_SUCCESS &H0               '正常終了の戻り値を示す
#define STANDARD_RIGHTS_READ &H20000    '(READ_CONTROL)オブジェクトのセキュリティ記述子の読み取り許可
#define KEY_QUERY_VALUE &H1             'サブキーデータを問い合わせるためのアクセス権
#define KEY_ENUMERATE_SUB_KEYS &H8      'サブキーの列挙を許可
#define KEY_NOTIFY &H10                 '変更の通知を許可
#define SYNCHRONIZE &H100000            '同期をとる

' レジストリのキーのハンドルを確保
Declare Function Api_RegOpenKeyEx& Lib "advapi32" Alias "RegOpenKeyExA" (ByVal hKey&, ByVal lpSubKey$, ByVal ulOptions&, ByVal samDesired&, phkResult&)

' レジストリの値を取得
Declare Function Api_RegQueryValueEx& Lib "advapi32" Alias "RegQueryValueExA" (ByVal hKey&, ByVal lpvName$, ByVal lpReserved&, ByVal lpType&, ByVal lpData$, lpcbData&)

' レジストリのハンドルを解放
Declare Function Api_RegCloseKey& Lib "advapi32" Alias "RegCloseKey" (ByVal hKey&)

Var Shared Text1 As Object
Var Shared Button1 As Object

Text1.Attach GetDlgItem("Text1") : Text1.SetFontSize 14
Button1.Attach GetDlgItem("Button1") : Button1.SetFontSize 14

'================================================================
'=
'================================================================
Declare Function TrimNull(startstr As String) As String
Function TrimNull(startstr As String) As String
    TrimNull = Left$(startstr, InStr(startstr, Chr$(0)) - 1)
End Function

'================================================================
'=
'================================================================
Declare Function OpenRegKey(hKey As Long, lpSubKey As String) As Long
Function OpenRegKey(hKey As Long, lpSubKey As String) As Long
    Var hSubKey As Long

    If Api_RegOpenKeyEx(hKey, lpSubKey, 0, STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY And Not SYNCHRONIZE, hSubKey) = ERROR_SUCCESS Then
        OpenRegKey = hSubKey
    End If
End Function

'================================================================
'=
'================================================================
Declare Function GetRegValue(hSubKey As Long, sKeyName As String) As String
Function GetRegValue(hSubKey As Long, sKeyName As String) As String
    Var lpValue As String
    Var lpcbData As Long

    If hSubKey <> 0 Then
        lpValue = Space$(260)
        lpcbData = Len(lpValue)
        If Api_RegQueryValueEx(hSubKey, sKeyName, 0, 0, lpValue, lpcbData) = ERROR_SUCCESS Then
            GetRegValue = TrimNull(lpValue)
        End If
    End If
End Function

'================================================================
'=
'================================================================
Declare Function GetDefaultAccount() As String
Function GetDefaultAccount() As String
    Var hKey As Long
    Var sKey As String
    Var Ret As Long
   
    sKey = "Software\Microsoft\Internet Account Manager"
    hKey = OpenRegKey(HKEY_CURRENT_USER, sKey)

    If hKey <> 0 Then
        GetDefaultAccount = GetRegValue(hKey, "Default Mail Account")
        Ret = Api_RegCloseKey(hKey)
   End If
End Function

'================================================================
'=
'================================================================
Declare Function GetDefaultEmailAddress() As String
Function GetDefaultEmailAddress() As String
    Var sAccount As String
    Var sDefAddress As String
    Var hKey As Long
    Var sKey As String
    Var tmp As String
    Var Ret As Long
   
    sAccount = GetDefaultAccount()

    If Len(sAccount) <> 0 Then
        sKey = "Software\Microsoft\Internet Account Manager"
        hKey = OpenRegKey(HKEY_CURRENT_USER, sKey & "\Accounts\" & sAccount)
        If hKey <> 0 Then
            tmp = GetRegValue(hKey, "SMTP Email Address")
            If Len(tmp) > 0 Then
                GetDefaultEmailAddress = tmp
                Exit Function
            Else
                tmp = GetRegValue(hKey, "SMTP Reply To Email Address")
                If Len(tmp) > 0 Then
                    GetDefaultEmailAddress = tmp
                    Exit Function
                Else
                    tmp = GetRegValue(hKey, "POP3 Email Address")
                    If Len(tmp) > 0 Then
                        GetDefaultEmailAddress = tmp
                        Exit Function
                    Else
                        tmp = GetRegValue(hKey, "POP3 Reply To Email Address")
                        If Len(tmp) > 0 Then
                            GetDefaultEmailAddress = tmp
                            Exit Function
                        Else
                            GetDefaultEmailAddress = ""
                        End If
                    End If
                End If
            End If
            Ret = Api_RegCloseKey(hKey)
        End If
    End If
End Function

'================================================================
'=
'================================================================
Declare Sub Button1_on edecl ()
Sub Button1_on()
    Text1.SetWindowText GetDefaultEmailAddress
End Sub

'================================================================
'=
'================================================================
While 1
    WaitEvent
Wend
Stop
End