Mastering Visual Basic 6/mastvb6.iso/ch_code/ch13/registry/registry.frm

Visual Basic Form | 1996-04-30 | 7.1 KB | 206 lines

VERSION 5.00
Begin VB.Form Form1
   Caption         =   "Using the Registry"
   ClientHeight    =   4260
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   4995
   LinkTopic       =   "Form1"
   ScaleHeight     =   4260
   ScaleWidth      =   4995
   StartUpPosition =   3  'Windows Default
   Begin VB.Frame Frame2
      Caption         =   "Window Height"
      Height          =   1455
      Left            =   120
      TabIndex        =   7
      Top             =   2400
      Width           =   4575
      Begin VB.Label Label10
         Caption         =   "Subkey Name:"
         Height          =   255
         Left            =   240
         TabIndex        =   11
         Top             =   360
         Width           =   1215
      End
      Begin VB.Label Label9
         Caption         =   "Subkey Value:"
         Height          =   255
         Left            =   240
         TabIndex        =   10
         Top             =   840
         Width           =   1215
      End
      Begin VB.Label Label8
         Height          =   255
         Left            =   1560
         TabIndex        =   9
         Top             =   360
         Width           =   2775
      End
      Begin VB.Label Label7
         Height          =   255
         Left            =   1560
         TabIndex        =   8
         Top             =   840
         Width           =   2895
      End
   End
   Begin VB.Frame Frame1
      Caption         =   "Window Width"
      Height          =   1455
      Left            =   120
      TabIndex        =   1
      Top             =   600
      Width           =   4575
      Begin VB.Label Label5
         Height          =   255
         Left            =   1560
         TabIndex        =   5
         Top             =   840
         Width           =   2895
      End
      Begin VB.Label Label4
         Height          =   255
         Left            =   1560
         TabIndex        =   4
         Top             =   360
         Width           =   2775
      End
      Begin VB.Label Label3
         Caption         =   "Subkey Value:"
         Height          =   255
         Left            =   240
         TabIndex        =   3
         Top             =   840
         Width           =   1215
      End
      Begin VB.Label Label2
         Caption         =   "Subkey Name:"
         Height          =   255
         Left            =   240
         TabIndex        =   2
         Top             =   360
         Width           =   1215
      End
   End
   Begin VB.Label Label6
      Height          =   255
      Left            =   1920
      TabIndex        =   6
      Top             =   120
      Width           =   2775
   End
   Begin VB.Label Label1
      Caption         =   "Registry Key:"
      Height          =   255
      Left            =   240
      TabIndex        =   0
      Top             =   120
      Width           =   1335
   End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'  ******************************
'  ******************************
'  ** MASTERING VB6            **
'  ** by Evangelos Petroutos   **
'  ** SYBEX, 1998              **
'  ******************************
'  ******************************
Option Explicit
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 RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" _
    (ByVal hKey As Long, ByVal lpSubKey As String) As Long
Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" _
    (ByVal hKey As Long, ByVal lpValueName As String) As Long
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" _
    (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, _
    lpType As Long, lpData As Any, lpcbData 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
Const ERROR_SUCCESS = 0&
Const ERROR_BADDB = 1009&
Const ERROR_BADKEY = 1010&
Const ERROR_CANTOPEN = 1011&
Const ERROR_CANTREAD = 1012&
Const ERROR_CANTWRITE = 1013&
Const ERROR_REGISTRY_RECOVERED = 1014&
Const ERROR_REGISTRY_CORRUPT = 1015&
Const ERROR_REGISTRY_IO_FAILED = 1016&
Const HKEY_CLASSES_ROOT = &H80000000
Const HKEY_CURRENT_USER = &H80000001
Const HKEY_LOCAL_MACHINE = &H80000002
Const REG_SZ = 1
Const regKey = "\Sybex\Mastering VB 5.0"
Private Sub Form_Load()
Dim retValue As Long
Dim result As Long
Dim keyID As Long
Dim keyValue As String
Dim subKey As String
Dim bufSize As Long
    Label6.Caption = regKey
    'Create key
    retValue = RegCreateKey(HKEY_LOCAL_MACHINE, regKey, keyID)
    If retValue = 0 Then
        'Create width
        subKey = "Window Width"
        retValue = RegQueryValueEx(keyID, subKey, 0&, REG_SZ, _
                   0&, bufSize)
        'No value, set it
        If bufSize < 2 Then
            keyValue = Me.Width
            retValue = RegSetValueEx(keyID, subKey, 0&, _
                                        REG_SZ, ByVal keyValue, Len(keyValue) + 1)
        Else

            keyValue = String(bufSize + 1, " ")
            retValue = RegQueryValueEx(keyID, subKey, 0&, REG_SZ, _
                       ByVal keyValue, bufSize)
            keyValue = Left$(keyValue, bufSize - 1)
            Me.Width = keyValue
        End If
        'Set values on form
        Label4.Caption = subKey
        Label5.Caption = Me.Width
        'Create height
        subKey = "Window Height"
        retValue = RegQueryValueEx(keyID, subKey, 0&, REG_SZ, _
                   0&, bufSize)
        If bufSize < 2 Then
            keyValue = Me.Height
            retValue = RegSetValueEx(keyID, subKey, 0&, _
                       REG_SZ, ByVal keyValue, Len(keyValue) + 1)
        Else
            keyValue = String(bufSize + 1, " ")
            retValue = RegQueryValueEx(keyID, subKey, 0&, REG_SZ, _
                       ByVal keyValue, bufSize)
            keyValue = Left$(keyValue, bufSize - 1)
            Me.Height = keyValue
        End If
        'Set values on form
        Label8.Caption = subKey
        Label7.Caption = Me.Height
    End If
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Dim keyValue As String
Dim retValue As Long
Dim keyID As Long
    retValue = RegCreateKey(HKEY_LOCAL_MACHINE, regKey, keyID)
    keyValue = Me.Width
    retValue = RegSetValueEx(keyID, "Window Width", 0&, _
               REG_SZ, ByVal keyValue, Len(keyValue) + 1)
    keyValue = Me.Height
    retValue = RegSetValueEx(keyID, "Window Height", 0&, _
               REG_SZ, ByVal keyValue, Len(keyValue) + 1)
    MsgBox "Registry updated"
End Sub