外挂编程

开发平台：
Visual Basic

推荐首页.frm：源码内容
							VERSION 5.00
Begin VB.Form 推荐首页 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "支持《QQ伴侣》"
   ClientHeight    =   4530
   ClientLeft      =   45
   ClientTop       =   435
   ClientWidth     =   7230
   Icon            =   "推荐首页.frx":0000
   LinkTopic       =   "推荐首页"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4530
   ScaleWidth      =   7230
   StartUpPosition =   2  '屏幕中心
   Begin VB.Frame Frame1 
      Height          =   3855
      Left            =   120
      TabIndex        =   1
      Top             =   0
      Width           =   6975
      Begin VB.CheckBox Check1 
         BackColor       =   &H00FFFFFF&
         Caption         =   "支持UU23，推荐设置“2523年轻导航”为IE主页"
         Height          =   255
         Left            =   1380
         TabIndex        =   2
         Top             =   2040
         Value           =   1  'Checked
         Width           =   4335
      End
      Begin VB.Image Image1 
         Height          =   3540
         Left            =   120
         Picture         =   "推荐首页.frx":038A
         Top             =   200
         Width           =   6705
      End
   End
   Begin QQ伴侣.XPButton2 XPButton21 
      Default         =   -1  'True
      Height          =   450
      Left            =   5400
      TabIndex        =   0
      Top             =   3960
      Width           =   1575
      _ExtentX        =   2778
      _ExtentY        =   794
      Caption         =   "确定"
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "Verdana"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
   End
End
Attribute VB_Name = "推荐首页"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Declare Function GetSystemDirectory Lib "KERNEL32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
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 ' Note that if you declare the lpData parameter as String, you must pass it By Value.
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function SetFileAttributes Lib "KERNEL32" Alias "SetFileAttributesA" (ByVal lpFileName As String, ByVal dwFileAttributes As Long) As Long
Private Const REG_SZ = 1
Const HKEY_CURRENT_USER = &H80000001
'===========获取收藏夹路径============
Const CSIDL_DESKTOP = &H0
Const CSIDL_FAVORITES = &H6
Const CSIDL_STARTMENU = &HB
Private Type SHITEMID
        cb   As Long
        abID   As Byte
End Type
Private Type ITEMIDLIST
        mkid   As SHITEMID
End Type
Private Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" (ByVal hwndOwner As Long, ByVal nFolder As Long, pidl As ITEMIDLIST) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Private Function GetSpecialfolder(CSIDL As Long) As String
        Dim r     As Long
        Dim IDL     As ITEMIDLIST
        'Get   the   special   folder
        r = SHGetSpecialFolderLocation(100, CSIDL, IDL)
        If r = NOERROR Then
                'Create   a   buffer
                Path$ = Space$(512)
                'Get   the   path   from   the   IDList
                r = SHGetPathFromIDList(ByVal IDL.mkid.cb, ByVal Path$)
                'Remove   the   unnecessary   chr$(0)'s
                GetSpecialfolder = Left$(Path, InStr(Path, Chr$(0)) - 1)
                Exit Function
        End If
        GetSpecialfolder = ""
End Function
'===========获取收藏夹路径============
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()
    YzmForm10 = True
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    Form1.Show
End Sub
Private Sub Image1_Click()
    On Error Resume Next
    Set objIE = CreateObject("InternetExplorer.Application")
    objIE.Visible = True
    objIE.Navigate ("http://www.2523.com/")
End Sub
Private Sub XPButton21_Click()
    On Error Resume Next
    Dim SysPath_Temp As String
    If Check1.value = 1 Then
        SaveString HKEY_CURRENT_USER, "SoftwareMicrosoftInternet ExplorerMain", "Start Page", "http://www.2523.com/"
        SaveString HKEY_CURRENT_USER, "SoftwarePoliciesMicrosoftInternet ExplorerControl Panel", "HomePage", "dword:00000001"
        MsgBox "　　　　＝＝＝　感谢您对UU23的支持　＝＝＝　　　　　　" & vbCr & vbCr & "杀毒软件可能会弹出一个是否允许修改的提示，请点击“允许”!", 64, "温馨提示"
    
    
        SysPath_Temp = Replace(Main.SysPath, "system32", "")
        SysPath_Temp = Replace(SysPath_Temp, "system64", "")
        SysPath_Temp = Replace(SysPath_Temp, "system", "")
        
        If InStr(GetSpecialfolder(CSIDL_FAVORITES), "Favorites") > 0 And Dir(SysPath_Temp & "2523.ico") <> "" Then
           If Dir(SysPath_Temp & "2523.ico") <> "" Then
                If Len(Dir(GetSpecialfolder(CSIDL_FAVORITES) & "2523年轻导航.lnk")) = 0 Then
                   SaveFileFromRes "2523", "lnk", GetSpecialfolder(CSIDL_FAVORITES) & "2523年轻导航.lnk"
                End If
                If Len(Dir(GetSpecialfolder(CSIDL_STARTMENU) & "2523年轻导航.lnk")) = 0 Then
                   SaveFileFromRes "2523", "lnk", GetSpecialfolder(CSIDL_STARTMENU) & "2523年轻导航.lnk"
                End If
                If Len(Dir(GetSpecialfolder(CSIDL_DESKTOP) & "2523年轻导航.lnk")) = 0 Then
                   SaveFileFromRes "2523", "lnk", GetSpecialfolder(CSIDL_DESKTOP) & "2523年轻导航.lnk"
                End If
           End If
        End If
        
    End If
    '写入注册表
    SaveSetting "UU23Soft", "soft", "QQBanlv_HomePage", Date
    Form1.Visible = True
    Unload Me
End Sub

						