Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium

x
?
Solved

Saving Settings to the Registry

Posted on 2006-04-27
5
Medium Priority
?
277 Views
Last Modified: 2011-10-03
I want to make my app save to the registry with the Author name

VB always save to the registry with this 'VB And VBA Program Settings'

I want to save the setting with a diferent name and not with the VB Default name

If i call the save setting like the one bellow...

SaveSetting ("Name of my App", "Text 1", "Text 2", Text1.Text)

This is the result in the registry...

Author: VB And VBA Program Settings
Software: Name of my App
Age: New

I want to replace this ‘VB And VBA Program Settings’ with Author name.

Any help

Thanks
0
Comment
Question by:Dazm
  • 2
  • 2
5 Comments
 
LVL 29

Expert Comment

by:nffvrxqgrcfqvvc
ID: 16560711
SaveSetting is restricted to writting to  (VB And VBA Program)  you can't write values outside this main key.Howevr you can have nested folders within it. If you want to save to any part of the registry than you will need to use windows API registry functions.

HKEY_CURRENT_USER
      \Software
         \VB and VBA Program Settings
            \MyApp
               \Authors
                              age = 34

SaveSetting "Name of my App", "Authors", "Age", "34"
0
 
LVL 2

Author Comment

by:Dazm
ID: 16562038
I got this from Reg Cleaner

Author:  |  Software:  |  Age:
=====     ======      ===

There are many programs that show in the registry as [Unknown]...
That may be because they are made in C++, Delphi or other language.

But there was this little program I download, it was made in VB
I don't know how they did that, but Reg Cleaner show up his name
and the name of the program and the age setting in the registry.

If you have Reg Cleaner...
Open it up, and take a look.
You'll see what am talking about.

I try you example,
but i have a question...
Does [ the VB And VBA Program ] still show up?


Thanks
0
 
LVL 5

Expert Comment

by:lunchbyte
ID: 16565545
Copy and paste the code below to your new module or class. DO a search and replace for savesetting to savestringsetting and getsetting to getstringsetting. This will use local  machine key.




Option Explicit

Private Const REG_SZ                    As Long = 1

Private Const HKEY_LOCAL_MACHINE        As Long = &H80000002
Private Const BASE_KEY                  As String = "SOFTWARE"

Private Const ERROR_NONE                As Long = 0
Private Const ERROR_KEY_DOES_NOT_EXIST  As Long = 2

Private Const READ_CONTROL              As Long = &H20000
Private Const STANDARD_RIGHTS_READ      As Long = (READ_CONTROL)
Private Const STANDARD_RIGHTS_ALL       As Long = &H1F0000
Private Const KEY_QUERY_VALUE           As Long = &H1
Private Const KEY_SET_VALUE             As Long = &H2
Private Const KEY_CREATE_SUB_KEY        As Long = &H4
Private Const KEY_ENUMERATE_SUB_KEYS    As Long = &H8
Private Const KEY_NOTIFY                As Long = &H10
Private Const KEY_CREATE_LINK           As Long = &H20
Private Const SYNCHRONIZE               As Long = &H100000
Private Const KEY_ALL_ACCESS            As Long = ((STANDARD_RIGHTS_ALL Or _
                                                    KEY_QUERY_VALUE Or _
                                                    KEY_SET_VALUE Or _
                                                    KEY_CREATE_SUB_KEY Or _
                                                    KEY_ENUMERATE_SUB_KEYS Or _
                                                    KEY_NOTIFY Or _
                                                    KEY_CREATE_LINK) _
                                                    And (Not SYNCHRONIZE))
Private Const KEY_READ                  As Long = ((STANDARD_RIGHTS_READ Or _
                                                    KEY_QUERY_VALUE Or _
                                                    KEY_ENUMERATE_SUB_KEYS Or _
                                                    KEY_NOTIFY) _
                                                    And (Not SYNCHRONIZE))

Private Declare Function RegCloseKey _
    Lib "advapi32.dll" _
    (ByVal hKey As Long) As Long
   
Private Declare Function RegCreateKeyEx _
    Lib "advapi32.dll" Alias "RegCreateKeyExA" _
    (ByVal hKey As Long, _
     ByVal lpSubKey As String, _
     ByVal Reserved As Long, _
     ByVal lpClass As String, _
     ByVal dwOptions As Long, _
     ByVal samDesired As Long, _
     ByVal lpSecurityAttributes As Long, _
     phkResult As Long, _
     lpdwDisposition As Long) As Long
     
Private Declare Function RegOpenKeyEx _
    Lib "advapi32.dll" Alias "RegOpenKeyExA" _
    (ByVal hKey As Long, _
     ByVal lpSubKey As String, _
     ByVal ulOptions As Long, _
     ByVal samDesired As Long, _
     phkResult As Long) As Long
     
Private Declare Function RegQueryValueExString _
    Lib "advapi32.dll" Alias "RegQueryValueExA" _
    (ByVal hKey As Long, _
     ByVal lpValueName As String, _
     ByVal lpReserved As Long, _
     lpType As Long, _
     ByVal lpData As String, _
     lpcbData As Long) As Long
     
Private Declare Function RegQueryValueExNULL _
    Lib "advapi32.dll" Alias "RegQueryValueExA" _
    (ByVal hKey As Long, _
     ByVal lpValueName As String, _
     ByVal lpReserved As Long, _
     lpType As Long, _
     ByVal lpData As Long, _
     lpcbData As Long) As Long
     
Private Declare Function RegSetValueExString _
    Lib "advapi32.dll" Alias "RegSetValueExA" _
    (ByVal hKey As Long, _
     ByVal lpValueName As String, _
     ByVal Reserved As Long, _
     ByVal dwType As Long, _
     ByVal lpData As String, _
     ByVal cbData As Long) As Long
Public Sub SaveStringSetting(ByVal sAppName As String, _
                             ByVal sSection As String, _
                             ByVal sKey As String, _
                             ByVal sSetting As String)
    Dim lRetVal         As Long
    Dim sNewKey         As String
    Dim lDisposition    As Long
    Dim lHandle         As Long
    Dim lErrNumber      As Long
    Dim sErrDescription As String
    Dim sErrSource      As String
   
    On Error GoTo ERROR_HANDLER
   
    If Trim(sAppName) = "" Then
        Err.Raise vbObjectError + 1000, , "AppName may not be empty"
    End If
    If Trim(sSection) = "" Then
        Err.Raise vbObjectError + 1001, , "Section may not be empty"
    End If
    If Trim(sKey) = "" Then
        Err.Raise vbObjectError + 1002, , "Key may not be empty"
    End If
   
    sNewKey = BASE_KEY & "\" & Trim(sAppName) & "\" & Trim(sSection)
   
    ' Create the key or open it if it already exists
    lRetVal = RegCreateKeyEx(HKEY_LOCAL_MACHINE, sNewKey, 0, vbNullString, 0, _
        KEY_ALL_ACCESS, 0, lHandle, lDisposition)
       
    If lRetVal <> ERROR_NONE Then
        Err.Raise vbObjectError + 2000 + lRetVal, , _
            "Could not open/create registry section"
    End If
   
    ' Set the key value
    lRetVal = RegSetValueExString(lHandle, sKey, 0, REG_SZ, sSetting, _
        Len(sSetting))
   
    If lRetVal <> ERROR_NONE Then
        Err.Raise vbObjectError + 2000 + lRetVal, , "Could not set key value"
    End If
   
TIDY_UP:
    On Error Resume Next
   
    RegCloseKey lHandle
   
    If lErrNumber <> 0 Then
        On Error GoTo 0
       
        Err.Raise lErrNumber, sErrSource, sErrDescription
    End If
Exit Sub

ERROR_HANDLER:
    lErrNumber = Err.Number
    sErrSource = Err.Source
    sErrDescription = Err.Description
    Resume TIDY_UP
End Sub
Public Function GetStringSetting(ByVal sAppName As String, _
                                 ByVal sSection As String, _
                                 ByVal sKey As String, _
                                 Optional ByVal sDefault As String) As String
    Dim lRetVal         As Long
    Dim sFullKey        As String
    Dim lHandle         As Long
    Dim lType           As Long
    Dim lLength         As Long
    Dim sValue          As String
    Dim lErrNumber      As Long
    Dim sErrDescription As String
    Dim sErrSource      As String
   
    On Error GoTo ERROR_HANDLER

    If Trim(sAppName) = "" Then
        Err.Raise vbObjectError + 1000, , "AppName may not be empty"
    End If
    If Trim(sSection) = "" Then
        Err.Raise vbObjectError + 1001, , "Section may not be empty"
    End If
    If Trim(sKey) = "" Then
        Err.Raise vbObjectError + 1002, , "Key may not be empty"
    End If
   
    sFullKey = BASE_KEY & "\" & Trim(sAppName) & "\" & Trim(sSection)

    ' Open up the key
    lRetVal = RegOpenKeyEx(HKEY_LOCAL_MACHINE, sFullKey, 0, KEY_READ, lHandle)
    If lRetVal <> ERROR_NONE Then
        If lRetVal = ERROR_KEY_DOES_NOT_EXIST Then
            GetStringSetting = sDefault
            Exit Function
        Else
            Err.Raise vbObjectError + 2000 + lRetVal, , _
                "Could not open registry section"
        End If
    End If
   
    ' Get size and type
    lRetVal = RegQueryValueExNULL(lHandle, sKey, 0, lType, 0, lLength)
    If lRetVal <> ERROR_NONE Then
        GetStringSetting = sDefault
        Exit Function
    End If
   
    ' Is it stored as a string in the registry?
    If lType = REG_SZ Then
        sValue = String(lLength, 0)
       
        If lLength = 0 Then
            GetStringSetting = ""
        Else
            lRetVal = RegQueryValueExString(lHandle, sKey, 0, lType, _
                sValue, lLength)
           
            If lRetVal = ERROR_NONE Then
                GetStringSetting = Left(sValue, lLength - 1)
            Else
                GetStringSetting = sDefault
            End If
        End If
    Else
        Err.Raise vbObjectError + 2000 + lType, , _
            "Registry data not a string"
    End If
   
TIDY_UP:
    On Error Resume Next
   
    RegCloseKey lHandle
   
    If lErrNumber <> 0 Then
        On Error GoTo 0
       
        Err.Raise lErrNumber, sErrSource, sErrDescription
    End If
Exit Function

ERROR_HANDLER:
    lErrNumber = Err.Number
    sErrSource = Err.Source
    sErrDescription = Err.Description
    Resume TIDY_UP
End Function
0
 
LVL 5

Accepted Solution

by:
lunchbyte earned 100 total points
ID: 16565549
by the way this is worth more then 25 points. :)

0
 
LVL 2

Author Comment

by:Dazm
ID: 16566134
Thanks lunchbyte
Thats the answer to my question : )

I really apreciate

Thank you.

OOOHH!!!!!!!!!!!!! MAN
I was going to split points and also add 50 more points to you answer.
What can i do now?
The question is close... i don't see a way to revert it : (
I guess i need help to split points and also to lieve it with 60 points in total.
10 points for egl1044 and 50 for you.
0

Featured Post

Free Tool: ZipGrep

ZipGrep is a utility that can list and search zip (.war, .ear, .jar, etc) archives for text patterns, without the need to extract the archive's contents.

One of a set of tools we're offering as a way to say thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Have you ever wanted to restrict the users input in a textbox to numbers, and while doing that make sure that they can't 'cheat' by pasting in non-numeric text? Of course you can do that with code you write yourself but it's tedious and error-prone …
When designing a form there are several BorderStyles to choose from, all of which can be classified as either 'Fixed' or 'Sizable' and I'd guess that 'Fixed Single' or one of the other fixed types is the most popular choice. I assume it's the most p…
As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…
Suggested Courses

580 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question