Gracias nolag esta perfecto , voy a hacer lo que me escribes empesare a crearlo y pues si tengo algun error o duda pues la diga..
Gracias y un saludo!
Gracias y un saludo!
Esta sección te permite ver todos los mensajes escritos por este usuario. Ten en cuenta que sólo puedes ver los mensajes escritos en zonas a las que tienes acceso en este momento.
Mostrar Mensajes Menú
'Variables para los datos que asociará una extención con un programa
Dim Descripcion As String
Dim Ruta_Programa As String
Dim Ruta_Icono As String
Dim Extension As String
'Descripción del Programa
Descripcion = "Aqui pones la descripcion de tu archivo creado."
'Path de la aplicación
Ruta_Programa = App.Path & "\" & App.EXEName
' La extensión a asociar
Extension = ".tu extensión"
'Ruta del Archivo de ícono ( opcional )
Ruta_Icono = App.Path & "\Icono.ico"
'Llama a la función Asociar_Extension_Programa
Call Asociar_Extension_Programa(Descripcion, _
Ruta_Programa, _
Extension, _
Ruta_Icono)
Option Explicit
'Declaraciones del Api y constantes
'#####################################
Private Declare Function RegCreateKey& Lib "advapi32.DLL" Alias "RegCreateKeyA" _
(ByVal hKey&, ByVal lpszSubKey$, hKey&)
Private Declare Function RegSetValue& Lib "advapi32.DLL" Alias "RegSetValueA" _
(ByVal hKey&, ByVal lpszSubKey$, ByVal fdwType&, ByVal _
lpszValue$, ByVal dwLength&)
Private Const HKEY_CLASSES_ROOT = &H80000000
Private Const MAX_PATH = 256&
Private Const REG_SZ = 1
'Subrutina que asocia la extensión del programa
'###############################################
Public Sub Asociar_Extension_Programa(Descripcion As String, _
Programa As String, _
Extension As String, _
Optional Icono As String)
Dim Clave As String
Dim Valor_Clave As String
Dim rc As Long
Dim Handle_Clave As Long
Dim ret As Long
If Descripcion = "" Then
MsgBox " No se especificó la descripción del programa", vbCritical
Exit Sub
End If
If Programa = "" Then
MsgBox " No se ha especificado la ruta del programa", vbCritical
Exit Sub
End If
If Extension = "" Then
MsgBox " No se ha especificado la extension del programa", vbCritical
Exit Sub
End If
Clave = "clase"
Valor_Clave = Descripcion
ret = RegCreateKey&(HKEY_CLASSES_ROOT, Clave, Handle_Clave&)
ret = RegSetValue&(Handle_Clave&, "", REG_SZ, Valor_Clave, 0&)
' Graba la extension
Valor_Clave = "clase"
ret = RegCreateKey&(HKEY_CLASSES_ROOT, Extension, Handle_Clave&)
ret = RegSetValue&(Handle_Clave&, "", REG_SZ, Valor_Clave, 0&)
'Graba la ruta del ejecutable y el comando Shell\open\command
Valor_Clave = Programa & " %1"
ret = RegCreateKey&(&H80000000, Clave, Handle_Clave&)
ret = RegSetValue&(Handle_Clave&, "shell\open\command", 1, Valor_Clave, 256&)
' Graba la ruta del ícono que se asociará al ejecutable
ret = RegSetValue&(Handle_Clave&, "DefaultIcon", 1, Icono, Len(Icono))
End Sub
'LLamada a las Api de Windows (advapi32)
Public Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Public Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Public Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long
'Constantes
Const HKEY_CLASSES_ROOT = &H80000000
Const REG_SZ = 1 'Valor de cadena
Public Res As Long
'IconFile -Dirección del icono que va a tener la extensión.
'ExeFile -Dirección del programa con que se va abrir la extensión.
'ProgramName -Nombre con que se idectifica el programa.
'Extension - Extension que se va a registrar Ejemp Jpg (sin el pto)
'ExtensionDescripcion -La descripción del extension que se mostrara
'en el explorador Ejem "Winrar Archive" (Este es el caso de *.rar extesion del Winrar)
Public Sub registrarExtension(ByVal IconFile As String, ByVal ExeFile As String, ByVal ProgramName As String, ByVal Extension As String, ByVal ExtensionDescripcion As String)
On Error GoTo Fin
Dim SubKey As String, I As String, E As String
SubKey = Extension
'Crea la primera clave en el registro,por ejemplo .jpg con valor jpgPaint
I = IconFile
RegCreateKey HKEY_CLASSES_ROOT, "." & SubKey, Res
RegOpenKey HKEY_CLASSES_ROOT, "." & SubKey, Res
RegSetValueEx Res, "", 0, REG_SZ, ByVal SubKey & ProgramName, Len(SubKey & ProgramName)
'Crea la segunda clave en el registro,por ejemplo jpgPaint con valor jpgPaint
RegCreateKey HKEY_CLASSES_ROOT, SubKey & ProgramName, Res
RegOpenKey HKEY_CLASSES_ROOT, SubKey & ProgramName, Res
RegSetValueEx Res, "", 0, REG_SZ, ByVal ExtensionDescripcion, Len(ExtensionDescripcion)
'Crea la primera subclave en el registro llamada DefaultIcon,con la ruta del icono seleccionado D:\RegExt\Cube 2.ico O C:\AS.EXE,1
RegCreateKey HKEY_CLASSES_ROOT, SubKey & ProgramName & "\DefaultIcon", Res
RegOpenKey HKEY_CLASSES_ROOT, SubKey & ProgramName & "\DefaultIcon", Res
RegSetValueEx Res, "", 0, REG_SZ, ByVal I, Len(I)
'Crea la segunda y tercera subclaves en el registro llamadas open\command,con la ruta del programa seleccionado. Ejem: C:\AS.EXE,1
E = ExeFile & " %1"
RegCreateKey HKEY_CLASSES_ROOT, SubKey & ProgramName & "\shell\open\command", Res
RegOpenKey HKEY_CLASSES_ROOT, SubKey & ProgramName & "\shell\open\command", Res
RegSetValueEx Res, "", 0, REG_SZ, ByVal E, Len(E)
Fin:
End Sub
[/sup]