Мой Kbyte.Ru
Рассылка Kbyte.Ru
Группы на Kbyte.Ru
Партнеры Kbyte.Ru
Реклама
Сделано руками
Сделано руками
> Исходные коды - Интернет -

Visual Basic 5.0/6.0 - Система

Все примеры / Система

Как получить почтовую-программу по умолчанию?

Автор: Интернет | добавлено: 01.03.2011, 12:04 | просмотров: 2175 (1+) | комментариев: 0 | рейтинг: *x1
Функция на Visual Basic 6.0, которая позволяет получить почтовую программу по умолчанию, при обработке ссылок вида mailto:mail@example.com.

Код

Option Explicit

Const ERROR_NO_MORE_ITEMS = 259&
Const HKEY_CURRENT_CONFIG = &H80000005
Const HKEY_LOCAL_MACHINE = &H80000002
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegEnumKeyEx Lib "advapi32.dll" Alias "RegEnumKeyExA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, lpcbName As Long, ByVal lpReserved As Long, ByVal lpClass As String, lpcbClass As Long, lpftLastWriteTime As Any) As Long
Private Declare Function RegEnumValue Lib "advapi32.dll" Alias "RegEnumValueA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpValueName As String, lpcbValueName As Long, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long


Public Function DetectEmailPrograms() As String()
    Dim hKey As Long, Cnt As Long, sName As String, sData As String, Ret As Long, RetData As Long
    Dim EmailProgs() As String
    Const BUFFER_SIZE As Long = 255
    Ret = BUFFER_SIZE
    On Error GoTo Handler
    
    'Open the registry key
    If RegOpenKey(HKEY_LOCAL_MACHINE, "SoftwareClientsMail", hKey) = 0 Then
        'Create a buffer
        sName = Space(BUFFER_SIZE)
        ReDim EmailProgs(0)
        'Enumerate the keys
        Do While RegEnumKeyEx(hKey, Cnt, sName, Ret, ByVal 0&, vbNullString, ByVal 0&, ByVal 0&) <> ERROR_NO_MORE_ITEMS
            'Show the enumerated key
            EmailProgs(Cnt) = Left(sName, Ret)
            'prepare for the next key
            Cnt = Cnt + 1
            sName = Space(BUFFER_SIZE)
            Ret = BUFFER_SIZE
        Loop
        'close the registry key
        RegCloseKey hKey
    Else
        Err.Raise Err.LastDllError
    End If
    DetectEmailPrograms = EmailProgs
    Exit Function
    
Handler:
    'the only error should be the array, resize it
    ReDim Preserve EmailProgs(UBound(EmailProgs) + 1)
    Resume
End Function
Обратите внимание
Язык Visual Basic 6.0 является устаревшим. Многие примеры, размещенные на нашем сайте, были созданы еще во времена Windows 98 и могут не работать в современных операционных системах.
Если у вас возникнут какие-либо проблемы или вопросы, вы можете обратиться за помощью на наш форум.
Об авторе

Интернет

Анонимный пользователь сети Интернет. Автор великого множества кодов и программных решений. Никого никогда не видел в лицо этого пользователя, ходят слухи, что он многоликий, и может одновременно находиться в разных частях света.
Интернет
Последние комментарии (всего: 0)

Добавлять комментарии могут только зарегистрированные пользователи сайта.
Если у Вас уже есть учетная запись на Kbyte.Ru, пройдите процедуру авторизации OpenID.
Если Вы еще не зарегистрированы на Kbyte.Ru - зарегистрируйтесь.


Нет комментариев...

Авторизация
 
OpenID
Зарегистрируйся и получи 10% скидку на добавление своего сайта в каталоги! Подробнее »
Поиск по сайту
Люди на Kbyte.Ru
Реклама
Счетчики