Aplicación al registro

[servantsoftware]

Hola, que tal !

Alguien me podría dar los códigos para subir mi aplicación al registro, por ejemplo:

Un command1 para subir la aplicacion al registro
Otro Command2 para quitar la aplicacion del registro

Osea que inicie con Windows, y que compata con todos los Windows (XP ,Vista ,7)

Muchas Gracias!

Ojo: los command estarán en la misma aplicación.

[servantsoftware]

Ya conseguí como, lo publicare para que les sirva de aporte:

En un modulo .Bas:

Código:

Option Explicit
  
'Declaración de constantes
'****************************
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 REG_SZ As Long = 1
Public Const REG_DWORD As Long = 4
  
Private Const KEY_ALL_ACCESS = &H3F
Private Const REG_OPTION_NON_VOLATILE = 0
  
  
'Declaración de las funciones api para el registro
'*************************************************
  
' Cierra la clave abierta
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
  
'Abre una clave
Private 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
  
'Establece un valor de tipo cadena
Private 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
  
'Establece un valor de tipo entero
Private 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
  
'Elimina una clave
Private Declare Function RegDeleteKey& Lib "advapi32.dll" Alias "RegDeleteKeyA" _
        (ByVal hKey As Long, _
         ByVal lpSubKey As String)
  
'Elimina un valor del registro
Private Declare Function RegDeleteValue& Lib "advapi32.dll" Alias "RegDeleteValueA" _
        (ByVal hKey As Long, _
         ByVal lpValueName As String)
  
  
  
  
  
' Función que elimina una clave especifica utilizando el Api RegDeleteKey
  
Function EliminarClave(clave As Long, Nombre_clave As String)
      
    Dim Ret As Long
    ' Eliminar
    Ret = RegDeleteKey(clave, Nombre_clave)
      
End Function
  
' Función que elimina un dato utilizando el Api RegDeleteValue
  
Function EliminarValor(clave As Long, _
                              Nombre_clave As String, _
                              Nombre_valor As String) As Boolean
  
  
       Dim Ret As Long
       Dim Handle_clave As Long
         
       ' Abre la clave del registro indicada
       Ret = RegOpenKeyEx(clave, Nombre_clave, 0, KEY_ALL_ACCESS, Handle_clave)
         
       'si el valor de retorno es distinto de 0 es por que hubo un error
       If Ret <> 0 Then
          EliminarValor = False
          Exit Function
       End If
         
       'Elimina el valor del registro
       Ret = RegDeleteValue(Handle_clave, Nombre_valor)
         
       If Ret <> 0 Then
          EliminarValor = False
          Exit Function
       End If
         
       'Cierra la vlave del registro abierta
       RegCloseKey (Handle_clave)
         
       ' OK
       EliminarValor = True
         
End Function
  
  
  
' Función que establece un nuevo valor mediante el Api SetValueEx
  
Function EstablecerValor(clave As Long, _
                                Nombre_clave As String, _
                                Nombre_valor As String, _
                                el_Valor As Variant, _
                                Tipo_Valor As Long) As Boolean
  
  
       Dim Ret As Long
       Dim Handle_clave As Long
  
       'Abre la clave del registro indicada
       Ret = RegOpenKeyEx(clave, Nombre_clave, 0, KEY_ALL_ACCESS, Handle_clave)
         
       'si el valor de retorno es distinto de 0 es por que hubo un error
       If Ret <> 0 Then
          EstablecerValor = False
          Exit Function
       End If
         
       'Establece el nuevo dato
       Ret = SetValueEx(Handle_clave, Nombre_valor, Tipo_Valor, el_Valor)
         
       If Ret <> 0 Then
          EstablecerValor = False
          Exit Function
       End If
         
       'cierra la clave abierta
       RegCloseKey (Handle_clave)
         
       'Ok
       EstablecerValor = True
         
         
End Function
  
' Función que establece y graba la entrada _
  en el registro ( para datos de cadena y Dword)
  
Private Function SetValueEx(ByVal Handle_clave As Long, _
                            Nombre_valor As String, _
                            Tipo As Long, _
                            el_Valor As Variant) As Long
      
    Dim Ret As Long
    Dim sValue As String
  
    Select Case Tipo
          
        ' Valor de tipo cadena
        Case REG_SZ
              
            sValue = el_Valor
            SetValueEx = RegSetValueExString(Handle_clave, _
                                             Nombre_valor, 0&, _
                                             Tipo, sValue, Len(sValue))
          
        'Valor Entero
        Case REG_DWORD
            Ret = el_Valor
            SetValueEx = RegSetValueExLong(Handle_clave, Nombre_valor, _
                                           0&, Tipo, Ret, 4)
        End Select
  
End Function

Botón para agregar la aplicación:

Código:

Dim Path_Programa As String
Dim Titulo_Programa As String
Dim Ret As Boolean
  
Path_Programa = App.Path & "\" & App.EXEName & ".exe"
Titulo_Programa = App.Title
  
  
Ret = EstablecerValor(HKEY_LOCAL_MACHINE, _
                     RAMA_RUN_WINDOWS, _
                     Titulo_Programa, _
                     Path_Programa, REG_SZ)
  
'si retorna True es por que creó el dato correctamente
If Ret Then
    MsgBox "En el próximo reinicio el programa iniciará con Windows.", vbInformation
      
      Close #1
Else
    MsgBox "Hubo un error, el programa no puede iniciar con Windows.", vbCritical
End If

Para quitarlo del registro:

Código:

MsgBox ("El programa ya no iniciará con Windows."), vbInformation

Dim Titulo_Programa As String
  
Titulo_Programa = App.Title
  
Call EliminarValor(HKEY_LOCAL_MACHINE, _
                   RAMA_RUN_WINDOWS, _
                   Titulo_Programa)