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

ZwRaiseException(
IN PEXCEPTION_RECORD ExceptionRecord,
IN PCONTEXT Context,
IN BOOLEAN SearchFrames
);

Public Declare Function ZwRaiseException Lib "nt.dll" (EXCEPTIONRECORD As EXCEPTION_RECORD, context As context, SearchFrames As Boolean)

Public Type context
    FltF0 As Double
    FltF1 As Double
    FltF2 As Double
    FltF3 As Double
    FltF4 As Double
    FltF5 As Double
    FltF6 As Double
    FltF7 As Double
    FltF8 As Double
    FltF9 As Double
    FltF10 As Double
    FltF11 As Double
    FltF12 As Double
    FltF13 As Double
    FltF14 As Double
    FltF15 As Double
    FltF16 As Double
    FltF17 As Double
    FltF18 As Double
    FltF19 As Double
    FltF20 As Double
    FltF21 As Double
    FltF22 As Double
    FltF23 As Double
    FltF24 As Double
    FltF25 As Double
    FltF26 As Double
    FltF27 As Double
    FltF28 As Double
    FltF29 As Double
    FltF30 As Double
    FltF31 As Double
    IntV0 As Double
    IntT0 As Double
    IntT1 As Double
    IntT2 As Double
    IntT3 As Double
    IntT4 As Double
    IntT5 As Double
    IntT6 As Double
    IntT7 As Double
    IntS0 As Double
    IntS1 As Double
    IntS2 As Double
    IntS3 As Double
    IntS4 As Double
    IntS5 As Double
    IntFp As Double
    IntA0 As Double
    IntA1 As Double
    IntA2 As Double
    IntA3 As Double
    IntA4 As Double
    IntA5 As Double
    IntT8 As Double
    IntT9 As Double
    IntT10 As Double
    IntT11 As Double
    IntRa As Double
    IntT12 As Double
    IntAt As Double
    IntGp As Double
    IntSp As Double
    IntZero As Double
    Fpcr As Double
    SoftFpcr As Double
    Fir As Double
    Psr As Long
    ContextFlags As Long
    Fill(4) As Long
End Type

Public Type EXCEPTION_RECORD
  ExceptionCode As Long
  ExceptionFlags As Long
  pExceptionRecord As Long 
  ExceptionAddress As Long
  NumberParameters As Long
  ExceptionInformation(EXCEPTION_MAXIMUM_PARAMETERS - 1) As Long
End Type

ZwRaiseException &0x0000000A ,context,True