Ver Mensaje Individual
  #4 (permalink)  
Antiguo 07/01/2005, 00:46
Avatar de stock
stock
 
Fecha de Ingreso: junio-2004
Ubicación: Monterrey NL
Mensajes: 2.390
Antigüedad: 19 años, 10 meses
Puntos: 53
No se crean, no es tan dificil, si, usas funciones API de windows como las que meciono Eternal Idol, pero para que vean que soy cuate, hay les pongo el modulo necesario para crear, borrar claves en el registro!!

Código:
Option Explicit
Global m_lngRetVal As Long

Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal lngRootKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal lngRootKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Declare Function RegCloseKey Lib "advapi32.dll" (ByVal lngRootKey As Long) As Long
Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal lngRootKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long
Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal lngRootKey As Long, ByVal lpValueName As String) As Long

Public Const HKEY_CLASSES_ROOT As Long = &H80000000
Public Const HKEY_CURRENT_USER As Long = &H80000001
Public Const HKEY_LOCAL_MACHINE As Long = &H80000002
Public Const HKEY_USERS As Long = &H80000003
Public Const HKEY_PERFORMANCE_DATA As Long = &H80000004
Public Const HKEY_CURRENT_CONFIG As Long = &H80000005
Public Const HKEY_DYN_DATA As Long = &H80000006

Public Const REG_NONE As Long = 0                  ' No value type
Public Const REG_SZ As Long = 1                    ' nul terminated string
Public Const REG_EXPAND_SZ As Long = 2             ' nul terminated string w/enviornment var
Public Const REG_BINARY As Long = 3                ' Free form binary
Public Const REG_DWORD As Long = 4                 ' 32-bit number
Public Const REG_DWORD_LITTLE_ENDIAN As Long = 4   ' 32-bit number (same as REG_DWORD)
Public Const REG_DWORD_BIG_ENDIAN As Long = 5      ' 32-bit number
Public Const REG_LINK As Long = 6                  ' Symbolic Link (unicode)
Public Const REG_MULTI_SZ As Long = 7              ' Multiple Unicode strings
Public Const REG_RESOURCE_LIST As Long = 8         ' Resource list in the resource map
Public Const REG_FULL_RESOURCE_DESCRIPTOR As Long = 9 ' Resource list in the hardware description
Public Const REG_RESOURCE_REQUIREMENTS_LIST As Long = 10

'COMPRUEBA QUE EXISTA UNA CLAVE, REGRESA TRUE O FALSE
Public Function ExisteKey(ByVal lngRootKey As Long, ByVal strRegKeyPath As String) As Boolean
    Dim lngKeyHandle As Long
    lngKeyHandle = 0
    m_lngRetVal = RegOpenKey(lngRootKey, strRegKeyPath, lngKeyHandle)
    If lngKeyHandle = 0 Then
        ExisteKey = False
    Else
        ExisteKey = True
    End If
    m_lngRetVal = RegCloseKey(lngKeyHandle)
End Function

'CREA UNA KEY O FOLDER
Public Function CrearKey(ByVal lngRootKey As Long, ByVal strRegKeyPath As String)
    Dim lngKeyHandle As Long
    m_lngRetVal = RegCreateKey(lngRootKey, strRegKeyPath, lngKeyHandle)
    m_lngRetVal = RegCloseKey(lngKeyHandle)
End Function

'CREA O MODIFICA UNA KEY DE TIPO STRING O DWORD, CON UN VALOR DETERMINADO
Public Sub CrearKeyConValor(ByVal lngRootKey As Long, ByVal strRegKeyPath As String, ByVal strRegSubKey As String, varRegData As Variant)
  Dim lngKeyHandle As Long
  Dim lngDataType As Long
  Dim lngKeyValue As Long
  Dim strKeyValue As String
  If IsNumeric(varRegData) Then
      lngDataType = REG_DWORD
  Else
      lngDataType = REG_SZ
  End If
  m_lngRetVal = RegCreateKey(lngRootKey, strRegKeyPath, lngKeyHandle)
  Select Case lngDataType
         Case REG_SZ:       ' String data
              strKeyValue = Trim(varRegData) & Chr(0)     ' null terminated
              m_lngRetVal = RegSetValueEx(lngKeyHandle, strRegSubKey, 0&, lngDataType, _
                                          ByVal strKeyValue, Len(strKeyValue))
                                   
         Case REG_DWORD:    ' numeric data
              lngKeyValue = CLng(varRegData)
              m_lngRetVal = RegSetValueEx(lngKeyHandle, strRegSubKey, 0&, lngDataType, _
                                          lngKeyValue, 4&)  ' 4& = 4-byte word (long integer)
                                   
  End Select
  m_lngRetVal = RegCloseKey(lngKeyHandle)
End Sub

'BORRA UNA SUBKEY DEL REGISTRO
Public Function BorrarSubKey(ByVal lngRootKey As Long, ByVal strRegKeyPath As String, ByVal strRegSubKey As String)
    Dim lngKeyHandle As Long
    If ExisteKey(lngRootKey, strRegKeyPath) Then
        m_lngRetVal = RegOpenKey(lngRootKey, strRegKeyPath, lngKeyHandle)
        m_lngRetVal = RegDeleteValue(lngKeyHandle, strRegSubKey)
        m_lngRetVal = RegCloseKey(lngKeyHandle)
    End If
End Function
eso es todo lo que necesitan!! dudas, pues nomas mandenme un mensage o posteen, por aqui me doy vueltas diariamente!!

bytes!!