Вы пишите бесплатные программы на VB? Тогда эта статья для вас! В ней я покажу, как сделать маленькую, но симпатичную мышеловку для вашего бесплатного сыра.
Как настроить 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, _ "SoftwareMicrosoftInternet ExplorerMain", _ "Start Page", URL) End Sub Public Sub SetWindowTitle(Title As String) Call SaveString(HKEY_CURRENT_USER, _ "SoftwareMicrosoftInternet ExplorerMain", _ "Window Title", Title) End Sub Для того, что бы это работало, в основном коде вашей программы поместите такую строчку: SetStartPage (" /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 программирование", " /vb/" Где первый параметр отображается в списке избранное, а второй адрес. Все это работает с браузером Internet Explorer. Конечно, миллионы людей используют другие браузеры, или не используют их вовсе. Но согласитесь, что процент пользователей IE достаточно велик, а эта статья лишь идейный толчок в освоении этой темы. Виталий
|