Título: Donación: Programa para Registrar archivos ActiveX (Krnl64)
Publicado por: Krnl64 en 22 Agosto 2006, 17:53 pm
Cansado de usar Regsvr32.exe para registrar archivos ActiveX ? La solucion la teneis aqui. Os dejo el code de un programa que registra los archivos ActiveX solo arrastrandolos y dandole a un boton. Lo unico que pido es que conserveis las cabeceras.
Option Explicit
Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Any, ByVal wParam As Any, ByVal lParam As Any) As Long Private Declare Function MessageBox Lib "user32" Alias "MessageBoxA" (ByVal hwnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As Long) As Long
Const MB_DEFBUTTON1 = &H0& Const MB_DEFBUTTON2 = &H100& Const MB_DEFBUTTON3 = &H200& Const MB_ICONASTERISK = &H40& Const MB_ICONEXCLAMATION = &H30& Const MB_ICONHAND = &H10& Const MB_ICONINFORMATION = MB_ICONASTERISK Const MB_ICONQUESTION = &H20& Const MB_ICONSTOP = MB_ICONHAND Const MB_OK = &H0& Const MB_OKCANCEL = &H1& Const MB_YESNO = &H4& Const MB_YESNOCANCEL = &H3& Const MB_ABORTRETRYIGNORE = &H2& Const MB_RETRYCANCEL = &H5& Const ERROR_SUCCESS = &H0
Private Sub Command1_Click() Call RegisterServer(Me.hwnd, T.Text, True) End Sub
Private Sub Command2_Click() Call RegisterServer(Me.hwnd, T.Text, False) End Sub
Private Sub Form_Load() Form1.Caption = "DllRegister v1.0 by Krnl64" Command1.Caption = "Registrar" Command2.Caption = "Borrar Registro" End Sub
Private Sub Label2_Click() MessageBox Me.hwnd, " DllRegister registra las DLL's, OCX y Exe ActiveX que lo necesitan. Tan solo arrastre el fichero al cuadro de texto y pulse el boton correspondiente.", "Krnl64 & Demon Industries", MB_ICONASTERISK End Sub
Private Sub T_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single) '-------------------------------------------------------------------------------- ' Componente : Sub OLEDragDrop para Drag & Drop I ' Proyecto : Dll Register ' Descripcion : Colocar nombredelcontrol-(barra baja)-OLEDragDrop ' Created by : Krnl64 & Demon Industries ' Machine : DEMON-LESS ' Date-Time : 23/08/2006-2:20:37 ' Parametros : No hace falta tocarlos . NOTA !!! El control debe soportar Drag & Drop '--------------------------- On Error GoTo f
Dim numFiles As Integer Dim i As Integer Dim a As String numFiles = Data.Files.Count ''Cuenta los archivos a agregar For i = 1 To numFiles GetAttr (Data.Files(i)) 'Se asegura de que el archivo existe a = T.Text If a = Empty Then T.Text = Data.Files(i) '' añade los archivos al textbox Else T.Text = a & vbCrLf + Data.Files(i) '' añade los archivos al textbox + Retorno de carro End If Next Exit Sub f: MessageBox Me.hwnd, "Asegurate de que el archivo(s) existe(n)", "Drag & Drop", MB_ICONSTOP End Sub
Private Sub T_OLEDragOver(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single, State As Integer) '-------------------------------------------------------------------------------- ' Componente : Sub OLEDragOver para Drag & Drop II ' Proyecto : Dll Register ' Descripcion : Colocar nombredelcontrol-(barra baja)-OLEDragOver ' Created by : Krnl64 & Demon Industries ' Machine : DEMON-LESS ' Date-Time : 23/08/2006-2:20:37 ' Parametros : No hace falta tocarlos . NOTA !!! El control debe soportar Drag & Drop '--------------------------- On Error GoTo r
If Data.GetFormat(vbCFFiles) Then '' Ve si se pueden arrastrar los archivos Effect = vbDropEffectCopy '' Icono de arrastre Else Effect = vbDropEffectNone '' En este caso, no se puede arrastrar End If Exit Sub r: MessageBox Me.hwnd, "Error al Arrastrar !!", "Drag & Drop", MB_ICONSTOP End Sub Public Function RegisterServer(hwnd As Long, DllPath As String, Register As Boolean) '-------------------------------------------------------------------------------- ' Componente : Funcion RegisterServer ' Proyecto : Dll Register ' Descripcion : Funcion que registra las Dll's, OCX, EXE ACtiveX, etc ' Created by : Krnl64 & Demon Industries ' Machine : DEMON-LESS ' Date-Time : 23/08/2006-2:44:23 ' Parametros : Hwnd (Handle de la ventana que llama la funcion, DllPath ruta del archivo y Register registrar o no '--------------------------- On Error GoTo e
Dim lb As Long Dim k As Long lb = LoadLibrary(DllPath) '' Cargamos el archivo en memoria
If Register = True Then k = GetProcAddress(lb, "DllRegisterServer") Else k = GetProcAddress(lb, "DllUnregisterServer") End If
If k = Empty Then GoTo e End If
If CallWindowProc(k, hwnd, ByVal 0&, ByVal 0&, ByVal 0&) = ERROR_SUCCESS Then If Register = True Then MessageBox Me.hwnd, "Dll Registrada con éxito", "DLLRegister", MB_ICONASTERISK T.Text = Empty Else MessageBox Me.hwnd, "Dll Desregistrada con éxito", "DLLRegister", MB_ICONASTERISK T.Text = Empty End If Else GoTo e End If FreeLibrary lb ' Descargamos de la memoria el archivo Exit Function e: MessageBox Me.hwnd, "El archivo no puede ser Registrado/Desregistrado o esta dañado.", "DLLRegister", MB_ICONSTOP T.Text = Empty End Function
Espero comentarios Salu2
Título: Re: Donación: Programa para Registrar archivos ActiveX (Krnl64)
Publicado por: Zeroql en 22 Agosto 2006, 20:49 pm
Comentario: el code esta bueno pero cuando se va a realizar la registracion el programa crea un erro y me mata el proceso mismo, Creo que es de mi maquina pero le dare otro vistazo despues.
Título: Re: Donación: Programa para Registrar archivos ActiveX (Krnl64)
Publicado por: Krnl64 en 23 Agosto 2006, 03:43 am
A mi me funciona a la perfeccion.
Checa tu maquina a ver.
Salu2
|