Автор:
Интернет | добавлено: 01.03.2011, 12:04 | просмотров: 2373 (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