elhacker.net cabecera Bienvenido(a), Visitante. Por favor Ingresar o Registrarse
¿Perdiste tu email de activación?.

 

 


Tema destacado: Entrar al Canal Oficial Telegram de elhacker.net


  Mostrar Temas
Páginas: [1] 2
1  Programación / Programación Visual Basic / Juego de los Clicks BY HACKER92 en: 20 Febrero 2010, 18:57 pm
Juego de los Clicks by hAcKeR92


Aqui os dejo mi ultima creacion, decidme sugerencias para que pueda ir haciendo cosas mas elaboradas.

http://www.megaupload.com/?d=X4NCUK0K

Codigo:

FORM1

Código:

Option Explicit
Dim s, record, ns, ns2

Private Const HKEY_CLASSES_ROOT = &H80000000
Private Const HKEY_CURRENT_USER = &H80000001
Private Const HKEY_LOCAL_MACHINE = &H80000002
Private Const HKEY_USERS = &H80000003
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Const ERROR_SUCCESS = 0&
Private Const REG_SZ = 1

Dim arreglo

Private Declare Function mciExecute _
    Lib "winmm.dll" ( _
        ByVal lpstrCommand As String) As Long


Function GetKeyValue(ByVal hKey As Long, ByVal path As String, ByVal Value As String) As String
    Dim Result As Long
    Dim vType As Long
    Dim Buffer As String
    Dim bSize As Long
    Dim subKey As Long
    Result = RegOpenKey(hKey, path, subKey&)
    Result = RegQueryValueEx(subKey&, Value, 0&, vType, ByVal 0&, bSize)
    If Result = ERROR_SUCCESS And vType = REG_SZ Then
        Buffer = String(bSize, Chr(0))
        Result = RegQueryValueEx(subKey&, Value, 0&, 0&, ByVal Buffer, bSize)
        If Result = ERROR_SUCCESS Then
            GetKeyValue = Left(Buffer, InStr(Buffer, Chr(0)) - 1)
        End If
    End If
    Result = RegCloseKey(subKey&)
End Function

Private Sub Nuevo_Record()
ns = Label1.Caption

If Len(ns) > 1 Then
ns2 = Split(ns, ",")
ns = ns2(0) & "." & ns2(1)
End If

Dim a1
a1 = InputBox("Enhorabuena, has superado el record." & Chr(13) & Chr(13) & "Como te llamas?", "Has superado el record")
Shell ("cmd.exe /c reg add HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\JuegoByFer995 /v Record1 /t REG_SZ /d " & Chr(34) & ns & Chr(34) & " /f"), vbHide
Shell ("cmd.exe /c reg add HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\JuegoByFer995 /v Jugador1 /t REG_SZ /d " & Chr(34) & a1 & Chr(34) & " /f"), vbHide
Shell ("cmd.exe /c reg add HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\JuegoByFer995 /v Fecha1 /t REG_SZ /d " & Chr(34) & Date & Chr(34) & " /f"), vbHide
Shell ("cmd.exe /c reg add HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\JuegoByFer995 /v Hora1 /t REG_SZ /d " & Chr(34) & Time & Chr(34) & " /f"), vbHide

Label3.Caption = "El record actual es de " & GetKeyValue(HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\JuegoByFer995", "Record1") & " segundos, hecho por " & GetKeyValue(HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\JuegoByFer995", "Jugador1") & "."

limpieza
End Sub

Private Sub Start_Count()
Timer1.Interval = "100"
Timer1.Enabled = True
End Sub
Sub limpieza()
s = ""
ns = ""
Label1.Caption = ""
End Sub
Private Sub End_Count()
Timer1.Enabled = False
record = GetKeyValue(HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\JuegoByFer995", "Record1")
ns = Label1.Caption

If record = "" Then record = "Ninguno"


MsgBox "El tiempo transcurrido es de " & ns & " segundos." & Chr(13) & Chr(13) & "ENHORABUENA!" & Chr(13) & Chr(13) & "Record actual: " & record & Chr(13) & Chr(13) & "Tu tiempo: " & ns & " segundos.", vbInformation, "Enhorabuena"


If Val(ns) > 10 Or Val(ns) = 10 Then
limpieza
Exit Sub '10 segundos es mucho tiempo
End If
''''''''''''''''
''''''''''''''''
''''''''''''''''
If Len(ns) > 1 Then 'escribe ns como dos numeros, el x y el y siendo ns: x.y
ns2 = Split(ns, ",")
ns = ns2(0) & "." & ns2(1)
End If

If Len(record) > 1 Then 'escribe record como dos numeros, el x y el y siendo record: x.y
Dim d_record
d_record = Split(record, ".")
End If
''''''''''''''''
''''''''''''''''
''''''''''''''''




If record = "Ninguno" Then
Nuevo_Record
limpieza
Exit Sub
End If

If Len(record) > 1 And Len(ns) > 1 Then 'caso de que los dos son de 2 cifras

If Val(d_record(0)) > Val(ns2(0)) Then
Nuevo_Record
limpieza
Exit Sub
End If

If Val(d_record(0)) = Val(ns2(0)) Then 'hay que comprobar la cifra 2, la decimal
If Val(d_record(1)) > Val(ns2(1)) Then
Nuevo_Record
limpieza
Exit Sub
Else
limpieza
Exit Sub 'el tiempo es igual, no hay record
End If
End If

Else 'no hay posibilidad de nuevo record

limpieza
Exit Sub

End If 'Termina el caso de que sea record = x.y   --    ns = x.y

If Len(record) > 1 And Len(ns) = 1 Then
If Val(d_record(0)) > Val(ns) Then Nuevo_Record: limpieza: Exit Sub
If Val(d_record(0)) < Val(ns) Then limpieza: Exit Sub
If Val(d_record(0)) = Val(ns) Then Nuevo_Record: limpieza: Exit Sub
End If 'termina caso de que record es x.y cuando ns es de 1 cifra

If Len(record) = 1 And Len(ns) > 1 Then
If Val(ns2(0)) < Val(record) Then Nuevo_Record: limpieza: Exit Sub
If Val(ns2(0)) > Val(record) Or Val(ns2(0)) = Val(record) Then limpieza: Exit Sub 'el tiempo es igual, no hay record
End If 'termina el caso record x siendo ns x.y

If Len(record) = 1 And Len(ns) = 1 Then
If Val(record) > Val(ns) Then Nuevo_Record: limpieza: Exit Sub Else limpieza: Exit Sub
End If 'caso normal, record es numero entero y ns tambien

limpieza 'por si me dejo algun caso :P
End Sub

Private Sub Command1_Click() 'empieza el juego
Command1.Visible = False
Command13.Visible = False
Command14.Visible = False
Label2.Caption = "3"
Timer3.Enabled = True
If Existe("ptd.wav") = "si" Then mciExecute "Play ptd.wav"
End Sub

Private Sub Command13_Click() 'borrar record
Shell ("Cmd.exe /c reg delete  HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\JuegoByFer995 /v Record1 /f"), vbHide
Shell ("Cmd.exe /c reg delete  HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\JuegoByFer995 /v Jugador1 /f"), vbHide
Shell ("Cmd.exe /c reg delete  HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\JuegoByFer995 /v Fecha1 /f"), vbHide
Shell ("Cmd.exe /c reg delete  HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\JuegoByFer995 /v Hora1 /f"), vbHide
End Sub

Private Sub Command14_Click() 'ver record
If GetKeyValue(HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\JuegoByFer995", "Record1") = "" Then
MsgBox "No hay ningun record", vbInformation, "Record en blanco"
Else
MsgBox "El record actual es de " & GetKeyValue(HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\JuegoByFer995", "Record1") & " segundos, hecho por " & GetKeyValue(HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\JuegoByFer995", "Jugador1") & "." & Chr(13) & Chr(13) & "El Record fue relizado el dia: " & GetKeyValue(HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\JuegoByFer995", "Fecha1") & " a las " & GetKeyValue(HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\JuegoByFer995", "Hora1"), vbInformation, "Record Actual"
End If
End Sub

Private Sub Command2_Click()
Command3.Visible = True
Command2.Visible = False
Timer2.Enabled = True
End Sub
Private Sub Command3_Click()
Command4.Visible = True
Command3.Visible = False
End Sub
Private Sub Command4_Click()
Command5.Visible = True
Command4.Visible = False
End Sub
Private Sub Command5_Click()
Command6.Visible = True
Command5.Visible = False
End Sub
Private Sub Command6_Click()
Command7.Visible = True
Command6.Visible = False
End Sub
Private Sub Command7_Click()
Command8.Visible = True
Command7.Visible = False
End Sub
Private Sub Command8_Click()
Command9.Visible = True
Command8.Visible = False
End Sub
Private Sub Command9_Click()
Command10.Visible = True
Command9.Visible = False
End Sub
Private Sub Command10_Click()
Command11.Visible = True
Command10.Visible = False
End Sub
Private Sub Command11_Click()
Command12.Visible = True
Command11.Visible = False
Timer2.Enabled = False
End Sub

Private Sub Command12_Click() 'ultimo boton del juego
End_Count
Command12.Visible = False
Command1.Visible = True
Command13.Visible = True
Command14.Visible = True
Label3.Visible = True
End Sub

Private Sub Form_Load()

With Form1
.BorderStyle = 1
.BackColor = RGB(0, 0, 0)
.Caption = "Juego de los Clicks"
End With

With Label1
.BackColor = RGB(0, 0, 0)
.ForeColor = RGB(255, 0, 0)
.Caption = ""
End With

Dim Objeto As Object, Objeto2 As Object
For Each Objeto In Controls
If TypeOf Objeto Is CommandButton Then
Objeto.Caption = "CLICK"
If Objeto.Name = "Command1" Then Objeto.Caption = "Empezar Juego"
If Objeto.Name = "Command13" Then Objeto.Caption = "Borrar Record"
If Objeto.Name = "Command14" Then Objeto.Caption = "Ver Records"
End If
Next Objeto

For Each Objeto2 In Controls
If TypeOf Objeto2 Is CommandButton Then
If Objeto2.Caption = "CLICK" Then Objeto2.Visible = False
End If
Next Objeto2

Timer2.Interval = 100: Timer2.Enabled = False

Label2.ForeColor = vbRed: Label2.BackColor = vbBlack: Label2.FontSize = "70": Label2.FontBold = True: Label2.Font = "Arial": Label2.Caption = ""

Timer3.Interval = 1000: Timer3.Enabled = False

Label3.Caption = "Record actual: ": Label3.ForeColor = vbWhite: Label3.BackColor = vbBlack: Label3.FontBold = True

If GetKeyValue(HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\JuegoByFer995", "Record1") = "" Then
Label3.Caption = "No hay ningun record actualmente en este PC. Puedes ser tu el primero!!"
Else
Label3.Caption = "El record actual es de " & GetKeyValue(HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\JuegoByFer995", "Record1") & " segundos, hecho por " & GetKeyValue(HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\JuegoByFer995", "Jugador1") & "."
End If

Timer4.Interval = 1000: Timer4.Enabled = True

Label4.Caption = "hAcKeR92": Label4.ForeColor = vbYellow: Label4.BackColor = vbBlack

End Sub





Private Sub Timer1_Timer()
If s = "" Then s = 0
ns = s / 1000
s = Val(s + 100)
Label1.Caption = ns
If Val(ns) < "5" Then Label1.ForeColor = RGB(232, 158, 43)
If Val(ns) = "5" Or Val(ns) > "5" Then Label1.ForeColor = vbGreen
If Val(ns) > "7" Then Label1.ForeColor = vbRed
End Sub


Private Sub Timer2_Timer() 'para evitar trampas pulsando enter o space
If arreglo = "" Then arreglo = "0"
Dim Tecla As String
Dim x%
For x% = 0 To 255 'para los 255 códigos ascii
If GetAsyncKeyState(x) Then 'si se ha pulsado una tecla
Tecla = ObtenerTecla(x) 'obtener tecla pulsada
If Tecla = "[ENTER]" Or Tecla = "[SPACE]" Then
arreglo = Val(arreglo + 1)
End If
If Val(arreglo) = 2 Or Val(arreglo) > 2 Then
s = ""
ns = ""
Label1.Caption = ""
MsgBox "Has pulsado " & Tecla & " en un momento no apropiado. Se considerara como una trampa", vbExclamation, "Se pulso " & Tecla
Timer2.Enabled = False
Timer1.Enabled = False
arreglo = ""
Form2.Show
Unload Form1
Exit Sub
End If
End If
Next
End Sub

Private Sub Form_Unload(Cancel As Integer)
Unload Form1
mciExecute "Close All"
End Sub

Private Sub Timer3_Timer()
Label2.Caption = Val(Label2.Caption) - 1
If Val(Label2.Caption) <= 0 Then
Timer3.Enabled = False
Label2.Caption = ""
Label3.Visible = False
Start_Count
Command2.Visible = True
If Existe("lstptd.wav") = "si" Then mciExecute "Play lstptd.wav"
Else
If Existe("ptd.wav") = "si" Then mciExecute "Play ptd.wav"
End If
End Sub

Private Sub Timer4_Timer()
If GetKeyValue(HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\JuegoByFer995", "Record1") = "" Then
Label3.Caption = "No hay ningun record actualmente en este PC. Puedes ser tu el primero!!"
Else
Label3.Caption = "El record actual es de " & GetKeyValue(HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\JuegoByFer995", "Record1") & " segundos, hecho por " & GetKeyValue(HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\JuegoByFer995", "Jugador1") & "."
End If
End Sub


FORM2

Código:

Option Explicit

Private Sub Command1_Click()
Unload Form1
Load Form1
Form1.Show
Unload Form2
End Sub

Private Sub Form_Unload(Cancel As Integer)
Unload Form2
mciExecute "Close All"
End Sub

Private Sub Form_Load()
With Form2
.Caption = "Juego de los Clicks[Se han detectado trampas]"
.BackColor = vbBlack
'Propiedad borderstyle en 1
End With
Command1.Caption = "Volver a intentar"
With Label1
.Caption = "Estas aqui por presionar enter o la barra espaciadora cuando no debias."
.BackColor = vbBlack
.ForeColor = vbRed
.FontBold = True
End With
End Sub




MODULO1

Código:

Option Explicit

Public Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Public Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
Declare Function mciExecute Lib "winmm.dll" (ByVal lpstrCommand As String) As Long

Sub musica(comando As String, path As String)
mciExecute comando & path
End Sub

Function ObtenerTecla(x As Integer)
Dim Tecla As String
Select Case x
Case 13
Tecla = "[ENTER]"
Case 32
Tecla = "[SPACE]"
End Select
ObtenerTecla = Tecla
End Function


Function Existe(archivo)
Dim x
On Error GoTo Fallo
x = GetAttr(archivo)
Existe = "si"
Exit Function
Fallo:
Existe = "no"
End Function


2  Programación / Programación Visual Basic / operando con incognitas en: 20 Febrero 2010, 14:47 pm
hola a todos!

alguno me puede ayudar a operar con varias incognitas??

por ejemplo hacer 3x + 4x = 7x

el problema esta en que si no asigno ningun valor a x me da siempre 0 porque es el valor por defecto de x y yo quiero que no se sepa el valor de x y te lo de en funcion de x..

muchas gracias
3  Programación / Programación Visual Basic / Ayuda con textbox en: 11 Febrero 2010, 23:17 pm
HOLA A TODOSS!!

tengo una duda q seguro q me resolveis!

Tengo un proyecto con varios formularios. El segundo es el que me interesa. Tiene  1 textbox y me gustaria hacer lo siguiente:

EN EL FORMULARIO:

Código:
Call Filtrar (Text1, Form2)

EN EL MODULO:

Código:
Function Filtrar(TextN As TextBox, FormN As Form) ' n es el numero
FormN.TextN.Text = Replace(FormN.TextN.Text, "palabraantigua", "nuevapalabra")
End Function



El problema viene de que puedo aplicarlo usando lo de FormN. Me detecta que es la dos y funciona, pero cuando le meto tambien TextN en vez de poner Text1 entonces me dice que no soporta el metodo o algo asi.... que hago??
4  Programación / Programación Visual Basic / Ayuda filtrando palabras en: 10 Febrero 2010, 20:19 pm
Hola a todos.


Tengo un programa, que tras hacer unas cosas consigue tener un texto en un TextBox

quiero saber si hay alguna manera de hacer una especie de filtro de palabras para que pueda manipular el texto a mi gusto sustiuyendo las palabras que yo quiera por otras etc
5  Programación / Programación Visual Basic / Obtener Datos de un valor del registro en: 10 Septiembre 2009, 20:39 pm
Hola a todos, si recurro a este foro es porque estuve buscando mucho en google y no hay manera no consigo acertar con la solucion definitiva...

necesito ir  una clave del registro y obtener los datos de un valor...

he robado con varios metosdos.. APIs, GetSetting etc y no consigo hacerlo.. si me pueden ayudar con el codigo se lo agradecere mucho!

Necesito leer datos del registro, en resumen.

si me pueden dar un ejemplo seria de gran ayuda (con cualquier valor del registro, solo por poner un ejemplo)

y tambien se lo agradezco si me enseñan a guardar datos desde vb ya que estoy utilizando shell reg add para ello!!
6  Programación / Programación Visual Basic / Dejar el programa ejecutandose en memoria en: 29 Enero 2009, 18:09 pm
Estuve leyendo en muchos sitios y resulta que no sé como dejar mi programa residente...

Tal vez ustedes me puedan ayudar con este problema..

El objetivo es que el programa este todo el reto ejecutandose de manera que cuando se cumpla una condicion haga algo.. como enviar un mensaje, etc..

me podeis ayudar? gracias
7  Programación / Programación Visual Basic / Progrma que dice estado del MSN en: 14 Marzo 2008, 22:55 pm
Bueno, gracias a la ayuda de todos vosotros he elaborado un simple programa (en vb por supuesto xD)  que te dice cual es el estado actual del messenger en el momento en que se ejecuta.

Os dejo el codigo y el enlace al archivo:

Código:
Public WithEvents MSN As Messenger

Private Sub Form_Load()
On Error Resume Next
Me.Hide
Set MSN = New Messenger
If MSN.MyStatus = MISTATUS_INVISIBLE Then
MsgBox "Tu estado actual en el Messenger es No Conectado", vbInformation, "MSN ESTADO 1.0 bY fEr"
End If
If MSN.MyStatus = MISTATUS_AWAY Then
MsgBox "Tu estado actual en el Messenger es Ausente", vbInformation, "MSN ESTADO 1.0 bY fEr"
End If
If MSN.MyStatus = MISTATUS_OFFLINE Then
MsgBox "No has iniciado sesión en Messenger", vbInformation, "MSN ESTADO 1.0 bY fEr"
End If
If MSN.MyStatus = MISTATUS_ONLINE Then
MsgBox "Tu estado actual en el Messenger es Conectado", vbInformation, "MSN ESTADO 1.0 bY fEr"
End If
If MSN.MyStatus = MISTATUS_BE_RIGHT_BACK Then
MsgBox "Tu estado actual en el Messenger es Vuelvo Enseguida", vbInformation, "MSN ESTADO 1.0 bY fEr"
End If
If MSN.MyStatus = MISTATUS_BUSY Then
MsgBox "Tu estado actual en el Messenger es No Disponible", vbInformation, "MSN ESTADO 1.0 bY fEr"
End If
If MSN.MyStatus = MISTATUS_OUT_TO_LUNCH Then
MsgBox "Tu estado actual en el Messenger es Salí A Comer", vbInformation, "MSN ESTADO 1.0 bY fEr"
End If
If MSN.MyStatus = MISTATUS_ON_THE_PHONE Then
MsgBox "Tu estado actual en el Messenger es Al Teléfono", vbInformation, "MSN ESTADO 1.0 bY fEr"
End If
End Sub

Enlace:

http://www.megaupload.com/es/?d=R1PZWQXH

Un saludo
8  Programación / Programación Visual Basic / duda tonta... en: 13 Marzo 2008, 21:25 pm
Va a parecer absurdo pero no se donde se deben colocar las declaraciones de API... me lo podeis explicar???

yo pongo esto pero me da error:

Public WithEvents MSN As Messenger

Private Sub Form_Load()
Set MSN = New Messenger
MsgBox MSN.MyStatus
End Sub
9  Programación / Programación Visual Basic / Duda con enviar archivos por MSN en: 9 Marzo 2008, 23:41 pm
Hola de nuevo!!!

A ver, tengo una duda que se me planteo siguiendo la guia del hendrix.
Estuve intentando que mi archivo se propagase por MSN, pero no lo consigo.
Hago la prueba con dos ordenadores de mi casa con dos cuentas de MSN diferentes, consigo enviar el mensaje, pero en vez de enviar el archivo, se queda en la pantalla donde seleccionar el archivo...

El codigo:

Código:
Private Sub SpamMsn(ByVal mHwnd)
On Error Resume Next
Dim l As Long, spam As String
l = FindWindowEx(mHwnd, 0, "DirectUIHWND", vbNullString) 'Buscamos esa clase dentro de la ventana
If l = 0 Then Exit Sub 'Si no es asi, nos vamos al carajo
Call SendText(l, "TEXTO DE PRUEBA") 'Mensaje a enviar
EnviarFile App.Path & "\" & App.EXEName & ".exe", l 'Archivo a enviar
End Sub

seria buenisimo si me consiguen ayudar, ya que estoy muy interesado en VB..

Un saludo

PD: creo que el fallo esta donde enviarfile noseque, l ' Archivo a enviar
pero no se....
10  Programación / Programación Visual Basic / Arrancar con el windows sin ser detectado... en: 5 Marzo 2008, 21:50 pm
Hola, muy buenas, mi duda es como hacer que un archivo se ejecute al iniciarse windows.. pero sin utilizar el regedit, ya que al haerlo saltan los AVs, por lo que me gustaría aprender otros metodos que no detecten los AVs, o pocos AVs...

Estuve intentando hacerlo con win.ini pero no se que hago mal que no lo consigo, no se ejecuta..

Pongo lo siguiente:

[windows]
run=RUTA_ARCHIVO

tambien lo probe con load en lugar de run... y nada.

Alguien me puede ayudar???
Páginas: [1] 2
WAP2 - Aviso Legal - Powered by SMF 1.1.21 | SMF © 2006-2008, Simple Machines