registry editor.frm

大量优秀的vb编程

VERSION 5.00
Begin VB.Form Registry 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "注册表编辑器"
   ClientHeight    =   4848
   ClientLeft      =   2136
   ClientTop       =   1440
   ClientWidth     =   4584
   Icon            =   "Registry Editor.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   4848
   ScaleWidth      =   4584
   Begin VB.Frame Keys 
      Caption         =   "键"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   12
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   1452
      Left            =   600
      TabIndex        =   9
      Top             =   0
      Width           =   3252
      Begin VB.TextBox Text1 
         Height          =   372
         Left            =   1560
         TabIndex        =   12
         Top             =   360
         Width           =   1212
      End
      Begin VB.CommandButton Deletekeys 
         Caption         =   "删除键"
         Height          =   375
         Left            =   1680
         TabIndex        =   11
         Top             =   960
         Width           =   1215
      End
      Begin VB.CommandButton Createkeys 
         Caption         =   "创建键"
         Height          =   375
         Left            =   360
         TabIndex        =   10
         Top             =   960
         Width           =   1215
      End
      Begin VB.Label Label1 
         Caption         =   "指定名称"
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   12
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   372
         Left            =   360
         TabIndex        =   13
         Top             =   360
         Width           =   1092
      End
   End
   Begin VB.Frame Write 
      Caption         =   "写数据"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   12
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   1452
      Left            =   120
      TabIndex        =   5
      Top             =   1560
      Width           =   4332
      Begin VB.TextBox Text2 
         Height          =   372
         Left            =   1800
         TabIndex        =   15
         Top             =   360
         Width           =   1932
      End
      Begin VB.CommandButton Writestring 
         Caption         =   "写字符串数据"
         Height          =   375
         Left            =   240
         TabIndex        =   8
         Top             =   960
         Width           =   1215
      End
      Begin VB.CommandButton Writebinary 
         Caption         =   "写二进制数据"
         Height          =   375
         Left            =   1560
         TabIndex        =   7
         Top             =   960
         Width           =   1215
      End
      Begin VB.CommandButton Writedword 
         Caption         =   "写双字数据"
         Height          =   375
         Left            =   2880
         TabIndex        =   6
         Top             =   960
         Width           =   1215
      End
      Begin VB.Label Label2 
         Caption         =   "写入内容"
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   12
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   372
         Left            =   600
         TabIndex        =   14
         Top             =   360
         Width           =   1092
      End
   End
   Begin VB.Frame Read 
      Caption         =   "读取数据"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   12
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   975
      Left            =   120
      TabIndex        =   1
      Top             =   3240
      Width           =   4335
      Begin VB.CommandButton Readdword 
         Caption         =   "读取双字数据"
         Height          =   375
         Left            =   2880
         TabIndex        =   4
         Top             =   360
         Width           =   1215
      End
      Begin VB.CommandButton Readbinary 
         Caption         =   "读取二进制数据"
         Height          =   375
         Left            =   1560
         TabIndex        =   3
         Top             =   360
         Width           =   1215
      End
      Begin VB.CommandButton Readstring 
         Caption         =   "读取字符串数据"
         Height          =   375
         Left            =   240
         TabIndex        =   2
         Top             =   360
         Width           =   1215
      End
   End
   Begin VB.CommandButton Cancel 
      Caption         =   "退出程序"
      Height          =   375
      Left            =   1800
      TabIndex        =   0
      Top             =   4440
      Width           =   975
   End
End
Attribute VB_Name = "Registry"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim KeysName As String
Private Sub Cancel_Click()

Unload Me 'exit the program

End Sub





Private Sub Createkeys_Click()

'This creates a new key in the users registry.
If Trim(Text1) = "" Then
    MsgBox "请输入键名称"
    Text1.SetFocus
    Exit Sub
Else
    KeysName = "HKEY_LOCAL_MACHINE\Registry Editor\" & Trim(Text1)
    CreateKey KeysName
    MsgBox "键创建成功,位于:" + Chr(10) + Chr(10) + "HKEY_LOCAL_MACHINE\Registry Editor"
End If


End Sub

Private Sub Deletekeys_Click()

'This deletes a key in the users registry. All sub keys and entrys under
'this key will also be deleted.


DeleteKey "HKEY_LOCAL_MACHINE\Registry Editor"

MsgBox KeysName & "HKEY_LOCAL_MACHINE\Registry Editor下的所有内容已经被删除"

End Sub

Private Sub Form_Load()

Move (Screen.Width - Width) \ 2, (Screen.Height - Height) \ 2 'centre the form on the screen

'This project was downloaded from
'
'http://www.brianharper.demon.co.uk/
'
'Please use this project and all of its source code however you want.
'
'UNZIPPING
'To unzip the project files you will need a 32Bit unzipper program that
'can handle long file names. If you have a latest copy of Winzip installed
'on your system then you may use that. If you however dont have a copy,
'then visit my web site, go into the files section and from there you can
'click on the Winzip link to goto their site and download a copy of the
'program. By doing this you will now beable to unzip the project files
'retaining their proper long file names.
'Once upzipped, load up your copy of Visual Basic and goto
'File/Open Project. Locate the project files to where ever you unzipped
'them, then click Open. The project files will be loaded and are now ready
'for use.
'
'THE PROJECT
'Well....This project can and is the most valuable of them all. Most if not
'all of Windows programs to this day, read and write the the users system
'registry to store data in some kind of way. I have tried to make this
'process as simple as possible by putting each function into its own
'seperate precedure. I myself think it is quite simple once you know what
'your actually trying to do. There are three different types of entrys that
'can be written to or read from. The most common of the three is String
'values. String values can hold any text or number. The other two you might
'never use, but are handy to know  you have access to theme.
'
'Binary entrys are that little bit more complicated as these are all to do
'with bytes and hexadecimal. I, myself really arnt all that sure on these
'types of entrys, but hopefully you will learn as time goes on.
'
'For some reason but I dont really know why, when you call the function,
'DeleteKey, it doesnt seem to work. I am looking into this, but there
'doesnt seem to be anything wronge with the code.
'
'NOTES
'I have only provided the necessary project files with the zip. This keeps
'the size of the zip files down to a minimum and enables me to upload more
'prjects files to my site.
'
'I hope you find the project usful in what ever you are programming. I
'have tried to write out a small explanation of what each line of code
'does in the project, although most of it is pretty simple to understand.
'
'If you find any bugs in the code then please dont hesitate to Email me and
'I will get back to you as soon as possible. If you however need help on a
'different matter concerning Visual Basic then please please Email me as
'I like to here from people and here what they are programming.
'
'My Email address is:
'[e-mail]
'
'My web site is:
'http://www.brianharper.demon.co.uk/
'
'Please visit my web site and find many other useful projects like this.
'

End Sub

Private Sub Readbinary_Click()

'This calls the GetBinaryValue function. This function reads a Binary
'value from the users registry. The first part of the function gives the
'full path of the location at which the key is located. The second part is
'the name of the entry. The MsgBox returns the value from the registry. If
'the value counld not be found, then "Error" will be returned and displayed
'in the Msgbox.

rtn = GetBinaryValue("HKEY_LOCAL_MACHINE", "Binary Value")
If rtn = Chr$(&H1) + Chr$(&H2) + Chr$(&H3) + Chr$(&H4) Then
   MsgBox "The value was returned successfully..."
End If

End Sub

Private Sub Readdword_Click()

'This calls the GetDWORDValue function. This function reads a DWORD
'value from the users registry. The first part of the function gives the
'full path of the location at which the key is located. The second part is
'the name of the entry. The MsgBox returns the value from the registry. If
'the value counld not be found, then "Error" will be returned and displayed
'in the Msgbox.

MsgBox GetDWORDValue("HKEY_LOCAL_MACHINE", "DWORD Value")

End Sub

Private Sub Readstring_Click()

'This calls the GetStringValue function. This function reads a String
'value from the users registry. The first part of the function gives the
'full path of the location at which the key is located. The second part is
'the name of the entry. The MsgBox returns the value from the registry. If
'the value counld not be found, then "Error" will be returned and displayed
'in the Msgbox.
'
'If you need to read the default value fron a key, then leave the name of
'the the entry blank (""). This will then, not look for a string, but will
'return the default value a key.

MsgBox GetStringValue("HKEY_LOCAL_MACHINE", "String Value")

End Sub


Private Sub Writebinary_Click()

'This calls the SetBinaryValue function. This function writes a Binary
'value to the users registry. The first part of the function gives the full
'path of the location at which the key is located. The second part is the
'name of the entry. The third and final part of the function is the value
'at which is to be written to the entry.
'
'Binary values are slightly different to string and DWORD values such that
'they work in bytes. It can get quite complicated when dealing with these,
'but hopefully you should very rarly use them. To write a hexadecimal value
'of "00 00 00 00" in the registry, you have to use the Chr$(&H0)+Chr$(&H0)
'+Chr$(&H0)+Chr$(&H0).
'
'If the entry you are writting to in the regsitry does not exist, then a
'new entry will be created with the name and value specified.

SetBinaryValue "HKEY_LOCAL_MACHINE", "Binary Value", Chr$(&H1) + Chr$(&H2) + Chr$(&H3) + Chr$(&H4)

MsgBox "A Binary Value has been created in you system registry at:" + Chr(10) + Chr(10) + "HKEY_LOCAL_MACHINE" + Chr(10) + Chr(10) + "The Binary was called ""Binary Value"" and the value written was:" + Chr(10) + Chr(10) + "01 02 03 04"

End Sub

Private Sub Writedword_Click()

'This calls the SetDWORDValue function. This function writes a DWORD
'value to the users registry. The first part of the function gives the full
'path of the location at which the key is located. The second part is the
'name of the DWORD. The third and final part of the function is the value
'at which is to be written to the DWORD value.
'
'If the entry you are writting to in the regsitry does not exist, then a
'new entry will be created with the name and value specified.
If Trim(Text2) = "" Then
    MsgBox "请输入内容!", vbOKOnly, "错误"
    Text2.SetFocus
    Exit Sub
Else
    If IsNumeric(Trim(Text2)) Then
        SetDWORDValue "HKEY_LOCAL_MACHINE", "DWORD Value", Text2
        MsgBox "A DWORD Value has been created in you system registry at:" + Chr(10) + Chr(10) + "HKEY_LOCAL_MACHINE" + Chr(10) + Chr(10) + "The DWORD was called ""Dword Value"" and the value written was:" + Chr(10) + Chr(10) + Text2
    Else
        MsgBox "请输入数字!", vbOKOnly, "错误"
        Text2.SetFocus
        Exit Sub
    End If
    
End If

End Sub

Private Sub Writestring_Click()

'This calls the SetStringValue function. This function writes a String
'value to the users registry. The first part of the function gives the full
'path of the location at which the key is located. The second part is the
'name of the entry. The third and final part of the function is the value
'at which is to be written to the entry.
'
'If the entry you are writting to in the regsitry does not exist, then a
'new entry will be created with the name and value specified.
If Trim(Text2) = "" Then
    MsgBox "请输入内容!", vbOKOnly, "错误"
    Text2.SetFocus
    Exit Sub
Else
    SetStringValue "HKEY_LOCAL_MACHINE", "String Value", Text2
    MsgBox "A String Value has been created in you system registry at:" + Chr(10) + Chr(10) + "HKEY_LOCAL_MACHINE" + Chr(10) + Chr(10) + "The String was called ""String Value"" and the value written was:" + Chr(10) + Chr(10) + Text2
End If

End Sub