Sorry for late answer.
I don't know the place with open source function, but can suggest my solution.
The code below contains functions to copy, rename and delete keys in registry.

Alexander

Attribute VB_Name = "RenameKey"
Option Explicit

Const ERROR_SUCCESS = 0
Const REG_OPTION_NON_VOLATILE = 0
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&
Const READ_CONTROL = &H20000
Const WRITE_DAC = &H40000
Const WRITE_OWNER = &H80000
Const SYNCHRONIZE = &H100000
Const STANDARD_RIGHTS_REQUIRED = &HF0000
Const STANDARD_RIGHTS_READ = READ_CONTROL
Const STANDARD_RIGHTS_WRITE = READ_CONTROL
Const STANDARD_RIGHTS_EXECUTE = READ_CONTROL
Const KEY_READ = STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY
Const KEY_WRITE = STANDARD_RIGHTS_WRITE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY
Const KEY_EXECUTE = KEY_READ

Const FORMAT_MESSAGE_ALLOCATE_BUFFER = &H100
Const FORMAT_MESSAGE_FROM_SYSTEM = &H1000
Const LANG_NEUTRAL = &H0
Const SUBLANG_DEFAULT = &H1

Private Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type

Private Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" _
    (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, _
    ByVal samDesired As Long, phkResult As Long) As Long
Private Declare Function RegCreateKeyEx Lib "advapi32" Alias "RegCreateKeyExA" _
    (ByVal hKey As Long, ByVal lpSubKey As String, ByVal Reserved As Long, _
    ByVal lpClass As String, ByVal dwOptions As Long, ByVal samDesired As Long, _
    ByVal lpSecurityAttributes As Long, phkResult As Long, lpdwDisposition As Long) _
    As Long
Private Declare Function RegCloseKey Lib "advapi32" _
    (ByVal hKey As Long) As Long
Public Declare Function RegEnumKeyEx Lib "advapi32" Alias "RegEnumKeyExA" _
    (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, _
    lpcbName As Long, ByVal lpReserved As Long, ByVal lpClass As String, _
    lpcbClass As Long, lpftLastWriteTime As FILETIME) As Long
Private Declare Function RegEnumValue Lib "advapi32" 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 RegQueryValueEx Lib "advapi32" Alias "RegQueryValueExA" _
    (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, _
    lpType As Long, ByVal szData As String, lpcbData As Long) As Long
Private Declare Function RegSetValueEx Lib "advapi32" Alias "RegSetValueExA" _
    (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, _
    ByVal lpType As Long, ByVal szData As String, ByVal lpcbData As Long) As Long
Private Declare Function RegDeleteKey& Lib "advapi32" Alias "RegDeleteKeyA" _
    (ByVal hKey As Long, ByVal lpSubKey As String)
Private Declare Function RegDeleteValue& Lib "advapi32" Alias "RegDeleteValueA" _
    (ByVal hKey As Long, ByVal lpValueName As String)

Private Declare Function FormatMessage Lib "kernel32" Alias "FormatMessageA" _
    (ByVal dwFlags As Long, lpSource As Any, ByVal dwMessageId As Long, _
    ByVal dwLanguageId As Long, ByVal lpBuffer As String, ByVal nSize As Long, _
    Arguments As Long) As Long
Private Declare Function GetLastError Lib "kernel32" () As Long


Private Sub ErrMsg(lErrorCode As Long, Optional Message As String = "")
    
    Dim Buffer As String, Msg As String
    ' Create a string buffer
    Buffer = Space(256)
    ' Format the message string
    FormatMessage FORMAT_MESSAGE_FROM_SYSTEM, ByVal 0&, lErrorCode, _
        LANG_NEUTRAL, Buffer, 256, ByVal 0&
    ' Show the message
    Msg = IIf(Len(Message) <> 0, Message & vbCrLf & Buffer, Buffer)
    MsgBox Msg, vbCritical, "WinAPI error #" & lErrorCode

End Sub

' Renaming keys in registry
Public Function Rename(RootSrc As Long, SubkeySrc As String, _
    RootDest As Long, SubkeyDest As String) As Boolean

    Rename = False
    If CopyKey(RootSrc, SubkeySrc, RootDest, SubkeyDest) Then
        If DeleteKey(RootSrc, SubkeySrc) Then Rename = True
    End If
End Function

' Recursive copying keys in registry
Public Function CopyKey(RootSrc As Long, SubkeySrc As String, _
    RootDest As Long, SubkeyDest As String) As Boolean

    Dim hKey1 As Long, hKey2 As Long, res As Long, r As Long

    res = RegOpenKeyEx(RootSrc, SubkeySrc, 0&, KEY_READ, hKey1) 'open the key
    If res <> ERROR_SUCCESS Then            'if the key could not be opened then
        ErrMsg res, "Can't open source key:" 'display the error
        CopyKey = False
        Exit Function
    End If

    res = RegCreateKeyEx(RootDest, SubkeyDest, 0&, vbNullString, _
        REG_OPTION_NON_VOLATILE, KEY_WRITE, 0&, hKey2, r) 'create the key
    If res <> ERROR_SUCCESS Then            'if the key could not be created then
        RegCloseKey hKey1                   'close the key
        ErrMsg res, "Can't create target key:" 'display the error
        CopyKey = False
        Exit Function
    End If

    CopyKey = True
    Dim sName As String, sData As String
    sName = Space(256)
    sData = Space(256)
    Dim sTime As FILETIME
    Dim lIndex As Long, lType As Long, DataLen As Long

    ' Copy subkeys
    lIndex = 0
    While RegEnumKeyEx(hKey1, lIndex, sName, 256, 0, vbNullString, 0, sTime) = ERROR_SUCCESS
        If Not CopyKey(hKey1, sName, hKey2, sName) Then
            CopyKey = False
        End If
        lIndex = lIndex + 1
    Wend

    ' Copy values
    DataLen = 256
    lIndex = 0
    While RegEnumValue(hKey1, lIndex, sName, 256, 0, lType, sData, DataLen) = ERROR_SUCCESS
        res = RegSetValueEx(hKey2, sName, 0, lType, sData, DataLen)
        If res <> ERROR_SUCCESS Then
            ErrMsg res, "Can't assign value:"
            CopyKey = False
        End If
        DataLen = 256
        lIndex = lIndex + 1
    Wend
    
    RegCloseKey hKey1
    RegCloseKey hKey2
End Function

' Recursive deleting of keys in registry
Public Function DeleteKey(RootSrc As Long, SubkeySrc As String) As Boolean
    Dim hKey1 As Long, res As Long

    res = RegOpenKeyEx(RootSrc, SubkeySrc, 0&, KEY_WRITE, hKey1) 'open the key
    If res <> ERROR_SUCCESS Then            'if the key could not be opened then
        ErrMsg res, "Can't open source key:" 'display the error
        DeleteKey = False
        Exit Function
    End If
    
    DeleteKey = True
    Dim sName As String
    sName = Space(256)
    Dim sTime As FILETIME
    
    ' Delete subkeys
    While RegEnumKeyEx(hKey1, 0, sName, 256, 0, vbNullString, 0, sTime) = ERROR_SUCCESS
        If Not DeleteKey(hKey1, sName) Then
            DeleteKey = False
        End If
    Wend
    
    RegCloseKey hKey1
    
    ' Delete key
    res = RegDeleteKey(RootSrc, SubkeySrc)
    If res <> ERROR_SUCCESS Then
        ErrMsg res, "Can't delete key:"
        DeleteKey = False
    End If
End Function

>Thanks for the help, but on that web page all components are for sell..and this is a personal project, so i dont wanna waste money on something that does such a simple task ( in teory off course ) is you know or have someplace where i can download a open source function to rename the key of the registry....ill really apreciate