• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 454
  • Last Modified:

Writing to Registry gives error

I have trouble writing to the registry.
Under Win95 it works. WinNT it doesn't
I am using a standard API call RegCreateKeyEx found on the internet REGISTRY.BAS and found in all the documentation i have read.
I am also setting the KEY_ALL_ACCESS.
The function is not getting an ERROR_SUCCES returned.
I get the code 87 return, which refers to ERROR_INVALID_PARAMETERS, but I'm putting in the correct parameters, I've checked this hundred times now.
?????
I am a full administrator on my machine, this would mean that I have the rights to edit the registry, anyway I am able to edit the registry manually, so I see no problems with authority.

Code below:
*************************************************
Public Declare Function RegCreateKeyEx Lib "advapi32.dll" Alias _
    "RegCreateKeyExA" (ByVal HKEY As Long, ByVal lpSubKey As String, _
    ByVal Reserved As Long, ByVal lpClass As String, ByVal dwOptions _
    As Long, ByVal samDesired As Long, lpSecurityAttributes As _
    Long, phkResult As Long, lpdwDisposition As Long) _
    As Long

********
Public Const KEY_QUERY_VALUE = &H1
Public Const KEY_SET_VALUE = &H2
Public Const KEY_CREATE_SUB_KEY = &H4
Public Const KEY_ENUMERATE_SUB_KEYS = &H8
Public Const KEY_NOTIFY = &H10
Public Const KEY_CREATE_LINK = &H20
Public Const STANDARD_RIGHTS_ALL = &H1F0000
Public Const SYNCHRONIZE = &H100000
Public Const KEY_ALL_ACCESS = &H3F
Public Const REG_SZ = 1        ' Unicode null terminated string
Public Const ERROR_SUCCESS = 0
Public Const HKEY_CLASSES_ROOT = &H80000000
Public Const HKEY_CURRENT_USER = &H80000001
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const HKEY_USERS = &H80000003
Public Const HKEY_PERFORMANCE_DATA = &H80000004
****************************************
Public Sub SetRegString(HKEY As Long, strSubKey As String, _
                                strValueName As String,  strSetting _
                                As String)
    Dim hNewHandle As Long
    Dim lpdwDisposition As Long
    Dim lRetVal As Long
   
   
   
    lRetVal = RegCreateKeyEx(HKEY, strSubKey, 0, vbNullString, 0, _
        KEY_ALL_ACCESS, 0&, hNewHandle, lpdwDisposition)
    If lRetVal = ERROR_SUCCESS Then
        If RegSetValueEx(hNewHandle, strValueName, 0, REG_SZ, _
            ByVal strSetting, Len(strSetting)) <> ERROR_SUCCESS Then
            Err.Raise ERRBASE + 2, "SetRegString", _
                "RegSetValueEx failed!"
        End If
    Else
        Err.Raise ERRBASE + 3, "SetRegString", "RegCreateKeyEx failed!"
    End If
   
   
    RegCloseKey hNewHandle
    Debug.Print lRetVal
End Sub
**********************

My call looks like:

Call SetRegString(HKEY_CURRENT_USER, "Software\marcel", "Testvalue", "0")

*************************
0
hoogteijling
Asked:
hoogteijling
1 Solution
 
twardCommented:
Do you have the rights to update the Registry?

Are you logged in as administrator?

Show some of the code and maybe that will help...
0
 
hoogteijlingAuthor Commented:
Edited text of question.
0
 
GordonpCommented:
Are you using VB6.

With VB6 you get an activeX dll for accessing the Registry REGTOOL5.DLL

it in the Visual Studio\Common\Tools\APE
directory

use the UpdateKey function to create a registry key.

This should help solve problems with API declarations.

Gordon

However if the user/application doesnt have rights to create registry keys then your busted whichever way you go
0
The new generation of project management tools

With monday.com’s project management tool, you can see what everyone on your team is working in a single glance. Its intuitive dashboards are customizable, so you can create systems that work for you.

 
danelroismanCommented:
Hi Hooqteijing!

Your code:

lRetVal = RegCreateKeyEx(HKEY(!!!!!!!), strSubKey, 0, vbNullString, 0, _
        KEY_ALL_ACCESS, 0&, hNewHandle, lpdwDisposition)

But it's a BUG!
HKEY is equal to .. what?

For example your code might be:

lRetVal = RegCreateKeyEx(HKEY_LOCKAL_MASHINE,"SOFTWARE\Microsoft\MyKey", 0, vbNullString, 0, _
        KEY_ALL_ACCESS, 0&, hNewHandle, lpdwDisposition)

Check it and good luck!



0
 
danelroismanCommented:
Mistake,sorrrrrrrrrry!
not HKEY_LOCKAL_MASHINE but
HKEY_LOCAL_MACHINE
 
0
 
hoogteijlingAuthor Commented:
As you can see in my code HKEY is only a pass-through value. In fact I am passing the constant: HKEY_LOCAL_MACHINE = &H80000002 (= -2147483646)

This is also the value I see in the procedure during debug, so I assume this is correct.

What is this about a Bug. If this is so, is this bug in by program, in VB or in the Win API ????

I have tryed your sollution in entering the full HKEY_LOCAL_MACHINE
But no luck.....

I do get the feeling that you have been messing arround with this before also.
Please tell me more.

Thanks,
Marcel
0
 
crazymanCommented:
I made this small class that exports and imports registry settings in a custom text file i will paste it and maybe you can see what is wrong.
Im not sure but are you opening the key first using regopenkey ?


*****************************************

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'RegLoader version 1.0 by Richard Friend
'there are 2 methods import and export
'supported data types are dword string and envr strings
'
Option Explicit
Public Const HKEY_CLASSES_ROOT = &H80000000
Public Const HKEY_CURRENT_USER = &H80000001
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const HKEY_USERS = &H80000003
Public Const HKEY_CURRENT_CONFIG = &H80000005
Public Const HKEY_DYN_DATA = &H80000006
Public Const REG_SZ As Long = 1
Public Const REG_EXPAND_SZ = 2
Public Const REG_DWORD As Long = 4
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_ARENA_TRASHED = 7
Public Const ERROR_ACCESS_DENIED = 8
Public Const ERROR_INVALID_PARAMETERS = 87
Public Const ERROR_NO_MORE_ITEMS = 259
Public Const ERROR_SUCCESS = 0&
Public FILE_LOCATION
Const SYNCHRONIZE = &H100000
Public l As ListBox
Const STANDARD_RIGHTS_READ = &H20000
Const STANDARD_RIGHTS_WRITE = &H20000
Const STANDARD_RIGHTS_EXECUTE = &H20000
Const STANDARD_RIGHTS_REQUIRED = &HF0000
Const STANDARD_RIGHTS_ALL = &H1F0000
Const KEY_QUERY_VALUE = &H1
Const KEY_SET_VALUE = &H2
Const KEY_CREATE_SUB_KEY = &H4
Const KEY_ENUMERATE_SUB_KEYS = &H8
Const KEY_NOTIFY = &H10
Const KEY_CREATE_LINK = &H20
Public Const KEY_READ = ((STANDARD_RIGHTS_READ Or _
KEY_QUERY_VALUE Or _
KEY_ENUMERATE_SUB_KEYS Or _
KEY_NOTIFY) And _
(Not SYNCHRONIZE))
Public Const KEY_ALL_ACCESS = &H3F
Public Const REG_OPTION_NON_VOLATILE = 0

Declare Function RegCloseKey Lib "advapi32.dll" _
(ByVal hKey As Long) As Long
Declare Function RegCreateKeyEx Lib "advapi32.dll" Alias _
"RegCreateKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, _
ByVal Reserved As Long, ByVal lpClass As String, ByVal dwOptions _
As Long, ByVal samDesired As Long, ByVal lpSecurityAttributes _
As Long, phkResult As Long, lpdwDisposition As Long) As Long
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
Declare Function RegQueryValueExString Lib "advapi32.dll" Alias _
"RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As _
String, ByVal lpReserved As Long, lpType As Long, ByVal lpData _
As String, lpcbData As Long) As Long
Declare Function RegQueryValueExLong Lib "advapi32.dll" Alias _
"RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As _
String, ByVal lpReserved As Long, lpType As Long, lpData As _
Long, lpcbData As Long) As Long
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 Long, lpcbData As Long) As Long
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
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
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, _
                  lpData As Any, _
                  lpcbData As Long) As Long
                  Private 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
Private Declare Function RegQueryInfoKey Lib "advapi32.dll" Alias "RegQueryInfoKeyA" (ByVal hKey As Long, ByVal lpClass As String, lpcbClass As Long, ByVal lpReserved As Long, lpcSubKeys As Long, lpcbMaxSubKeyLen As Long, lpcbMaxClassLen As Long, lpcValues As Long, lpcbMaxValueNameLen As Long, lpcbMaxValueLen As Long, lpcbSecurityDescriptor As Long, lpftLastWriteTime As Any) As Long
Private Declare Function RegEnumValueLong 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, lpData As Long, lpcbData As Long) As Long
Private Declare Function RegEnumValueStr 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
Private Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long
Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long
Private Declare Function RegEnumValueByte 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, lpData As Byte, lpcbData As Long) As Long
Public Function EnumerateSections(ByRef sSect() As String, ByRef iSectCount As Long, phKey As Long, Section As String, Optional ByRef lngExpandErrmsg, Optional ByRef lngSzCount As Long) As Boolean

   Dim lResult       As Long
   Dim hKey          As Long
   Dim dwReserved    As Long
   Dim szBuffer      As String
   Dim lBuffSize     As Long
   Dim lIndex        As Long
   Dim lType         As Long
   Dim sCompKey      As String
   Dim iPos          As Long

   On Error GoTo EnumerateSectionsError

   iSectCount = 0
   Erase sSect
   ' ***
   lIndex = 0
   lResult = RegOpenKeyEx(phKey, Section, 0, KEY_ENUMERATE_SUB_KEYS, hKey)
   Do While lResult = ERROR_SUCCESS
   lngSzCount = lIndex
      ' *** Set buffer space
      szBuffer = String$(255, 0)
      lBuffSize = Len(szBuffer)

      ' *** Get next value
      lResult = RegEnumKey(hKey, lIndex, szBuffer, lBuffSize)

      If (lResult = ERROR_SUCCESS) Then
         iSectCount = iSectCount + 1
         ReDim Preserve sSect(1 To iSectCount) As String
         iPos = InStr(szBuffer, Chr$(0))
         If (iPos > 0) Then
            sSect(iSectCount) = Section & "\" & Left(szBuffer, iPos - 1)
         Else
            sSect(iSectCount) = Section & "\" & Left(szBuffer, lBuffSize)
         End If
      ElseIf lResult = ERROR_NO_MORE_ITEMS Then
        lngExpandErrmsg = ERROR_NO_MORE_ITEMS
      End If

      lIndex = lIndex + 1
   Loop
   If (hKey <> 0) Then
      RegCloseKey hKey
   End If
   EnumerateSections = True
   If iSectCount = 0 Then
    ReDim sSect(0 To 1)
End If
   Exit Function

EnumerateSectionsError:
   If (hKey <> 0) Then
      RegCloseKey hKey
   End If
'   Err.Raise vbObjectError + 1048 + 26002, App.EXEName & ".cRegistry", Err.Description
   Exit Function

End Function


Public Function ListValueContainers(lngSection As Long, strKy As String, strRes() As String, ByRef lngCount As Long) As String
Dim lngKeyHandle As Long
Dim lngResult As Long
Dim lngCurIdx As Long
Dim strValue As String
Dim lngValueLen As Long
Dim lngData As Long
Dim lngDataLen As Long
Dim strResult As String
Dim lType As Long
Dim cch As Long
Dim lrc As Long
'ReDim strRes(0 To 1)
lngResult = RegOpenKeyEx(lngSection, _
        strKy, _
         0&, _
         KEY_READ, _
         lngKeyHandle)
If lngResult <> ERROR_SUCCESS Then
    ListValueContainers = Empty
    Exit Function
End If
lngCurIdx = 0

Do
    lngValueLen = 2000
    strValue = String(lngValueLen, 0)
    lngDataLen = 2000
    lngResult = RegEnumValue(lngKeyHandle, _
                             lngCurIdx, _
                             ByVal strValue, _
                             lngValueLen, _
                             0&, _
                             0&, _
                             ByVal lngData, _
                             lngDataLen)
    lrc = RegQueryValueEx(lngKeyHandle, strValue, 0&, lType, 0&, cch)
   
    If lngResult = ERROR_SUCCESS Then
        lngCurIdx = lngCurIdx + 1
        ReDim Preserve strRes(1 To lngCurIdx)
        strRes(lngCurIdx) = Left(strValue, InStr(strValue, Chr(0)) - 1)
       
       
        lngCount = lngCurIdx
    End If
   
Loop While lngResult = ERROR_SUCCESS
Call RegCloseKey(lngKeyHandle)
End Function
Public Function QueryValue(rhkey As Long, sKeyName As String, sValueName As String, ByRef sz As Long) As String
Dim lRetVal As Long         'result of the API functions
Dim hKey As Long         'handle of opened key
Dim vValue As Variant      'setting of queried value
On Error GoTo e
lRetVal = RegOpenKeyEx(rhkey, sKeyName, 0, _
KEY_ALL_ACCESS, hKey)
lRetVal = QueryValueEx(hKey, sValueName, vValue, sz)
'MsgBox vValue
QueryValue = Left(vValue, InStr(vValue, Chr(0)) - 1)
RegCloseKey (hKey)
Exit Function
e:

End Function
Function QueryValueEx(ByVal lhKey As Long, ByVal szValueName As _
String, vValue As Variant, Optional ByRef szType As Long, Optional blnWrite As Boolean) As Long
Dim cch As Long
Dim lrc As Long
Dim lType As Long
Dim lValue As Variant
Dim sValue As String

On Error GoTo QueryValueExError

' Determine the size and type of data to be read
lrc = RegQueryValueEx(lhKey, szValueName, 0&, lType, 0&, cch)
If lrc <> ERROR_NONE Then Error 5

Select Case lType
' For strings
    Case REG_SZ
        sValue = String(cch, 0)
        szType = REG_SZ
        lrc = RegQueryValueExString(lhKey, szValueName, 0&, lType, _
        sValue, cch)
        'If lrc = ERROR_NONE Then
         '   vValue = Left$(sValue, cch - 1)
       ' Else
            If Not blnWrite Then vValue = sValue
       ' End If
        ' For DWORDS
    Case REG_DWORD:
        szType = REG_DWORD
        lrc = RegQueryValueExLong(lhKey, szValueName, 0&, lType, _
        lValue, cch)
        If lrc = ERROR_NONE And Not blnWrite Then vValue = lValue
    Case REG_EXPAND_SZ
        'all other data types not supported
        sValue = String(cch, 0)
        'szType = REG_SZ
       
        lrc = RegQueryValueExString(lhKey, szValueName, 0&, lType, _
        sValue, cch)
        szType = lType
         If Not blnWrite Then vValue = sValue
        'If lrc = ERROR_NONE Then
         '   vValue = Left$(sValue, cch - 1)
       ' Else
            'MsgBox ExpandEnvStr(sValue)
       ' End If
End Select

QueryValueExExit:
QueryValueEx = lrc
Exit Function

QueryValueExError:

Resume QueryValueExExit
End Function

Public Function SaveFullPath(hKey As Long, strSection As String, strContainers As String, vValue As Variant, lngDataType As Long)
     Dim intFile As Integer
     Dim strKey As String
     intFile = FreeFile
     Select Case hKey
        Case HKEY_CLASSES_ROOT
            strKey = "HKEY_CLASSES_ROOT"
        Case HKEY_CURRENT_USER
            strKey = "HKEY_CURRENT_USER"
        Case HKEY_LOCAL_MACHINE
            strKey = "HKEY_LOCAL_MACHINE"
        Case HKEY_USERS
            strKey = "HKEY_USERS"
        Case HKEY_CURRENT_CONFIG
            strKey = "HKEY_CURRENT_CONFIG"
        Case HKEY_DYN_DATA
            strKey = "HKEY_DYN_DATA"
    End Select
    '
    Open FILE_LOCATION For Append As #intFile
         Print #intFile, lngDataType & strKey & "\" & strSection & "     [" & strContainers & " --:-- " & vValue & "]## ~"
    Close #intFile
End Function
Public Sub Export(strRegPath As String, ByVal strFilePath As String)
  'List1.Clear
    'If Len(Dir(strFilePath)) > 0 Then Kill strFilePath
    FILE_LOCATION = strFilePath
    Dim strphKey As String
    Dim phKey As Long
    Dim strSection As String
    Dim intPos As Integer
    '
    Dim strSections() As String
    Dim strVal() As String
    Dim lngValCount As Long
    Dim lngiSect As Long
    Dim lngErr As Long
    Dim lngSZ As Long
    Dim x As Long
    Dim lngDataType As Long
    Dim y As Long
    intPos = InStr(strRegPath, "\")
    strphKey = Left(strRegPath, intPos - 1)
    strSection = Mid(strRegPath, intPos + 1)
    Select Case strphKey
        Case "HKEY_CLASSES_ROOT"
            phKey = HKEY_CLASSES_ROOT
        Case "HKEY_CURRENT_USER"
            phKey = HKEY_CURRENT_USER
        Case "HKEY_LOCAL_MACHINE"
            phKey = HKEY_LOCAL_MACHINE
        Case "HKEY_USERS"
            phKey = HKEY_USERS
        Case "HKEY_CURRENT_CONFIG"
            phKey = HKEY_CURRENT_CONFIG
        Case "HKEY_DYN_DATA"
            phKey = HKEY_DYN_DATA
    End Select
   
    EnumerateSections strSections(), lngiSect, phKey, strSection, lngErr, lngSZ
    If lngSZ > 0 Then
        For x = LBound(strSections) To UBound(strSections)
            'recursive function pass key back through
            Export strphKey & "\" & strSections(x), FILE_LOCATION
        Next x
    End If
    ListValueContainers phKey, strSection, strVal, lngValCount
    If lngValCount > 0 Then
        For y = LBound(strVal) To UBound(strVal)
             SaveFullPath phKey, strSection, strVal(y), QueryValue(phKey, strSection, strVal(y), lngDataType), lngDataType
        Next y
    End If
End Sub



Public Sub Import(strFile As String)
Dim intFile As Integer
Dim strInsert As String
Dim strphKey As String
Dim phKey As Long
Dim strSection As String
Dim intPos As Integer
Dim strContainer As String
Dim strKeyParts() As String
Dim strVal As String
Dim x As Long
Dim hKey As Long
Dim lngDataType As Long
On Error GoTo e_trap
intFile = FreeFile
Dim strAllInserts As String
Open strFile For Input As #intFile

    Do While Not EOF(intFile)
        Input #intFile, strInsert
        strAllInserts = strAllInserts & strInsert
    Loop
    Close #intFile
    If Left(strAllInserts, 2) = "{{" Then
        strAllInserts = Mid(strAllInserts, InStr(strAllInserts, "}}") + 2)
    End If
    intPos = InStr(strAllInserts, "\")
    Do While intPos > 0
        intPos = InStr(strAllInserts, "\")
        If intPos = 0 Then Exit Do
        strphKey = Left(strAllInserts, intPos - 1)
        strAllInserts = Mid(strAllInserts, intPos + 1)
        intPos = InStr(strAllInserts, "     [")
        If intPos = 0 Then Exit Do
        strSection = Left(strAllInserts, intPos - 1)
        strAllInserts = Mid(strAllInserts, intPos + 6)
        intPos = InStr(strAllInserts, " --:-- ")
        If intPos = 0 Then Exit Do
        strContainer = Left(strAllInserts, intPos - 1)
        strAllInserts = Mid(strAllInserts, intPos + 7)
        intPos = InStr(strAllInserts, "]## ~")
        If intPos = 0 Then Exit Do
        strVal = Left(strAllInserts, intPos - 1)
        'strVal = Trim$(strVal)
        strAllInserts = Mid(strAllInserts, intPos + 5)
        lngDataType = CLng(Left(strphKey, 1))
        strphKey = Mid(strphKey, 2)
        Select Case strphKey
            Case "HKEY_CLASSES_ROOT"
                phKey = HKEY_CLASSES_ROOT
            Case "HKEY_CURRENT_USER"
                phKey = HKEY_CURRENT_USER
            Case "HKEY_LOCAL_MACHINE"
                phKey = HKEY_LOCAL_MACHINE
            Case "HKEY_USERS"
                phKey = HKEY_USERS
            Case "HKEY_CURRENT_CONFIG"
                phKey = HKEY_CURRENT_CONFIG
            Case "HKEY_DYN_DATA"
                phKey = HKEY_DYN_DATA
            Case Else
               
               
                Log "Import", "00", "HKEY UnKnown"
        End Select
        strKeyParts() = Split(strSection, "\")
        strSection = strKeyParts(0)
        For x = LBound(strKeyParts) + 1 To UBound(strKeyParts)
            If RegOpenKeyEx(phKey, strSection, 0, KEY_ALL_ACCESS, hKey) = 0 Then
                RegCloseKey (hKey)
                strSection = strSection & "\" & strKeyParts(x)
            Else
                RegCloseKey (hKey)
                If CreateNewKey(phKey, Mid(strSection, Len(strSection) - 1), strKeyParts(x)) Then
                    'created new key
                    strSection = strSection & "\" & strKeyParts(x)
                End If
            End If
        Next x
        SetValue phKey, strSection, strContainer, strVal, lngDataType
    Loop
Exit Sub
e_trap:
    Log "Import", "00", Err.Description
End Sub
  Public Function CreateNewKey(rhkey As Long, strCurKey As String, sNewKeyName As String) As Boolean
Dim hNewKey As Long         'handle to the new key
Dim lRetVal As Long
Dim hKey As Long
On Error GoTo e:
'result of the RegCreateKeyEx function
lRetVal = lRetVal = RegOpenKeyEx(rhkey, strCurKey, 0, _
                       KEY_ALL_ACCESS, hKey)
lRetVal = RegCreateKeyEx(hKey, sNewKeyName, 0&, _
          vbNullString, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, _
          0&, hNewKey, lRetVal)
          If lRetVal = 0 Then CreateNewKey = True
RegCloseKey (hNewKey)
Exit Function
e:
End Function
Public Function SetValue(m_hClassKey As Long, m_sSectionKey As String, m_sValueKey As String, Val As Variant, ByVal m_eValueType As Long) As Boolean
Dim ordType       As Long
   Dim c             As Long
   Dim hKey          As Long
   Dim e             As Long
   Dim lCreate       As Long
   Dim tSA           As Long 'SECURITY_ATTRIBUTES
    On Error GoTo e
   ' *** Open or Create the key
   e = RegCreateKeyEx(m_hClassKey, m_sSectionKey, 0, "", REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, tSA, hKey, lCreate)
    Select Case m_eValueType
         Case REG_DWORD
            'If (VarType(Val) = vbInteger) Or (VarType(Val) = vbLong) Then
               Dim i As Long
               i = 0
               ordType = REG_DWORD
               e = RegSetValueExLong(hKey, m_sValueKey, 0&, ordType, i, 4)
            'End If
         Case REG_SZ
            Dim s As String, iPos As Long
            s = Val
            ordType = REG_SZ
            ' ***  Assume anything with two non-adjacent percents is expanded string
            iPos = InStr(s, "%")
           
            c = Len(s) + 1
            e = RegSetValueExString(hKey, m_sValueKey, 0&, ordType, s, c)

            ' ***  User should convert to a compatible type before calling
         Case Else
            'e = ERROR_INVALID_DATA
      End Select
      If e = 0 Then SetValue = True
      ' *** Close the key
      RegCloseKey hKey
Exit Function
e:
End Function
Public Function Log(strProc As String, strErrNo As String, strErr As String)
    Dim intFile As Integer
    Dim strPath As String
    strPath = App.Path & "\RegLoaderErr.log"
    intFile = FreeFile
    Open strPath For Append As intFile
        Print #intFile, "[" & Now & "]" & strErrNo & "-:-" & strProc & "-:-" & strErr
    Close #intFile
End Function




*********************************************


Called using


Public Function ExportRegistry(strFullRegPath As String, strFilePath As String)
    If InStr(strFilePath, ":\") <> 2 Then
       
    Else
        If Len(Dir(strFilePath)) > 0 Then Kill strFilePath
        Export strFullRegPath, strFilePath
    End If
End Function
Public Function ImportRegistry(strFileLocation As String)
    Import strFileLocation
End Function
0
 
paul_giloweyCommented:
I am getting the same problem.... but with the compiled version of the vb dll only.  If I run in debug mode then it works fine.
0

Featured Post

Get your problem seen by more experts

Be seen. Boost your question’s priority for more expert views and faster solutions

Tackle projects and never again get stuck behind a technical roadblock.
Join Now