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