Go Premium for a chance to win a PS4. Enter to Win

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 964
  • Last Modified:

Best method to wrtie to the registry using VB6

We are modifying all our apps, developed in Visual Basic 6.  We are incorporating a scheme to protect the apps and we need to write data to the windows registry.

How can this be done in VB6?

What areas in the Registry are safe for doing this and what considerations we need to keep in mind?
0
rayluvs
Asked:
rayluvs
  • 19
  • 16
  • 7
  • +3
16 Solutions
 
rayluvsAuthor Commented:
Thanx... but to test it I need to give it a MainKey,  SubKey , value.  For testing purposes can you provide me some of those names?
0
 
rayluvsAuthor Commented:
I am looking over the link you provide and it refers to alot of VB3 thru VB6.  Question, the code for registrry is it for XP, Vista and Windows 7?
0
Get free NFR key for Veeam Availability Suite 9.5

Veeam is happy to provide a free NFR license (1 year, 2 sockets) to all certified IT Pros. The license allows for the non-production use of Veeam Availability Suite v9.5 in your home lab, without any feature limitations. It works for both VMware and Hyper-V environments

 
silemoneCommented:
Ramante,
like .NET 2.0 -> 4.0, VB3 -> VB6 was pretty much the same except for some upgrades - some added functions, some deprecated functions probably removed.

The Registry does not change with each windows version.  
0
 
GMGeniusCommented:
I use some code I found along time ago, made some minor changes to it but it suits my needs
Save the below into a Module
To use., here are some simple examples
Read from the registry
sRegPath = "SOFTWARE\" & App.CompanyName & "\" & App.ProductName
ReadRegistry(HKEY_LOCAL_MACHINE, sRegPath, "Company")
To write to the registry
Call WriteRegistry(HKEY_LOCAL_MACHINE, sRegPath, "DBPath", ValString, sDBPath)

'
' Created by E.Spencer (elliot@spnc.demon.co.uk) - This code is public domain.
'
Option Explicit
Private Const ERROR_FILE_NOT_FOUND = 2&
Private Const ERROR_PATH_NOT_FOUND = 3&
Private Const ERROR_BAD_FORMAT = 11&
Private Const SE_ERR_ACCESSDENIED = 5        ' access denied
Private Const SE_ERR_ASSOCINCOMPLETE = 27
Private Const SE_ERR_DDEBUSY = 30
Private Const SE_ERR_DDEFAIL = 29
Private Const SE_ERR_DDETIMEOUT = 28
Private Const SE_ERR_DLLNOTFOUND = 32
Private Const SE_ERR_FNF = 2                ' file not found
Private Const SE_ERR_NOASSOC = 31
Private Const SE_ERR_PNF = 3                ' path not found
Private Const SE_ERR_OOM = 8                ' out of memory
Private Const SE_ERR_SHARE = 26

Public Enum EShellShowConstants
   essSW_HIDE = 0
   essSW_MAXIMIZE = 3
   essSW_MINIMIZE = 6
   essSW_SHOWMAXIMIZED = 3
   essSW_SHOWMINIMIZED = 2
   essSW_SHOWNORMAL = 1
   essSW_SHOWNOACTIVATE = 4
   essSW_SHOWNA = 8
   essSW_SHOWMINNOACTIVE = 7
   essSW_SHOWDEFAULT = 10
   essSW_RESTORE = 9
   essSW_SHOW = 5
End Enum

' Security Mask constants
Public Const READ_CONTROL As Variant = &H20000
Public Const SYNCHRONIZE As Variant = &H100000
Public Const STANDARD_RIGHTS_ALL As Variant = &H1F0000
Public Const STANDARD_RIGHTS_READ As Variant = READ_CONTROL
Public Const STANDARD_RIGHTS_WRITE As Variant = READ_CONTROL
Public Const KEY_QUERY_VALUE As Variant = &H1
Public Const KEY_SET_VALUE As Variant = &H2
Public Const KEY_CREATE_SUB_KEY As Variant = &H4
Public Const KEY_ENUMERATE_SUB_KEYS As Variant = &H8
Public Const KEY_NOTIFY As Variant = &H10
Public Const KEY_CREATE_LINK As Variant = &H20
Public Const KEY_ALL_ACCESS As Variant = ((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))
Public Const KEY_READ As Variant = ((STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And (Not SYNCHRONIZE))
Public Const KEY_EXECUTE As Variant = ((KEY_READ) And (Not SYNCHRONIZE))
Public Const KEY_WRITE As Variant = ((STANDARD_RIGHTS_WRITE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY) And (Not SYNCHRONIZE))
' Possible registry data types
Public Enum InTypes_enum
   ValNull = 0
   ValString = 1
   ValXString = 2
   ValBinary = 3
   ValDWord = 4
   ValLink = 6
   ValMultiString = 7
   ValResList = 8
End Enum
' Temporary Stack Storage Variables
Private Temp As Long
Dim TempEx As Long
Dim TempExA As String
Private TempExB&, TempExC%

' Handle And Other Storage Variables
Private hHnd As Long
Private KeyPath As String
Private hDepth As Long

' Variable To Hold Last Error
Public RegLastError As Long

' Registry value type definitions
Public Const REG_NONE As Long = 0
Public Const REG_SZ As Long = 1
Public Const REG_EXPAND_SZ As Long = 2
Public Const REG_BINARY As Long = 3
Public Const REG_DWORD As Long = 4
Public Const REG_LINK As Long = 6
Public Const REG_MULTI_SZ As Long = 7
Public Const REG_RESOURCE_LIST As Long = 8
' Registry section definitions
Public Enum hKeyNames
   HKEY_CLASSES_ROOT = &H80000000
   HKEY_CURRENT_USER = &H80000001
   HKEY_LOCAL_MACHINE = &H80000002
   HKEY_USERS = &H80000003
   HKEY_PERFORMANCE_DATA = &H80000004
   HKEY_CURRENT_CONFIG = &H80000005
   HKEY_DYN_DATA = &H80000006
End Enum

' Codes returned by Reg API calls
Public Const ERROR_NONE = 0
Public Const ERROR_BADDB = 1
Public Const ERROR_BADKEY = 2
Public Const ERROR_CANTOPEN = 3
Public Const ERROR_CANTREAD = 4
Public Const ERROR_CANTWRITE = 5
Public Const ERROR_OUTOFMEMORY = 6
Public Const ERROR_INVALID_PARAMETER = 7
Public Const ERROR_ACCESS_DENIED = 8
Public Const ERROR_INVALID_PARAMETERS = 87
Public Const ERROR_NO_MORE_ITEMS = 259
' Registry API functions used in this module (there are more of them)
Public Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Public 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
Public Declare Function RegQueryValueEx 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
Public Declare Function RegEnumValue Lib "advapi32.dll" Alias "RegEnumValueA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpValueName As String, lpcbValueName As Long, ByVal lpReserved As Long, lpType As Long, ByVal lpData As String, lpcbData As Long) As Long
Public Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Public Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Public 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 lpValue As String, ByVal cbData As Long) As Long
Public Declare Function RegSetValueExLong Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpValue As Long, ByVal cbData As Long) As Long
Public Declare Function RegFlushKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Public Declare Function RegEnumKey Lib "advapi32.dll" Alias "RegEnumKeyA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, ByVal cbName As Long) As Long
Public Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long
Public Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long
Public Declare Function RegSetValueExB Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByRef lpData As Byte, ByVal cbData As Long) As Long
Declare Function ShellExecuteForExplore Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, lpParameters As Any, lpDirectory As Any, ByVal nShowCmd As Long) As Long
Declare Function ShellExecute Lib "shell32" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

' This routine allows you to get values from anywhere in the Registry, it currently
' only handles string, double word and binary values. Binary values are returned as
' hex strings.
'
' Example
' Text1.Text = ReadRegistry(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon\", "DefaultUserName")
'
Public Function ReadRegistry(ByVal Group As Long, ByVal Section As String, ByVal Key As String, Optional sDefault As String = "Not Found") As String
Dim lResult As Long, lKeyValue As Long, lDataTypeValue As Long, lValueLength As Long, sValue As String, td As Double
Dim TStr1 As String, TStr2 As String
Dim i As Integer
      On Error Resume Next
      lResult = RegOpenKey(Group, Section, lKeyValue)
      sValue = Space$(2048)
      lValueLength = Len(sValue)
      lResult = RegQueryValueEx(lKeyValue, Key, 0&, lDataTypeValue, sValue, lValueLength)
      If (lResult = 0) And (Err.Number = 0) Then
         If lDataTypeValue = REG_DWORD Then
            td = Asc(Mid$(sValue, 1, 1)) + &H100& * Asc(Mid$(sValue, 2, 1)) + &H10000 * Asc(Mid$(sValue, 3, 1)) + &H1000000 * CDbl(Asc(Mid$(sValue, 4, 1)))
            sValue = Format$(td, "000")
         End If
         If lDataTypeValue = REG_BINARY Then
            ' Return a binary field as a hex string (2 chars per byte)
            TStr2 = ""
            For i = 1 To lValueLength
               TStr1 = Hex(Asc(Mid$(sValue, i, 1)))
               If Len(TStr1) = 1 Then TStr1 = "0" & TStr1
               TStr2 = TStr2 + TStr1
            Next
            sValue = TStr2
         Else
            sValue = Left$(sValue, lValueLength - 1)
         End If
      Else
         sValue = sDefault
      End If
      lResult = RegCloseKey(lKeyValue)
      ReadRegistry = sValue
End Function

' This routine allows you to write values into the entire Registry, it currently
' only handles string and double word values.
'
' Example
' WriteRegistry HKEY_CURRENT_USER, "SOFTWARE\My Name\My App\", "NewSubKey", ValString, "NewValueHere"
' WriteRegistry HKEY_CURRENT_USER, "SOFTWARE\My Name\My App\", "NewSubKey", ValDWord, "31"
'
Public Sub WriteRegistry(ByVal Group As Long, ByVal Section As String, ByVal Key As String, ByVal ValType As InTypes_enum, ByVal Value As Variant)
Dim lResult As Long
Dim lKeyValue As Long
Dim InLen As Long
Dim lNewVal As Long
Dim sNewVal As String
Dim i As Integer
Dim lDataSize As Integer
Dim ByteArray() As Byte

      On Error Resume Next
      lResult = RegCreateKey(Group, Section, lKeyValue)
      If ValType = ValDWord Then
         lNewVal = CLng(Value)
         InLen = 4
         lResult = RegSetValueExLong(lKeyValue, Key, 0&, ValType, lNewVal, InLen)
      Else
         ' Fixes empty string bug - spotted by Marcus Jansson
         If ValType = ValString Then Value = Value + Chr(0)
         If ValType = ValBinary Then
            InLen = Len(Value)
            ReDim ByteArray(InLen) As Byte
            For i = 1 To InLen
               ByteArray(i) = Asc(Mid$(Value, i, 1))
            Next
            lResult = RegSetValueExB(lKeyValue, Key, 0&, REG_BINARY, ByteArray(1), InLen)
         Else
            sNewVal = Value
            InLen = Len(sNewVal)
            lResult = RegSetValueExString(lKeyValue, Key, 0&, 1&, sNewVal, InLen)
         End If
      End If
      lResult = RegFlushKey(lKeyValue)
      lResult = RegCloseKey(lKeyValue)
End Sub
Private Function RegCheckError(ByRef ErrorValue As Long) As Boolean

      If ((ErrorValue < 8) And (ErrorValue > 1)) Or _
      (ErrorValue = 87) Or (ErrorValue = 259) Then _
      RegCheckError = -1 Else RegCheckError = 0

End Function

Public Function DeleteRegistryKey(ByVal hKey As Long, ByVal Section As String) As Boolean
    
      ' Delete Existing Key
      Temp& = RegDeleteKey(hKey, Section)

      ' Process Returned Information
      If RegCheckError(Temp&) Then GoTo DeleteKeyError

      ' Operation Was Successful
      DeleteRegistryKey = -1

      ' Exit Function With Passed Value
      Exit Function

DeleteKeyError:
    
      ' Store Error In Variable
      RegLastError = Temp&
    
      ' Operation Was Not Successful
      DeleteRegistryKey = 0
    
End Function

Public Function DeleteRegistryValue(ByVal hKey As Long, ByVal Section As String, ByVal Value As String) As Boolean

      ' Combine The Key And SubKey Paths
   
      ' Open The Key For Operations
      Temp& = RegOpenKey(hKey, Section$, hHnd&)
    
      ' Process Returned Information
      If RegCheckError(Temp&) Then GoTo DeleteValueError
    
      ' Delete Existing Value From Key
      Temp& = RegDeleteValue(hHnd&, Value)
    
      ' Process Returned Information
      If RegCheckError(Temp&) Then GoTo DeleteValueError
    
      ' Close Handle To Key
      Temp& = RegCloseKey(hHnd&)
    
      ' Operation Was Successful
      DeleteRegistryValue = -1

      ' Exit Function With Passed Value
      Exit Function

DeleteValueError:
    
      ' Store Error In Variable
      RegLastError = Temp&
    
      ' Operation Was Not Successful
      DeleteRegistryValue = 0
    
      ' Close Handle To Key
      Temp& = RegCloseKey(hHnd&)
    
End Function



Public Function ShellEx( _
      ByVal sFile As String, _
      Optional ByVal eShowCmd As EShellShowConstants = essSW_SHOWDEFAULT, _
      Optional ByVal sParameters As String = "", _
      Optional ByVal sDefaultDir As String = "", _
      Optional sOperation As String = "open", _
      Optional Owner As Long = 0) As Boolean
        
Dim lR As Long
Dim lErr As Long, sErr As Long
      If (InStr(UCase$(sFile), ".EXE") <> 0) Then
         eShowCmd = 0
      End If
      On Error Resume Next
      If (sParameters = "") And (sDefaultDir = "") Then
         lR = ShellExecuteForExplore(Owner, sOperation, sFile, 0, 0, essSW_SHOWNORMAL)
      Else
         lR = ShellExecute(Owner, sOperation, sFile, sParameters, sDefaultDir, eShowCmd)
      End If
      If (lR < 0) Or (lR > 32) Then
         ShellEx = True
      Else
         ' raise an appropriate error:
         lErr = vbObjectError + 1048 + lR
         Select Case lR
            Case 0
               lErr = 7: sErr = "Out of memory"
            Case ERROR_FILE_NOT_FOUND
               lErr = 53: sErr = "File not found"
            Case ERROR_PATH_NOT_FOUND
               lErr = 76: sErr = "Path not found"
            Case ERROR_BAD_FORMAT
               sErr = "The executable file is invalid or corrupt"
            Case SE_ERR_ACCESSDENIED
               lErr = 75: sErr = "Path/file access error"
            Case SE_ERR_ASSOCINCOMPLETE
               sErr = "This file type does not have a valid file association."
            Case SE_ERR_DDEBUSY
               lErr = 285: sErr = "The file could not be opened because the target application is busy. Please try again in a moment."
            Case SE_ERR_DDEFAIL
               lErr = 285: sErr = "The file could not be opened because the DDE transaction failed. Please try again in a moment."
            Case SE_ERR_DDETIMEOUT
               lErr = 286: sErr = "The file could not be opened due to time out. Please try again in a moment."
            Case SE_ERR_DLLNOTFOUND
               lErr = 48: sErr = "The specified dynamic-link library was not found."
            Case SE_ERR_FNF
               lErr = 53: sErr = "File not found"
            Case SE_ERR_NOASSOC
               sErr = "No application is associated with this file type."
            Case SE_ERR_OOM
               lErr = 7: sErr = "Out of memory"
            Case SE_ERR_PNF
               lErr = 76: sErr = "Path not found"
            Case SE_ERR_SHARE
               lErr = 75: sErr = "A sharing violation occurred."
            Case Else
               sErr = "An error occurred occurred whilst trying to open or print the selected file."
         End Select
                
         Err.Raise lErr, , App.EXEName & ".GShell", sErr
         ShellEx = False
      End If

End Function

Open in new window

0
 
coolcurrent4uCommented:
0
 
ArkCommented:
To protect app via registry SaveSetting/GetSetting (HKEY_CURRENT_USER\Software\VB and VBA Program Settings\YourAppName) is enough:
1. They use shared registry key (i.e no need any permissions/rights to open this key)
2. Hiding settings anywhere dipper doesn't improve your app security - many tools like RegMon easy find this place. And even more - Vista and Win7 will alert when your app starts: "Application [yourapp.exe] try to read/write to registry key xxxxxx. Allow?
0
 
rayluvsAuthor Commented:
GMGenius:

     We never written to the registry, so can you explain each line?

      sRegPath = "SOFTWARE\" & App.CompanyName & "\" & App.ProductName
     ReadRegistry(HKEY_LOCAL_MACHINE, sRegPath, "Company")
     Call WriteRegistry(HKEY_LOCAL_MACHINE, sRegPath, "DBPath", ValString, sDBPath)

      I ask this becuase I checked the registry and it goes much deeper than just
      MainKey,  SubKey , value as silemone's links suggests, for example:

       [HKEY_CURRENT_USER\.DEFAULT\SOFTWARE\PDFComplete\PDF Complete\Office]

Ark:

      Good info.  It looks that you just can't write anywhere in the registry.  I see you suggest
      (HKEY_CURRENT_USER\Software\VB and VBA Program Settings\YourAppName) , but
      we are looking for to write to an area one time, that is at installation and then go back when
      registring the application.  Do you yous suggest the same location?
0
 
GMGeniusCommented:
Hi,
With my code you can write anywhere in the registry but be carefull of course
 sRegPath = "SOFTWARE\" & App.CompanyName & "\" & App.ProductName
sRegPath is used to store the path to the registry item , the example is the applications CompanyName plus the application name
eg SOFTWARE\Google\Chrome
     ReadRegistry(HKEY_LOCAL_MACHINE, sRegPath, "Company")
     ReadRegistry(GROUP,SECTION,KEY)
HKEY_LOCAL_MACHINE = a constant for this start location
sRegPath as above is section
"Company" is the key
 So in your example to read the registry as you mentioned
ReadRegistry(HKEY_CURRENT_USER,".DEFAULT\SOFTWARE\PDFComplete\PDF Complete","Office")

     Call WriteRegistry(HKEY_LOCAL_MACHINE, sRegPath, "DBPath", ValString, sDBPath)

Public Sub WriteRegistry(ByVal Group As Long, _
                         ByVal Section As String, _
                         ByVal Key As String, _
                         ByVal ValType As InTypes_enum, _
                         ByVal Value As Variant)
0
 
GMGeniusCommented:
Using SaveSettings and GetSettings ONLY allows access to  (HKEY_CURRENT_USER\Software\VB and VBA Program Settings\YourAppName) and no other location.
0
 
rayluvsAuthor Commented:
Ok I think  got it.  In my registry line sent, the section would be as follow:

     GROUP = HKEY_CURRENT_USER\
     SECTION = .DEFAULT\SOFTWARE\PDFComplete\PDF Complete\
     KEY= Office

If that's correct, then:

[HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Internet Account Manager\Preconfigured\VeriSign]

would be:

     GROUP = HKEY_LOCAL_MACHINE\
     SECTION = SOFTWARE\Microsoft\Internet Account Manager\Preconfigured\
     KEY= VeriSign

Is this safe to say?
0
 
GMGeniusCommented:
Yes, but the GROUP does not have \ , the constant is called HKEY_LOCAL_MACHINE
Public Enum hKeyNames
   HKEY_CLASSES_ROOT = &H80000000
   HKEY_CURRENT_USER = &H80000001
   HKEY_LOCAL_MACHINE = &H80000002
   HKEY_USERS = &H80000003
   HKEY_PERFORMANCE_DATA = &H80000004
   HKEY_CURRENT_CONFIG = &H80000005
   HKEY_DYN_DATA = &H80000006
End Enum
 
0
 
rayluvsAuthor Commented:
Ok.  I'm trying to understand the 3 areas you discussed: Group, Section and Key.

What I mean is if I wanted to search for an entry that has "Internet Account Manager", I would look into the area "SECTION"?
0
 
GMGeniusCommented:
Yes,
The GROUP is one of the registry hives on the PC, the section is the section as described, where you have to specify the path then the key is what key/value pair you have or want to update.
0
 
rayluvsAuthor Commented:
Understood.  I tried your code of ID: 33571703 to see it run step by step but it doesn't work.  It gave me an the error "Compile error: Expected: =" when it get to "ReadRegistry(HKEY_LOCAL_MACHINE, sRegPath, "Company") "



0
 
GMGeniusCommented:
try
Dim sCompany as String
sCompany = ReadRegistry(HKEY_CURRENT_USER,".DEFAULT\SOFTWARE\PDFComplete\PDF Complete","Office")
0
 
GMGeniusCommented:
You have to assign a variable with the result as above example
Variable = ReadRegistry...
0
 
rayluvsAuthor Commented:
Same error.  In the Command1_Click() I place:

sCompany = ReadRegistry(HKEY_CURRENT_USER,".DEFAULT\SOFTWARE\PDFComplete\PDF Complete","Office"

When pressing Enter key for the next line, it gave same error.  The error is not at compile time.
0
 
GMGeniusCommented:
have you missed the ) ?
0
 
ArkCommented:
Hi
>>Using SaveSettings and GetSettings ONLY allows access to  (HKEY_CURRENT_USER\Software\VB and VBA Program Settings\YourAppName) and no other location<<
Yes, I did mention this. But is there ANY reason to use another location???
0
 
rayluvsAuthor Commented:
GMGenius,

      you were right, I dint place the )... oops!
   
      Ok, I ranned it and lResult is "0" and ReadRegistry is "Not Found"
      i noticed empty value in App.CompanyName and App.ProductName

      Should there be value placed here?

Ark:

No reason ti use another location.  The thing is if User JOE does the install the Activation Code for the apps will be placed under his User and if User RALPH uses the program, it won't find the activation code... that whay I made that question on  ID: 33575391

0
 
ArkCommented:
In this case I suggest using ini file at CommonAppData\YourApp
Code below is for clsINI.cls
Using:
Dim ini As New clsINI
   
Private Sub Command1_Click()
   ini.IniFile = "x"
   ini.SaveSetting App.Title, "SecretKey", "TopSecret"
End Sub

Private Sub Command2_Click()
   ini.IniFile = "x"
   MsgBox ini.GetSetting(App.Title, "SecretKey", "Non secret")
End Sub
Option Explicit

Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Private Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As String, ByVal lpFileName As String) As Long


Private Declare Function SpecialFolderPath Lib "shell32" Alias "SHGetSpecialFolderPathA" _
        (ByVal hOwner As Long, ByVal szPath As String, ByVal nFolder As Long, ByVal fCreate As Boolean) As Long
Private Const CSIDL_COMMON_APPDATA = &H23

Private m_IniFile As String
Private m_Folder As String

Public Property Get IniFile() As String
    IniFile = m_IniFile
End Property
Public Property Let IniFile(NewFile As String)
    m_IniFile = m_Folder & "\" & NewFile
    If Len(Dir(m_IniFile)) = 0 Then
       Dim nFile As Integer
       nFile = FreeFile
       Open m_IniFile For Output As nFile
       Close nFile
    End If
End Property

Public Function GetSetting(Section As String, Key As String, Optional Default As String = "") As String
    Dim BufferSize As Long, Ret As Long
    Do
        BufferSize = BufferSize + 256
        GetSetting = Space(BufferSize)
        Ret = GetPrivateProfileString(Section, Key, Default, GetSetting, BufferSize, m_IniFile)
    Loop Until Ret < BufferSize - 1
    If Ret > 0 Then
        GetSetting = Left$(GetSetting, Ret)
    Else
        GetSetting = ""
    End If
End Function

Public Sub SaveSetting(Section As String, Key As String, Value As String)
    WritePrivateProfileString Section, Key, Value, m_IniFile
End Sub

Private Function AllUsersAppPath() As String
   Dim sPath As String
   sPath = String(255, 0)
   Call SpecialFolderPath(0, sPath, CSIDL_COMMON_APPDATA, 0)
   If InStr(sPath, vbNullChar) > 1 Then
      AllUsersAppPath = Left$(sPath, InStr(sPath, vbNullChar) - 1)
   End If
End Function

Private Sub Class_Initialize()
   m_Folder = AllUsersAppPath & "\" & App.Title
   If Len(Dir(m_Folder, vbDirectory)) = 0 Then MkDir m_Folder
End Sub

Open in new window

0
 
GMGeniusCommented:
The App.companyname and app.productname was just an example, these are set in the project properties
You will need to write the values first also if its for your own application.
INI file is not as secure as registry, and becomes portable and the more easily distributable.
Also make sure the activation code can not be used on another machine, so use the machine hardware ID as part of the code.
 
0
 
ArkCommented:
If we're speaking about protection IMHO the best one is what MS use:
New windows every year plus
SP every month
0
 
rayluvsAuthor Commented:
Guys, let me refresh the purpose of the this question (I should have included it):

- We already prepare a scheme (with EE assistance) where an application is installed, it will
  place a code in the computer, but won't be able to run until an activation code is saved
  on that same computer.  This development is already done.  The way its done, prevents
  a user from copying the apps from computer to another.  And if the user does copy thr apps, it
  will prompt for an activation code, because it will not find the code to permit it run (the
  apps when runned will always check & compare the code/activation code)

- this being said, the question I placed here is for the purpose to change the way we are saving
  the "code" and the "activation code"; instead of saving it on a computer folder or file, we
  we'll use the registry (a good suggestion by one of your EE colleagues).

- We would like to know a place where we can place this information, that's why we gave Ark the
  reference of 2 different user within the same PC.

- In conclusion, we are not super-vb developers and less, Registry experts, but EE has alwasy
  come thru on assisting and giving us tools to make all our implementation true.

So at this moment we are kind of lost of how the samples you guys have provided can be understood by us; thats why the many questions.  

Ok, Ark we copy/paste to the code to clsINI.cls (module).  But when you sale "I suggest using ini file at CommonAppData\YourApp", what exactly do you mean?

GMGenius, that's what we were thinking, the App.companyname and app.productname were just example and the values hast to be provided.  But when you say "set in the project properties", does this mean that when we finally have this application, we have to run it with arguments? that is:  apps.exe arguments1 arguments2
0
 
GMGeniusCommented:
The code i provided will allow you to read what you need from anywhere as I stated,
The sample code was taken from one of my applications and I an using app.companyname so the code was reusable for any project i built
You can set the CompanyName and ProductName in the VB6 project properties when you are building the application
You can hard code these if you wish but I would consider obfuscating them so they are not easily found, bare in mind though that there are tools to monitor registry access and file system access as mentioned already.
as for a good place to put your code... thats hard , I would suggest you hide it in a very populated section of the registry. I have used the HKEY_LOCAL_MACHINE\SOFTWARE\Classes location before and used an obscure key but thats a a decision you have to make for yourself.
There are a large many places to hide stuff , just be carefull to not make it too obvious and even if it is then make sure your application uses some formula to ensure that if tampered with then the activation becomes invalid. If you do that then it wont matter where you save it and then I would suggest
 HKEY_LOCAL_MACHINE\SOFTWARE\YourCompanyName\ProductName with a key of "ActivationCode"... but that is only if you deal with the tampering.
In any case no matter what you do , someone will decide if its worth it they will hack it.
 
 
 
 
0
 
rayluvsAuthor Commented:
Thanx lots for all that info!

Going back on your code, I literally placed "sCompany = ReadRegistry(HKEY_CURRENT_USER,".DEFAULT\SOFTWARE\PDFComplete\PDF Complete","Office")" and ran it; still I get "Not Found".

I also placed the line as:

sCompany = ReadRegistry(HKEY_CURRENT_USER,".DEFAULT\SOFTWARE\PDFComplete\PDF Complete","Office")

sCompany = ReadRegistry("HKEY_CURRENT_USER", ".DEFAULT\SOFTWARE\PDFComplete\PDF Complete", "Office")

So I'm not getting errors on any part of the (only when i tested placing HKEY_CURRENT_USER between quotes).  

Here's the code exactly as I have it.  Tell me what am I missing so I the  "Not Found". error stop showing.
'THIS IS THE MODULE.BAS
'------------------------------------
' Created by E.Spencer (elliot@spnc.demon.co.uk) - This code is public domain.
'
Option Explicit
Private Const ERROR_FILE_NOT_FOUND = 2&
Private Const ERROR_PATH_NOT_FOUND = 3&
Private Const ERROR_BAD_FORMAT = 11&
Private Const SE_ERR_ACCESSDENIED = 5        ' access denied
Private Const SE_ERR_ASSOCINCOMPLETE = 27
Private Const SE_ERR_DDEBUSY = 30
Private Const SE_ERR_DDEFAIL = 29
Private Const SE_ERR_DDETIMEOUT = 28
Private Const SE_ERR_DLLNOTFOUND = 32
Private Const SE_ERR_FNF = 2                ' file not found
Private Const SE_ERR_NOASSOC = 31
Private Const SE_ERR_PNF = 3                ' path not found
Private Const SE_ERR_OOM = 8                ' out of memory
Private Const SE_ERR_SHARE = 26

Public Enum EShellShowConstants
   essSW_HIDE = 0
   essSW_MAXIMIZE = 3
   essSW_MINIMIZE = 6
   essSW_SHOWMAXIMIZED = 3
   essSW_SHOWMINIMIZED = 2
   essSW_SHOWNORMAL = 1
   essSW_SHOWNOACTIVATE = 4
   essSW_SHOWNA = 8
   essSW_SHOWMINNOACTIVE = 7
   essSW_SHOWDEFAULT = 10
   essSW_RESTORE = 9
   essSW_SHOW = 5
End Enum

' Security Mask constants
Public Const READ_CONTROL As Variant = &H20000
Public Const SYNCHRONIZE As Variant = &H100000
Public Const STANDARD_RIGHTS_ALL As Variant = &H1F0000
Public Const STANDARD_RIGHTS_READ As Variant = READ_CONTROL
Public Const STANDARD_RIGHTS_WRITE As Variant = READ_CONTROL
Public Const KEY_QUERY_VALUE As Variant = &H1
Public Const KEY_SET_VALUE As Variant = &H2
Public Const KEY_CREATE_SUB_KEY As Variant = &H4
Public Const KEY_ENUMERATE_SUB_KEYS As Variant = &H8
Public Const KEY_NOTIFY As Variant = &H10
Public Const KEY_CREATE_LINK As Variant = &H20
Public Const KEY_ALL_ACCESS As Variant = ((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))
Public Const KEY_READ As Variant = ((STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And (Not SYNCHRONIZE))
Public Const KEY_EXECUTE As Variant = ((KEY_READ) And (Not SYNCHRONIZE))
Public Const KEY_WRITE As Variant = ((STANDARD_RIGHTS_WRITE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY) And (Not SYNCHRONIZE))
' Possible registry data types
Public Enum InTypes_enum
   ValNull = 0
   ValString = 1
   ValXString = 2
   ValBinary = 3
   ValDWord = 4
   ValLink = 6
   ValMultiString = 7
   ValResList = 8
End Enum
' Temporary Stack Storage Variables
Private Temp As Long
Dim TempEx As Long
Dim TempExA As String
Private TempExB&, TempExC%

' Handle And Other Storage Variables
Private hHnd As Long
Private KeyPath As String
Private hDepth As Long

' Variable To Hold Last Error
Public RegLastError As Long

' Registry value type definitions
Public Const REG_NONE As Long = 0
Public Const REG_SZ As Long = 1
Public Const REG_EXPAND_SZ As Long = 2
Public Const REG_BINARY As Long = 3
Public Const REG_DWORD As Long = 4
Public Const REG_LINK As Long = 6
Public Const REG_MULTI_SZ As Long = 7
Public Const REG_RESOURCE_LIST As Long = 8
' Registry section definitions
Public Enum hKeyNames
   HKEY_CLASSES_ROOT = &H80000000
   HKEY_CURRENT_USER = &H80000001
   HKEY_LOCAL_MACHINE = &H80000002
   HKEY_USERS = &H80000003
   HKEY_PERFORMANCE_DATA = &H80000004
   HKEY_CURRENT_CONFIG = &H80000005
   HKEY_DYN_DATA = &H80000006
End Enum

' Codes returned by Reg API calls
Public Const ERROR_NONE = 0
Public Const ERROR_BADDB = 1
Public Const ERROR_BADKEY = 2
Public Const ERROR_CANTOPEN = 3
Public Const ERROR_CANTREAD = 4
Public Const ERROR_CANTWRITE = 5
Public Const ERROR_OUTOFMEMORY = 6
Public Const ERROR_INVALID_PARAMETER = 7
Public Const ERROR_ACCESS_DENIED = 8
Public Const ERROR_INVALID_PARAMETERS = 87
Public Const ERROR_NO_MORE_ITEMS = 259
' Registry API functions used in this module (there are more of them)
Public Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Public 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
Public Declare Function RegQueryValueEx 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
Public Declare Function RegEnumValue Lib "advapi32.dll" Alias "RegEnumValueA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpValueName As String, lpcbValueName As Long, ByVal lpReserved As Long, lpType As Long, ByVal lpData As String, lpcbData As Long) As Long
Public Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Public Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Public 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 lpValue As String, ByVal cbData As Long) As Long
Public Declare Function RegSetValueExLong Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpValue As Long, ByVal cbData As Long) As Long
Public Declare Function RegFlushKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Public Declare Function RegEnumKey Lib "advapi32.dll" Alias "RegEnumKeyA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, ByVal cbName As Long) As Long
Public Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long
Public Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long
Public Declare Function RegSetValueExB Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByRef lpData As Byte, ByVal cbData As Long) As Long
Declare Function ShellExecuteForExplore Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, lpParameters As Any, lpDirectory As Any, ByVal nShowCmd As Long) As Long
Declare Function ShellExecute Lib "shell32" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

' This routine allows you to get values from anywhere in the Registry, it currently
' only handles string, double word and binary values. Binary values are returned as
' hex strings.
'
' Example
' Text1.Text = ReadRegistry(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon\", "DefaultUserName")
'
Public Function ReadRegistry(ByVal Group As Long, ByVal Section As String, ByVal Key As String, Optional sDefault As String = "Not Found") As String
Dim lResult As Long, lKeyValue As Long, lDataTypeValue As Long, lValueLength As Long, sValue As String, td As Double
Dim TStr1 As String, TStr2 As String
Dim i As Integer
      On Error Resume Next
      lResult = RegOpenKey(Group, Section, lKeyValue)
      sValue = Space$(2048)
      lValueLength = Len(sValue)
      lResult = RegQueryValueEx(lKeyValue, Key, 0&, lDataTypeValue, sValue, lValueLength)
      If (lResult = 0) And (Err.Number = 0) Then
         If lDataTypeValue = REG_DWORD Then
            td = Asc(Mid$(sValue, 1, 1)) + &H100& * Asc(Mid$(sValue, 2, 1)) + &H10000 * Asc(Mid$(sValue, 3, 1)) + &H1000000 * CDbl(Asc(Mid$(sValue, 4, 1)))
            sValue = Format$(td, "000")
         End If
         If lDataTypeValue = REG_BINARY Then
            ' Return a binary field as a hex string (2 chars per byte)
            TStr2 = ""
            For i = 1 To lValueLength
               TStr1 = Hex(Asc(Mid$(sValue, i, 1)))
               If Len(TStr1) = 1 Then TStr1 = "0" & TStr1
               TStr2 = TStr2 + TStr1
            Next
            sValue = TStr2
         Else
            sValue = Left$(sValue, lValueLength - 1)
         End If
      Else
         sValue = sDefault
      End If
      lResult = RegCloseKey(lKeyValue)
      ReadRegistry = sValue
End Function

' This routine allows you to write values into the entire Registry, it currently
' only handles string and double word values.
'
' Example
' WriteRegistry HKEY_CURRENT_USER, "SOFTWARE\My Name\My App\", "NewSubKey", ValString, "NewValueHere"
' WriteRegistry HKEY_CURRENT_USER, "SOFTWARE\My Name\My App\", "NewSubKey", ValDWord, "31"
'
Public Sub WriteRegistry(ByVal Group As Long, ByVal Section As String, ByVal Key As String, ByVal ValType As InTypes_enum, ByVal Value As Variant)
Dim lResult As Long
Dim lKeyValue As Long
Dim InLen As Long
Dim lNewVal As Long
Dim sNewVal As String
Dim i As Integer
Dim lDataSize As Integer
Dim ByteArray() As Byte

      On Error Resume Next
      lResult = RegCreateKey(Group, Section, lKeyValue)
      If ValType = ValDWord Then
         lNewVal = CLng(Value)
         InLen = 4
         lResult = RegSetValueExLong(lKeyValue, Key, 0&, ValType, lNewVal, InLen)
      Else
         ' Fixes empty string bug - spotted by Marcus Jansson
         If ValType = ValString Then Value = Value + Chr(0)
         If ValType = ValBinary Then
            InLen = Len(Value)
            ReDim ByteArray(InLen) As Byte
            For i = 1 To InLen
               ByteArray(i) = Asc(Mid$(Value, i, 1))
            Next
            lResult = RegSetValueExB(lKeyValue, Key, 0&, REG_BINARY, ByteArray(1), InLen)
         Else
            sNewVal = Value
            InLen = Len(sNewVal)
            lResult = RegSetValueExString(lKeyValue, Key, 0&, 1&, sNewVal, InLen)
         End If
      End If
      lResult = RegFlushKey(lKeyValue)
      lResult = RegCloseKey(lKeyValue)
End Sub
Private Function RegCheckError(ByRef ErrorValue As Long) As Boolean

      If ((ErrorValue < 8) And (ErrorValue > 1)) Or _
      (ErrorValue = 87) Or (ErrorValue = 259) Then _
      RegCheckError = -1 Else RegCheckError = 0

End Function

Public Function DeleteRegistryKey(ByVal hKey As Long, ByVal Section As String) As Boolean
    
      ' Delete Existing Key
      Temp& = RegDeleteKey(hKey, Section)

      ' Process Returned Information
      If RegCheckError(Temp&) Then GoTo DeleteKeyError

      ' Operation Was Successful
      DeleteRegistryKey = -1

      ' Exit Function With Passed Value
      Exit Function

DeleteKeyError:
    
      ' Store Error In Variable
      RegLastError = Temp&
    
      ' Operation Was Not Successful
      DeleteRegistryKey = 0
    
End Function

Public Function DeleteRegistryValue(ByVal hKey As Long, ByVal Section As String, ByVal Value As String) As Boolean

      ' Combine The Key And SubKey Paths
   
      ' Open The Key For Operations
      Temp& = RegOpenKey(hKey, Section$, hHnd&)
    
      ' Process Returned Information
      If RegCheckError(Temp&) Then GoTo DeleteValueError
    
      ' Delete Existing Value From Key
      Temp& = RegDeleteValue(hHnd&, Value)
    
      ' Process Returned Information
      If RegCheckError(Temp&) Then GoTo DeleteValueError
    
      ' Close Handle To Key
      Temp& = RegCloseKey(hHnd&)
    
      ' Operation Was Successful
      DeleteRegistryValue = -1

      ' Exit Function With Passed Value
      Exit Function

DeleteValueError:
    
      ' Store Error In Variable
      RegLastError = Temp&
    
      ' Operation Was Not Successful
      DeleteRegistryValue = 0
    
      ' Close Handle To Key
      Temp& = RegCloseKey(hHnd&)
    
End Function



Public Function ShellEx( _
      ByVal sFile As String, _
      Optional ByVal eShowCmd As EShellShowConstants = essSW_SHOWDEFAULT, _
      Optional ByVal sParameters As String = "", _
      Optional ByVal sDefaultDir As String = "", _
      Optional sOperation As String = "open", _
      Optional Owner As Long = 0) As Boolean
        
Dim lR As Long
Dim lErr As Long, sErr As Long
      If (InStr(UCase$(sFile), ".EXE") <> 0) Then
         eShowCmd = 0
      End If
      On Error Resume Next
      If (sParameters = "") And (sDefaultDir = "") Then
         lR = ShellExecuteForExplore(Owner, sOperation, sFile, 0, 0, essSW_SHOWNORMAL)
      Else
         lR = ShellExecute(Owner, sOperation, sFile, sParameters, sDefaultDir, eShowCmd)
      End If
      If (lR < 0) Or (lR > 32) Then
         ShellEx = True
      Else
         ' raise an appropriate error:
         lErr = vbObjectError + 1048 + lR
         Select Case lR
            Case 0
               lErr = 7: sErr = "Out of memory"
            Case ERROR_FILE_NOT_FOUND
               lErr = 53: sErr = "File not found"
            Case ERROR_PATH_NOT_FOUND
               lErr = 76: sErr = "Path not found"
            Case ERROR_BAD_FORMAT
               sErr = "The executable file is invalid or corrupt"
            Case SE_ERR_ACCESSDENIED
               lErr = 75: sErr = "Path/file access error"
            Case SE_ERR_ASSOCINCOMPLETE
               sErr = "This file type does not have a valid file association."
            Case SE_ERR_DDEBUSY
               lErr = 285: sErr = "The file could not be opened because the target application is busy. Please try again in a moment."
            Case SE_ERR_DDEFAIL
               lErr = 285: sErr = "The file could not be opened because the DDE transaction failed. Please try again in a moment."
            Case SE_ERR_DDETIMEOUT
               lErr = 286: sErr = "The file could not be opened due to time out. Please try again in a moment."
            Case SE_ERR_DLLNOTFOUND
               lErr = 48: sErr = "The specified dynamic-link library was not found."
            Case SE_ERR_FNF
               lErr = 53: sErr = "File not found"
            Case SE_ERR_NOASSOC
               sErr = "No application is associated with this file type."
            Case SE_ERR_OOM
               lErr = 7: sErr = "Out of memory"
            Case SE_ERR_PNF
               lErr = 76: sErr = "Path not found"
            Case SE_ERR_SHARE
               lErr = 75: sErr = "A sharing violation occurred."
            Case Else
               sErr = "An error occurred occurred whilst trying to open or print the selected file."
         End Select
                
         Err.Raise lErr, , App.EXEName & ".GShell", sErr
         ShellEx = False
      End If

End Function

'THIS IS THE COMMAND
'------------------------------------
Private Sub Command1_Click()

 Dim sCompany As String
 Results.Caption = ReadRegistry(HKEY_CURRENT_USER, ".DEFAULT\SOFTWARE\PDFComplete\PDF Complete", "Office")

End Sub

Open in new window

0
 
ArkCommented:
>> But when you sale "I suggest using ini file at CommonAppData\YourApp", what exactly do you mean<<
Since registry access became more and more protected (most AV software and firewalls alert when any app try to write registry), modern technique is to save app settings into
C:\Documents and Settings\All Users\Application Data\ folder for all user or
C:\Documents and Settings\User name\Application Data\ folder for single user
Names of these folders can differ on different machines, but shell allow get their path via CSIDL_COMMON_APPDATA and CSID_APPDATA constants. My class creates C:\Documents and Settings\All Users\Application Data\ App.Title subfolder and work with *.ini file you supply with IniFile property(create new if necessary). Then via same method (GetSetting/SaveSetting) it read/write ini file data.
PS
>>we we'll use the registry (a good suggestion by one of your EE colleagues).<<
IMHO, not so good suggestion especially for Vista/Win7 - seems Bill Gates decided that only he has full permission to access registry. If you install your app on fresh Vista with default policies/security settings, your user spend a lot of time closing numerous security alerts (if (s)he is admin) or simply cannot run app if no.
0
 
nffvrxqgrcfqvvcCommented:
Hi,
If your writing the values once during the installation phase the installer should be running with administrative rights, you can write to ANY location in this case except some protected areas of the registry. By default you can READ from the registry without administrative rights from any location unless an administrator specifically removed read access to that given part of the registry. Many anti-virus or services will grant only SYSTEM access to some specific keys but you don't need to worry about this because your not interested in such locations. However in user mode you only have WRITE access to HKEY_CURRENT_USER all other locations don't grant write access for default users.
If your installer writes to HKEY_LOCAL_MACHINE during the installation you need not worry about permissions because you will have READ access to this location.
You also need to be careful with the registry API flags, they require specific access rights and if you specify the wrong access mode the calls will fail.
You also should be aware of virtualization on Vista or later if your application(executable) isn't manifested then virtualization is enabled and all locations you would otherwise not have permissions to would be re-directed to different areas of the registry or filesystem. If your manifested for AsInvoker then virtualization will be disabled.
Example for reading "STRINGS" from the registry. (see code section)

Usage:
Debug.Print ReadRegString(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion\Internet Settings\Url History\", "Directory")


Option Explicit
 
Public Enum RegistryKey
  HKEY_LOCAL_MACHINE = &H80000002
  HKEY_CURRENT_USER = &H80000001
End Enum
Private Const REG_SZ As Long = &H1&
Private Const KEY_QUERY_VALUE As Long = &H1&
Private Const ERROR_SUCCESS = &H0&
Private Declare Function RegOpenKeyExW Lib "Advapi32.dll" (ByVal hKey As Long, ByVal lpSubkey As Long, ByVal ulOptions As Long, ByVal samDesired As Long, ByRef phkResult As Long) As Long
Private Declare Function RegQueryValueExW Lib "advapi32" (ByVal hKey As Long, ByVal lpValueName As Long, ByVal lpReserved As Long, ByRef lpType As Long, ByVal lpData As Long, ByRef lpcbData As Long) As Long
Private Declare Function RegCloseKey Lib "Advapi32.dll" (ByVal hKey As Long) As Long

Public Function ReadRegString(ByVal mainKey As RegistryKey, ByVal szSubKey As String, ByVal szValueName As String) As String
  Dim Buffer()      As Byte
  Dim BufferSize    As Long
  Dim hKey          As Long
  Dim lpType        As Long
  BufferSize = 4096
  If RegOpenKeyExW(mainKey, StrPtr(szSubKey), 0, KEY_QUERY_VALUE, hKey) = 0 Then
    ReDim Buffer(BufferSize) As Byte
    If RegQueryValueExW(hKey, StrPtr(szValueName), 0, lpType, VarPtr(Buffer(0)), BufferSize) = 0 Then
      ReadRegString = Left$(Buffer, InStr(Buffer, vbNullChar) - 1)
    End If
    RegCloseKey hKey
  Else
    Debug.Print "Error(RegOpenKeyExW) = " & Err.LastDllError
  End If
  Erase Buffer
End Function

Open in new window

0
 
rayluvsAuthor Commented:
Now I see more clearly on "CommonAppData\YourApp", and sounds solid.  But again, we're tryin our best to fully grasp your concept.

When you say "My class creates C:\Documents and Settings\All Users\Application Data\ App.", where does exactly creates it?

Also, you mention a *.ini file, what exactly does it suppose contain?

And finally, we ran your code to understand it, but when I run your code, I get an error at line "Dim ini As New clsINI":

            Compile error: User-defined type not defined

Like always, thanx for all your patience with members not knowledgeable in this area
0
 
ArkCommented:
1. Create new project Form 1 will creates by default
2. Add class module (Menu->Project->Add class module-> Select 'Class module->Open. Class1 will be created as default. Right click on Class1 in ProjectExplorer window choose Properties, rename it to clsINI (or any name your want or leave Class1)
3. Place 2 buttons (Command1 and Command2 are default names) on form1. Open Form1 code and paste following:
Dim ini As New clsINI 'Replace clsINI with your class name form #2
   
Private Sub Command1_Click()
   ini.IniFile = "x"
   ini.SaveSetting App.Title, "SecretKey", "TopSecret"
End Sub

Private Sub Command2_Click()
   ini.IniFile = "x"
   MsgBox ini.GetSetting(App.Title, "SecretKey", "Non secret")
End Sub

4. Run project, press button1
5. Open C:\Documents and Settings\All Users\Application Data\ folder  - you'll see Project1 (or other project name if you change it Project properties) subfolder in it. Open this subfolder - you'll see "x" file inside - this is your ini file which contains your settings. Open this file with notepad -= you'll see
[Project1]
SecretKey=TopSecret
6. Close App and run it again - press button2 - msgbox will show you your settings.

PS. Just in case, if you still want using registry, you can use WScript object:


'Write
Private Sub Command1_Click()
   Dim WshShell As Object
   Set WshShell = CreateObject("WScript.Shell")
   WshShell.RegWrite "HKEY_LOCAL_MACHINE\SOFTWARE\PDFComplete\PDF Complete\Office", "MyOffice", "REG_SZ"
   Set WshShell = Nothing
End Sub

'Read
Private Sub Command2_Click()
   Dim WshShell As Object
   Set WshShell = CreateObject("WScript.Shell")

   MsgBox WshShell.RegRead("HKLM\SOFTWARE\PDFComplete\PDF Complete\Office")
   Set WshShell = Nothing

End Sub

Open in new window

0
 
rayluvsAuthor Commented:
egl1044,

   Your code worked, it gave a result of "C:\Windows\History", but wasn't supposed to display:

    HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Internet Settings\Url History\Directory  ?

Ark,

   In reference of your code, in line 4 ("4. Run project, press button1"), you are asking me to
   run project, but there is nothing to run at this point and it gives me a Compile Error.
   Are you also rferring to your previous project at "09/01/10 08:57 PM, ID: 33583564"
0
 
nffvrxqgrcfqvvcCommented:
No. The example tells windows to look in the key (HKEY_LOCAL_MACHINE) under the sub keys (SOFTWARE\Microsoft\Windows\CurrentVersion\Internet Settings\Url History) the "Directory" part is the key value to read from and the result "C:\Windows\History" is the value member of the key.
0
 
rayluvsAuthor Commented:
Yes your are right.  I went directly to the Registry and follow the path and the value was there.  I also tested again with:

HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\ADs\Providers\LDAP\Extensions\person\{4de7016c-5ef9-11d1-8c13-00c04fd8d503}]

And it worked perfectly.  I tried for various areas in the registry and it work excellent!

Ok, thats for reading, and for writing?\
(can you give me a simple example as you did for the "reading")
0
 
GMGeniusCommented:
The "Not Found" means there is no value at the location you are reading
You are looking for a Key name "Office"
Under the
HKEY_CURRENT_USER\.DEFAULT\SOFTWARE\PDFComplete\PDF Complete registry location
Is there actually a key called office there?
0
 
GMGeniusCommented:
Call WriteRegistry(HKEY_LOCAL_MACHINE, ".DEFAULT\SOFTWARE\PDFComplete\PDF Complete registry location", "KeyName", ValString, "Your Value")
0
 
GMGeniusCommented:
@Ramante
Confused as to whos solution for reading and writing you are using now
0
 
GMGeniusCommented:
Just incase you are using my module code
Here is some code you can place in a button
    MsgBox (ReadRegistry(HKEY_CURRENT_USER, ".DEFAULT\SOFTWARE\PDFComplete\PDF Complete", "Office"))
    MsgBox (ReadRegistry(HKEY_CURRENT_USER, "SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer", "Logon User Name"))
   
    Call WriteRegistry(HKEY_CURRENT_USER, ".DEFAULT\SOFTWARE\PDFComplete\PDF Complete", "Office", ValString, "Your Value")
   
    MsgBox (ReadRegistry(HKEY_CURRENT_USER, ".DEFAULT\SOFTWARE\PDFComplete\PDF Complete", "Office"))

0
 
nffvrxqgrcfqvvcCommented:
Sure. Remember though as I said earlier you only have WRITE access by default to HKEY_CURRENT_USER so if your application is running in user mode attempts to right to HKEY_LOCAL_MACHINE will fail or in the case of virtualization will be redirected entirely. You can READ from both locations in user mode by default but not WRITE just a heads up.
You can use the following example, by using RegCreateKeyEx() you don't need to worry about creating sub folders as if they don't exists the call will automatically create them for you.
Add the code a module and you can use it like this:
Debug.Print ReadRegString(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion\Internet Settings\Url History\", "Directory")
Debug.Print WriteRegString(HKEY_CURRENT_USER, "SOFTWARE\Ramante", "EEName", "Ramante")
 
 

Option Explicit
 
Public Enum RegistryKey
  HKEY_LOCAL_MACHINE = &H80000002
  HKEY_CURRENT_USER = &H80000001
End Enum

Private Const REG_SZ As Long = &H1&
Private Const KEY_WRITE As Long = &H20006
Private Const KEY_QUERY_VALUE As Long = &H1&
Private Const ERROR_SUCCESS As Long = &H0&

Private Declare Function RegOpenKeyExW Lib "Advapi32.dll" (ByVal hKey As Long, ByVal lpSubKey As Long, ByVal ulOptions As Long, ByVal samDesired As Long, ByRef phkResult As Long) As Long
Private Declare Function RegCreateKeyExW Lib "Advapi32.dll" (ByVal hKey As Long, ByVal lpSubKey As Long, ByVal Reserved As Long, ByVal lpClass As Long, ByVal dwOptions As Long, ByVal samDesired As Long, ByVal lpSecurityAttributes As Long, ByRef phkResult As Long, ByRef lpdwDisposition As Long) As Long
Private Declare Function RegQueryValueExW Lib "Advapi32.dll" (ByVal hKey As Long, ByVal lpValueName As Long, ByVal lpReserved As Long, ByRef lpType As Long, ByVal lpData As Long, ByRef lpcbData As Long) As Long
Private Declare Function RegSetValueExW Lib "Advapi32.dll" (ByVal hKey As Long, ByVal lpValueName As Long, ByVal Reserved As Long, ByVal dwType As Long, ByVal lpData As Long, ByVal cbData As Long) As Long
Private Declare Function RegCloseKey Lib "Advapi32.dll" (ByVal hKey As Long) As Long

Public Function ReadRegString(ByVal mainKey As RegistryKey, ByVal szSubKey As String, ByVal szValueName As String) As String
  Dim Buffer()      As Byte
  Dim BufferSize    As Long
  Dim hKey          As Long
  Dim lpType        As Long
  BufferSize = 4096
  If RegOpenKeyExW(mainKey, StrPtr(szSubKey), 0, KEY_QUERY_VALUE, hKey) = 0 Then
    ReDim Buffer(BufferSize) As Byte
    If RegQueryValueExW(hKey, StrPtr(szValueName), 0, lpType, VarPtr(Buffer(0)), BufferSize) = 0 Then
      ReadRegString = Left$(Buffer, InStr(Buffer, vbNullChar) - 1)
    End If
    RegCloseKey hKey
  Else
    Debug.Print "Error(RegOpenKeyExW) = " & Err.LastDllError
  End If
  Erase Buffer
End Function

Public Function WriteRegString(ByVal mainKey As RegistryKey, ByVal subKeys As String, ByVal valueName As String, ByVal data As String) As Boolean
  Dim hKey    As Long
  Dim dwDisp  As Long
  Dim fOk     As Boolean
  fOk = False
  If RegCreateKeyExW(mainKey, StrPtr(subKeys), 0, 0, 0, KEY_WRITE, 0, hKey, dwDisp) = ERROR_SUCCESS Then
    If RegSetValueExW(hKey, StrPtr(valueName), 0, REG_SZ, StrPtr(data), LenB(data)) = ERROR_SUCCESS Then
      fOk = True
    Else
      Debug.Print "RegSetValueExW Error:"; Err.LastDllError
    End If
    RegCloseKey hKey
  Else
    Debug.Print "RegOpenKeyExW Error:"; Err.LastDllError
  End If
  WriteRegString = fOk
End Function

Open in new window

0
 
nffvrxqgrcfqvvcCommented:
Oh jesus..
<< attempts to right >>
should be:
attempts to WRITE
0
 
rayluvsAuthor Commented:
Guys I have to hand it to EE, you guys are incredible.  I combined your recommendations and we got a pretty good idea of how to read and write.

I think we can close the question, however, I see a differences between you guys of where the registry should be written to.  Question:

1. We need to write to an area that any user in Windows running our apps, the app can
    read that area for permission of use.  I see that HKEY_LOCAL_MACHINE is not
    recommended to write, so where can we write to so any user that enters the windows
    PC and running our apps, the app can access that area?
0
 
nffvrxqgrcfqvvcCommented:
You can use HKEY_CURRENT_USER under SOFTWARE\Ramante
Each user will be given it's own registry entries.
What does this mean?

If a computer has two users
1) Bob
2) Bill
If Bob is logged on and your application writes to HKEY_CURRENT_USER only Bob's registry entries exists.
If Bob logs off and Bill logs on the entries you previously written for Bob don't exist under Bill's profile unless you also write to Bill's registry profile under HKEY_CURRENT_USER.
HKEY_LOCAL_MACHINE is used for global access typically if you needed to write values that everyone  should only READ later you do this during installation when it has the appropriate permissions to write the values.
If you need to be able to WRITE more than once then you have to use the per user registry location HKEY_CURRENT_USER.
0
 
rayluvsAuthor Commented:
Ok.  I need to write only once, when the apps is installed, then that data is read each time the apps is loaded.  Should we still use HKEY_CURRENT_USER?
0
 
nffvrxqgrcfqvvcCommented:
No. In this case you should write to HKEY_LOCAL_MACHINE then the entry can be READ from your application regardless of which user is running.
0
 
rayluvsAuthor Commented:
Perfect.  What area do you recommend for writing?
0
 
nffvrxqgrcfqvvcCommented:
HKEY_LOCAL_MACHINE \software\yourcompany\...etc.. I don't know what your writing into the registry but if it's private you should look into making the value secure using encryption or some type of encoding.
0
 
rayluvsAuthor Commented:
Hey Thanx Lots!

Prior closing the question, I'll wait for pending feedback of the rest of EE
0
 
GMGeniusCommented:
I had suggested a location already in a previous post,
"as for a good place to put your code... thats hard , I would suggest you hide it in a very populated section of the registry. I have used the HKEY_LOCAL_MACHINE\SOFTWARE\Classes location before and used an obscure key but thats a a decision you have to make for yourself. "
I have created an entry with a made up extension like .pdf112 - as an example.
0
 
GMGeniusCommented:
Also , most installers give an option to write to the registry , you just need to run the install as an administrator.
0
 
rayluvsAuthor Commented:
Thanx all!
0
 
rayluvsAuthor Commented:
I wish I had more points to award.  Its been very helpfull (Hope I awarded apropiately)
0

Featured Post

VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

  • 19
  • 16
  • 7
  • +3
Tackle projects and never again get stuck behind a technical roadblock.
Join Now