RE:Pasar a una funcion un form y una caja de texto
No se ase asi esto es mucho mas complicado mira pon este codigo:
Option Explicit
Public Enum eTipoRegistro
eMaquinaLocal = 0
eUsuarioActual = 1
eRaizClases = 2
eConfiguracionActual = 3
End Enum
Public Enum eTipoDato
eBinario = 0
eString = 1
eEntero = 2
End Enum
Public Function LeerValor(ByVal pvTipoRegistro As eTipoRegistro, _
ByVal pvLlave As String, _
ByVal pvValor As String, _
ByVal pvDefecto As Variant) As Variant
Dim vll_ValRet As Long
Dim vll_DirReg As Long
Dim vll_hKey As Long
Dim vlx_Dato As Variant
Dim vll_TipoDato As Long
Dim vls_DirReg As String
Dim vloWScript As Object
On Error Resume Next
Select Case pvTipoRegistro
Case eTipoRegistro.eMaquinaLocal
vll_DirReg = HKEY_LOCAL_MACHINE
vls_DirReg = "HKEY_LOCAL_MACHINE"
Case eTipoRegistro.eUsuarioActual
vll_DirReg = HKEY_CURRENT_USER
vls_DirReg = "HKEY_CURRENT_USER"
Case eTipoRegistro.eRaizClases
vll_DirReg = HKEY_CLASSES_ROOT
vls_DirReg = "HKEY_CLASSES_ROOT"
Case eTipoRegistro.eConfiguracionActual
vll_DirReg = HKEY_CURRENT_CONFIG
vls_DirReg = "HKEY_CURRENT_CONFIG"
End Select
vll_ValRet = RegOpenKeyEx(vll_DirReg, pvLlave, 0, KEY_ALL_ACCESS, vll_hKey)
If vll_ValRet = 0 Then
Set vloWScript = CreateObject("WScript.Shell")
vlx_Dato = vloWScript.RegRead(vls_DirReg & "\" & pvLlave & "\" & pvValor)
If Err.Number <> 0 Then
vlx_Dato = pvDefecto
End If
If StrComp(vlx_Dato, vls_DirReg & "\" & pvLlave & "\" & pvValor, vbTextCompare) = 0 Then
vlx_Dato = pvDefecto
End If
Set vloWScript = Nothing
Else
vlx_Dato = pvDefecto
End If
LeerValor = vlx_Dato
End Function
Public Function GuardarLlave(ByVal pvTipoRegistro As eTipoRegistro, _
ByVal pvLlave As String) As Long
Dim vll_ValRet As Long
Dim vll_DirReg As Long
Dim vll_hKey As Long
Dim vll_Bandera As Long
Dim vle_Atributos As SECURITY_ATTRIBUTES
Dim vls_DirReg As String
Select Case pvTipoRegistro
Case eTipoRegistro.eMaquinaLocal
vll_DirReg = HKEY_LOCAL_MACHINE
vls_DirReg = "HKEY_LOCAL_MACHINE"
Case eTipoRegistro.eUsuarioActual
vll_DirReg = HKEY_CURRENT_USER
vls_DirReg = "HKEY_CURRENT_USER"
Case eTipoRegistro.eRaizClases
vll_DirReg = HKEY_CLASSES_ROOT
vls_DirReg = "HKEY_CLASSES_ROOT"
Case eTipoRegistro.eConfiguracionActual
vll_DirReg = HKEY_CURRENT_CONFIG
vls_DirReg = "HKEY_CURRENT_CONFIG"
End Select
vle_Atributos.nLength = Len(vle_Atributos)
vle_Atributos.bInheritHandle = 1
vle_Atributos.lpSecurityDescriptor = 0
vll_ValRet = RegCreateKeyEx(vll_DirReg, pvLlave, 0, "", 0, KEY_ALL_ACCESS, vle_Atributos, vll_hKey, vll_Bandera)
If vll_ValRet = 0 Then vll_ValRet = RegCloseKey(vll_hKey)
GuardarLlave = vll_ValRet
End Function
Public Function GuardarValor(ByVal pvTipoRegistro As eTipoRegistro, _
ByVal pvLlave As String, _
ByVal pvValor As String, _
ByVal pvDato As Variant, _
ByVal pvTipoDato As eTipoDato) As Long
Dim vll_ValRet As Long
Dim vll_DirReg As Long
Dim vll_hKey As Long
Dim vls_Dato As String
Dim vll_Dato As Long
Dim vls_DirReg As String
Dim vls_TipoDato As String
Dim vloWScript As Object
Select Case pvTipoDato
Case eTipoDato.eBinario
vls_TipoDato = "REG_BINARY"
Case eTipoDato.eEntero
vls_TipoDato = "REG_DWORD"
Case eTipoDato.eString
vls_TipoDato = "REG_SZ"
End Select
Select Case pvTipoRegistro
Case eTipoRegistro.eMaquinaLocal
vll_DirReg = HKEY_LOCAL_MACHINE
vls_DirReg = "HKEY_LOCAL_MACHINE"
Case eTipoRegistro.eUsuarioActual
vll_DirReg = HKEY_CURRENT_USER
vls_DirReg = "HKEY_CURRENT_USER"
Case eTipoRegistro.eRaizClases
vll_DirReg = HKEY_CLASSES_ROOT
vls_DirReg = "HKEY_CLASSES_ROOT"
Case eTipoRegistro.eConfiguracionActual
vll_DirReg = HKEY_CURRENT_CONFIG
vls_DirReg = "HKEY_CURRENT_CONFIG"
End Select
If Left(pvLlave, 1) = "\" Then pvLlave = Right(pvLlave, Len(pvLlave) - 1)
vll_ValRet = RegOpenKeyEx(vll_DirReg, pvLlave, 0, KEY_ALL_ACCESS, vll_hKey)
If vll_ValRet = 0 Then
If Not IsEmpty(pvDato) Then
Set vloWScript = CreateObject("WScript.Shell")
vloWScript.RegWrite vls_DirReg & "\" & pvLlave & "\" & pvValor, pvDato, vls_TipoDato
Set vloWScript = Nothing
End If
vll_ValRet = RegCloseKey(vll_hKey)
End If
GuardarValor = vll_ValRet
End Function
Public Function BorrarValor(ByVal pvTipoRegistro As eTipoRegistro, _
ByVal pvLlave As String, _
ByVal pvValor As String) As Long
Dim vll_ValRet As Long
Dim vll_DirReg As Long
Dim vll_hKey As Long
Dim vls_DirReg As String
Select Case pvTipoRegistro
Case eTipoRegistro.eMaquinaLocal
vll_DirReg = HKEY_LOCAL_MACHINE
vls_DirReg = "HKEY_LOCAL_MACHINE"
Case eTipoRegistro.eUsuarioActual
vll_DirReg = HKEY_CURRENT_USER
vls_DirReg = "HKEY_CURRENT_USER"
Case eTipoRegistro.eRaizClases
vll_DirReg = HKEY_CLASSES_ROOT
vls_DirReg = "HKEY_CLASSES_ROOT"
Case eTipoRegistro.eConfiguracionActual
vll_DirReg = HKEY_CURRENT_CONFIG
vls_DirReg = "HKEY_CURRENT_CONFIG"
End Select
vll_ValRet = RegOpenKeyEx(vll_DirReg, pvLlave, 0, KEY_ALL_ACCESS, vll_hKey)
If vll_ValRet = 0 Then
vll_ValRet = RegDeleteValue(vll_hKey, pvValor)
vll_ValRet = RegCloseKey(vll_hKey)
End If
BorrarValor = vll_ValRet
End Function
Public Function BorrarLlave(ByVal pvTipoRegistro As eTipoRegistro, _
ByVal pvLlave As String) As Long
Dim vll_ValRet As Long
Dim vll_DirReg As Long
Dim vll_hKey As Long
Dim vls_DirReg As String
Select Case pvTipoRegistro
Case eTipoRegistro.eMaquinaLocal
vll_DirReg = HKEY_LOCAL_MACHINE
vls_DirReg = "HKEY_LOCAL_MACHINE"
Case eTipoRegistro.eUsuarioActual
vll_DirReg = HKEY_CURRENT_USER
vls_DirReg = "HKEY_CURRENT_USER"
Case eTipoRegistro.eRaizClases
vll_DirReg = HKEY_CLASSES_ROOT
vls_DirReg = "HKEY_CLASSES_ROOT"
Case eTipoRegistro.eConfiguracionActual
vll_DirReg = HKEY_CURRENT_CONFIG
vls_DirReg = "HKEY_CURRENT_CONFIG"
End Select
vll_ValRet = RegDeleteKey(vll_DirReg, pvLlave)
BorrarLlave = vll_ValRet
End Function
