Donación: Programa para Registrar archivos ActiveX (Krnl64)

[Krnl64]

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.

Código [Seleccionar] Expandir


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

[Zeroql]

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.

[Krnl64]

A mi me funciona a la perfeccion.

Checa tu maquina a ver.

Salu2