Solved

Best method to wrtie to the registry using VB6

Posted on 2010-08-31
51
874 Views
Last Modified: 2012-05-10
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
Comment
Question by:rayluvs
  • 19
  • 16
  • 7
  • +3
51 Comments
 
LVL 21

Expert Comment

by:silemone
Comment Utility
0
 

Author Comment

by:rayluvs
Comment Utility
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
 

Author Comment

by:rayluvs
Comment Utility
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
 
LVL 21

Expert Comment

by:silemone
Comment Utility
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
 
LVL 12

Accepted Solution

by:
GMGenius earned 251 total points
Comment Utility
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
 
LVL 4

Expert Comment

by:coolcurrent4u
Comment Utility
0
 
LVL 27

Assisted Solution

by:Ark
Ark earned 94 total points
Comment Utility
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
 

Author Comment

by:rayluvs
Comment Utility
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
 
LVL 12

Assisted Solution

by:GMGenius
GMGenius earned 251 total points
Comment Utility
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
 
LVL 12

Assisted Solution

by:GMGenius
GMGenius earned 251 total points
Comment Utility
Using SaveSettings and GetSettings ONLY allows access to  (HKEY_CURRENT_USER\Software\VB and VBA Program Settings\YourAppName) and no other location.
0
 

Author Comment

by:rayluvs
Comment Utility
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
 
LVL 12

Expert Comment

by:GMGenius
Comment Utility
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
 

Author Comment

by:rayluvs
Comment Utility
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
 
LVL 12

Assisted Solution

by:GMGenius
GMGenius earned 251 total points
Comment Utility
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
 

Author Comment

by:rayluvs
Comment Utility
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
 
LVL 12

Expert Comment

by:GMGenius
Comment Utility
try
Dim sCompany as String
sCompany = ReadRegistry(HKEY_CURRENT_USER,".DEFAULT\SOFTWARE\PDFComplete\PDF Complete","Office")
0
 
LVL 12

Expert Comment

by:GMGenius
Comment Utility
You have to assign a variable with the result as above example
Variable = ReadRegistry...
0
 

Author Comment

by:rayluvs
Comment Utility
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
 
LVL 12

Assisted Solution

by:GMGenius
GMGenius earned 251 total points
Comment Utility
have you missed the ) ?
0
 
LVL 27

Expert Comment

by:Ark
Comment Utility
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
 

Author Comment

by:rayluvs
Comment Utility
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
 
LVL 27

Expert Comment

by:Ark
Comment Utility
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
 
LVL 12

Expert Comment

by:GMGenius
Comment Utility
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
 
LVL 27

Expert Comment

by:Ark
Comment Utility
If we're speaking about protection IMHO the best one is what MS use:
New windows every year plus
SP every month
0
 

Author Comment

by:rayluvs
Comment Utility
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
6 Surprising Benefits of Threat Intelligence

All sorts of threat intelligence is available on the web. Intelligence you can learn from, and use to anticipate and prepare for future attacks.

 
LVL 12

Assisted Solution

by:GMGenius
GMGenius earned 251 total points
Comment Utility
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
 

Author Comment

by:rayluvs
Comment Utility
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
 
LVL 27

Assisted Solution

by:Ark
Ark earned 94 total points
Comment Utility
>> 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
 
LVL 29

Assisted Solution

by:nffvrxqgrcfqvvc
nffvrxqgrcfqvvc earned 155 total points
Comment Utility
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
 

Author Comment

by:rayluvs
Comment Utility
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
 
LVL 27

Assisted Solution

by:Ark
Ark earned 94 total points
Comment Utility
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
 

Author Comment

by:rayluvs
Comment Utility
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
 
LVL 29

Assisted Solution

by:nffvrxqgrcfqvvc
nffvrxqgrcfqvvc earned 155 total points
Comment Utility
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
 

Author Comment

by:rayluvs
Comment Utility
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
 
LVL 12

Expert Comment

by:GMGenius
Comment Utility
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
 
LVL 12

Expert Comment

by:GMGenius
Comment Utility
Call WriteRegistry(HKEY_LOCAL_MACHINE, ".DEFAULT\SOFTWARE\PDFComplete\PDF Complete registry location", "KeyName", ValString, "Your Value")
0
 
LVL 12

Expert Comment

by:GMGenius
Comment Utility
@Ramante
Confused as to whos solution for reading and writing you are using now
0
 
LVL 12

Assisted Solution

by:GMGenius
GMGenius earned 251 total points
Comment Utility
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
 
LVL 29

Assisted Solution

by:nffvrxqgrcfqvvc
nffvrxqgrcfqvvc earned 155 total points
Comment Utility
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
 
LVL 29

Expert Comment

by:nffvrxqgrcfqvvc
Comment Utility
Oh jesus..
<< attempts to right >>
should be:
attempts to WRITE
0
 

Author Comment

by:rayluvs
Comment Utility
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
 
LVL 29

Assisted Solution

by:nffvrxqgrcfqvvc
nffvrxqgrcfqvvc earned 155 total points
Comment Utility
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
 

Author Comment

by:rayluvs
Comment Utility
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
 
LVL 29

Expert Comment

by:nffvrxqgrcfqvvc
Comment Utility
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
 

Author Comment

by:rayluvs
Comment Utility
Perfect.  What area do you recommend for writing?
0
 
LVL 29

Assisted Solution

by:nffvrxqgrcfqvvc
nffvrxqgrcfqvvc earned 155 total points
Comment Utility
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
 

Author Comment

by:rayluvs
Comment Utility
Hey Thanx Lots!

Prior closing the question, I'll wait for pending feedback of the rest of EE
0
 
LVL 12

Assisted Solution

by:GMGenius
GMGenius earned 251 total points
Comment Utility
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
 
LVL 12

Expert Comment

by:GMGenius
Comment Utility
Also , most installers give an option to write to the registry , you just need to run the install as an administrator.
0
 

Author Comment

by:rayluvs
Comment Utility
Thanx all!
0
 

Author Closing Comment

by:rayluvs
Comment Utility
I wish I had more points to award.  Its been very helpfull (Hope I awarded apropiately)
0

Featured Post

How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

Join & Write a Comment

Displaying an arrayList in a listView using the default adapter is rarely the best solution. To get full control of your display data, and to be able to refresh it after editing, requires the use of a custom adapter.
Whether you’re a college noob or a soon-to-be pro, these tips are sure to help you in your journey to becoming a programming ninja and stand out from the crowd.
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…
In this seventh video of the Xpdf series, we discuss and demonstrate the PDFfonts utility, which lists all the fonts used in a PDF file. It does this via a command line interface, making it suitable for use in programs, scripts, batch files — any pl…

771 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

Need Help in Real-Time?

Connect with top rated Experts

11 Experts available now in Live!

Get 1:1 Help Now