form1.frm

vb源码大全

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   1860
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   5115
   LinkTopic       =   "Form1"
   ScaleHeight     =   1860
   ScaleWidth      =   5115
   StartUpPosition =   3  'Windows Default
   Begin VB.CommandButton Command1 
      Caption         =   "设置主页"
      Height          =   375
      Left            =   1680
      TabIndex        =   2
      Top             =   1080
      Width           =   1575
   End
   Begin VB.TextBox Text1 
      Height          =   375
      Left            =   1440
      TabIndex        =   1
      Top             =   480
      Width           =   3015
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "URL"
      Height          =   180
      Left            =   720
      TabIndex        =   0
      Top             =   600
      Width           =   270
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'枚举，设置注册表中的根目录
Public Enum REG_TOPLEVEL_KEYS
HKEY_CLASSES_ROOT = &H80000000
'HKEY_CLASSES_ROOT根目录
HKEY_CURRENT_CONFIG = &H80000005
HKEY_CURRENT_USER = &H80000001
HKEY_DYN_DATA = &H80000006
HKEY_LOCAL_MACHINE = &H80000002
HKEY_PERFORMANCE_DATA = &H80000004
HKEY_USERS = &H80000003
End Enum
'建立键
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 RegCloseKey Lib "advapi32.dll" (ByVal Hkey 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 Const REG_SZ = 1


Private Sub Command1_Click()
Dim result As Boolean
result = SetIEHomePage(Text1.Text)
If result Then
MsgBox ("主页设置为:" & Text1.Text)
Else
MsgBox ("主页设置出错")
End If
End Sub

Public Function SetIEHomePage(ByVal URL As String) As Boolean
SetIEHomePage = WriteStringToRegistry(HKEY_CURRENT_USER, "Software\Microsoft\Internet Explorer\Main", "Start Page", URL)
End Function
Private Function WriteStringToRegistry(Hkey As REG_TOPLEVEL_KEYS, strPath As String, _
strValue As String, strdata As String) As Boolean
On Error GoTo ErrorHandler
'运行错误转到ErrorHandler
Dim keyhand As Long
Dim r As Long
'建立键
r = RegCreateKey(Hkey, strPath, keyhand)
If r = 0 Then
'建立成功
'设置键值
r = RegSetValueEx(keyhand, strValue, 0, REG_SZ, ByVal strdata, Len(strdata))
'关闭键
r = RegCloseKey(keyhand)
End If
'设置返回值
WriteStringToRegistry = (r = 0)
Exit Function
ErrorHandler:
'错误处理代码段
WriteStringToRegistry = False
MsgBox Err.Description
End Function