Как настроить Internet Explorer юзера на свой вкус

Вы пишите бесплатные программы на VB? Тогда эта статья для вас! В ней я покажу, как сделать маленькую, но симпатичную мышеловку для вашего бесплатного сыра.

Реклама - средство передвижения к месту, где есть деньги. Причем к нам, потребителям рекламы, это не относиться, мы не по ту сторону баррикад. А ведь хочется заявить о себе во весь голос, мол вот он я! И программу я сам написал! И вот моя страничка в Интернете! Заходите, пишите пожалуйста! Но пользователь, замученный агрессивной рекламой, на ваши ссылки не жмет, и письма благодарственные не пишет, нагло пользуясь халявой программой. Значит надо переходить к решительным действиям и заявить о себе не визуально добровольными, а принудительно техническими методами. В начале неплохо изменить стартовую страницу в IE. Этот код удобно оформить в виде .bas модуля, для удобства дальнейшего использования в любой программе, просто добавьте его и все.

Итак, сам код: 
Declare Function RegCreateKey Lib _ 
"advapi32.dll" Alias "RegCreateKeyA" _ 
(ByVal HKey As Long, ByVal lpSubKey As _ 
String, phkResult As Long) As Long 
Declare Function RegCloseKey Lib _ 
"advapi32.dll" (ByVal HKey As Long) As Long 
Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" _ 
(ByVal HKey As Long, ByVal _ 
lpValueName As String, ByVal _ 
Reserved As Long, ByVal dwType _ 
As Long, lpData As Any, ByVal _ 
cbData As Long) As Long 
Public Const REG_SZ = 1 
Public Const HKEY_CURRENT_USER = &H80000001 
Public Sub SaveString(HKey As Long, Path As String, _ 
Name As String, Data As String) 
Dim KeyHandle As Long 
Dim r As Long 
r = RegCreateKey(HKey, Path, KeyHandle) 
r = RegSetValueEx(KeyHandle, Name, 0, _ 
REG_SZ, ByVal Data, Len(Data)) 
r = RegCloseKey(KeyHandle) 
End Sub 
Public Sub SetStartPage(URL As String) 
Call SaveString(HKEY_CURRENT_USER, _ 
"Software\Microsoft\Internet Explorer\Main", _ 
"Start Page", URL) 
End Sub 
Public Sub SetWindowTitle(Title As String) 
Call SaveString(HKEY_CURRENT_USER, _ 
"Software\Microsoft\Internet Explorer\Main", _ 
"Window Title", Title) 
End Sub 
Для того, что бы это работало, в основном коде вашей программы поместите такую строчку: 
SetStartPage ("http://hiprog.com/vb/") 
Где в скобках, соответственно, нужный URL. 
В выше описанном .bas модуле есть еще одна процедура SetWindowTitle(Title As String). 
Она меняет заголовок IE. Т.е. если её вызвать в основной программе таким образом: 
SetWindowTitle ("Привет от Васи программиста!!!") 
То именно эту надпись и увидит юзер при очередном запуске IE. А чем не рекламный баннер? 
Хотя это и бесчеловечно, ибо изменить эту надпись (в отличии от стартовой страницы) простому юзеру достаточно сложно. 
Далее не плохо добавить свои координаты в папку "Избранное". 
Пишем следующий .bas модуль: 
Private Declare Function SHGetSpecialFolderLocation _ 
Lib "shell32.dll" (ByVal hwndOwner As Long, _ 
ByVal nFolder As SpecialShellFolderIDs, _ 
pidl As Long) As Long 
Private Declare Function SHGetPathFromIDList _ 
Lib "shell32.dll" Alias "SHGetPathFromIDListA" _ 
(ByVal pidl As Long, _ 
ByVal pszPath As String) As Long 
Private Declare Sub CoTaskMemFree Lib "ole32.dll" _ 
(ByVal pv As Long) 
Public Enum SpecialShellFolderIDs 
CSIDL_DESKTOP = &H0 
CSIDL_INTERNET = &H1 
CSIDL_PROGRAMS = &H2 
CSIDL_CONTROLS = &H3 
CSIDL_PRINTERS = &H4 
CSIDL_PERSONAL = &H5 
CSIDL_FAVORITES = &H6 
CSIDL_STARTUP = &H7 
CSIDL_RECENT = &H8 
CSIDL_SENDTO = &H9 
CSIDL_BITBUCKET = &HA 
CSIDL_STARTMENU = &HB 
CSIDL_DESKTOPDIRECTORY = &H10 
CSIDL_DRIVES = &H11 
CSIDL_NETWORK = &H12 
CSIDL_NETHOOD = &H13 
CSIDL_FONTS = &H14 
CSIDL_TEMPLATES = &H15 
CSIDL_COMMON_STARTMENU = &H16 
CSIDL_COMMON_PROGRAMS = &H17 
CSIDL_COMMON_STARTUP = &H18 
CSIDL_COMMON_DESKTOPDIRECTORY = &H19 
CSIDL_APPDATA = &H1A 
CSIDL_PRINTHOOD = &H1B 
CSIDL_ALTSTARTUP = &H1D 
CSIDL_COMMON_ALTSTARTUP = &H1E 
CSIDL_COMMON_FAVORITES = &H1F 
CSIDL_INTERNET_CACHE = &H20 
CSIDL_COOKIES = &H21 
CSIDL_HISTORY = &H22 
End Enum 
Public Sub AddFavorite(SiteName As String, URL As String) 
Dim pidl As Long 
Dim intFile As Integer 
Dim strFullPath As String 
On Error GoTo ErrorHandler 
intFile = FreeFile 
strFullPath = Space(255) 
'Проверяем с помощью API существование и расположение нужной папки 
If SHGetSpecialFolderLocation(0, CSIDL_FAVORITES, pidl) = 0 Then 
If pidl Then 
If SHGetPathFromIDList(pidl, strFullPath) Then 
' Убираем лишние пробелы 
If InStr(1, strFullPath, Chr(0)) Then 
strFullPath = Mid(strFullPath, 1, _ 
InStr(1, strFullPath, Chr(0)) - 1) 
End If 
' Добавляем черту если её нет 
If Right(strFullPath, 1) "\" Then 
strFullPath = strFullPath & "\" 
End If 
' Создаем сыылку 
strFullPath = strFullPath & SiteName & ".URL" 
Open strFullPath For Output As #intFile 
Print #intFile, "[InternetShortcut]" 
Print #intFile, "URL=" & URL 
Close #intFile 
End If 
CoTaskMemFree pidl 
End If 
End If 
ErrorHandler: 
End Sub 
Для того, что бы это работало, в основном коде вашей программы поместите такую строчку: 
AddFavorite "VB программирование", "http://hiprog.com/vb/" 
Где первый параметр отображается в списке избранное, а второй адрес. 
Все это работает с браузером Internet Explorer. Конечно, миллионы людей используют другие браузеры, или не используют их вовсе. Но согласитесь, что процент пользователей IE достаточно велик, а эта статья лишь идейный толчок в освоении этой темы.

16.02.2006