VB实现HOOK!VB无DLL Hook  API

这篇程序让你实现VB HOOK 的实现,也让你做一些VC等其他语言才能做的事情.不过目前还不是很完善还有待修改,目前还只能注入到EXPLORER.EXE和VB写的程序中.什么原因目前还不知道.由于我不懂汇编,而且目前还在出差就没有多的时间来研究,这个问题就等高手来解决好造福广大VB爱好者吧!


modHookInfo 模块 核心HOOK模块注意这个程序中不能使用类

Attribute VB_Name = "modHookInfo"
Private Declare Function MessageBoxA Lib "user32" (ByVal hwnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As Long) As Long
Private Declare Function MessageBoxW Lib "user32" (ByVal hwnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As Long) As Long
Private Declare Function WriteProcessMemory Lib "kernel32" (ByVal hProcess As Long, lpBaseAddress As Any, lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length 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 LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long
Private Declare Function GetCurrentProcessId Lib "kernel32" () As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Const PROCESS_QUERY_INFORMATION As Long = (&H400)

Private Const STANDARD_RIGHTS_REQUIRED As Long = &HF0000

Private Const SYNCHRONIZE As Long = &H100000

Private Const PROCESS_ALL_ACCESS As Long = (STANDARD_RIGHTS_REQUIRED or SYNCHRONIZE or &HFFF)

Private mbytOldCode(5) As Byte
Private mbytNewCode(5) As Byte
Private mlngFunAddr As Long

Private mhProcess As Long

Public Function HookApi(ByVal strDllName As String, ByVal strFunName As String, ByVal lngFunAddr As Long, ByVal hProcess As Long) As Boolean
     Dim hModule As Long, dwJmpAddr As Long
     mhProcess = hProcess
     hModule = LoadLibrary(strDllName)
     If hModule = 0 Then
         HookApi = False
         Exit Function
     End If
     mlngFunAddr = GetProcAddress(hModule, strFunName)
     If mlngFunAddr = 0 Then
         HookApi = False
         Exit Function
     End If
     CopyMemory mbytOldCode(0), ByVal mlngFunAddr, 6
     Debug.Print mbytOldCode(0); mbytOldCode(1); mbytOldCode(2); mbytOldCode(3); mbytOldCode(4)
     mbytNewCode(0) = &HE9
     dwJmpAddr = lngFunAddr - mlngFunAddr - 5
     CopyMemory mbytNewCode(1), dwJmpAddr, 4
     Debug.Print mbytNewCode(0); mbytNewCode(1); mbytNewCode(2); mbytNewCode(3); mbytNewCode(4)
     HookStatus True
     HookApi = True
End Function

Public Function HookStatus(ByVal blnIsHook As Boolean) As Boolean
     If blnIsHook Then
        If WriteProcessMemory(mhProcess, ByVal mlngFunAddr, mbytNewCode(0), 5, 0) <> 0 Then HookStatus = False '拦截
     Else
         If WriteProcessMemory(mhProcess, ByVal mlngFunAddr, mbytOldCode(0), 5, 0) <> 0 Then HookStatus = False '恢复
     End If
End Function

Private Sub Class_Initialize()
'     mhProcess = OpenProcess(PROCESS_ALL_ACCESS, 0, GetCurrentProcessId)
End Sub

Private Sub Class_Terminate()
     HookStatus False
'     CloseHandle mhProcess
End Sub


Attribute VB_Name = "modHookMain"

Option Explicit
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function VirtualAllocEx Lib "kernel32" (ByVal hProcess As Long, ByVal lpAddress As Long, ByVal dwnSize As Long, ByVal flAllocationType As Long, ByVal flProtect As Long) As Long
Private Declare Function VirtualFreeEx Lib "kernel32" (ByVal hProcess As Long, lpAddress As Any, ByVal dwnSize As Long, ByVal dwFreeType As Long) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
Private Declare Function GetProcAddress Lib "kernel32" (ByVal hhMod As Long, ByVal lpProcName As String) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As Any, ByVal lpWindowName As Any) As Long
Private Declare Function CreateRemoteThread Lib "kernel32" (ByVal hProcess As Long, lpThreadAttributes As Long, ByVal dwStacknSize As Long, lpStartAddress As Long, lpParameter As Any, ByVal dwCreationFlags As Long, lpthreadid As Long) As Long
Private Declare Function GetModuleHandleA Lib "kernel32" (ByVal ModName As Any) As Long
Private Declare Function WriteProcessMemory Lib "kernel32" (ByVal hProcess As Long, lpBaseAddress As Any, lpBuffer As Any, ByVal nnSize As Long, lpNumberOflngBytesWritten As Long) As Long
Private Declare Function ReadProcessMemory Lib "kernel32" (ByVal hProcess As Long, lpBaseAddress As Any, lpBuffer As Any, ByVal nnSize As Long, lpNumberOflngBytesWritten As Long) As Long
Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Any, ByVal wParam As Any, ByVal lParam As Any) As Long
Private 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
Private Declare Function DeleteFile Lib "kernel32" Alias "DeleteFileA" (ByVal lpFileName As String) As Long
Private Declare Function GetModuleFileName Lib "kernel32" Alias "GetModuleFileNameA" (ByVal hhMod As Integer, ByVal lpFileName As String, ByVal nnSize As Integer) As Integer
Private Declare Function GetCurrentProcessId Lib "kernel32" () As Long
Private Declare Sub ExitProcess Lib "kernel32" (ByVal dwExitCode As Long)
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

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

Private Type IMAGE_DATA_DIRECTORY
     VirtualAddress As Long
     Size As Long
End Type

Private 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

Private 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
     nSizeOfStackReserve As Long
     SizeOfStackCommit As Long
     SizeOfHeapReserve As Long
     SizeOfHeapCommit As Long
     LoaerFlags As Long
     NumberOfRvaAndnSizes As Long
     DataDirectory(IMAGE_NUMBEROF_DIRECTIRY_ENRIES - 1) As IMAGE_DATA_DIRECTORY
End Type

Private 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
Private Const szTarget As String = "ProgMan"
Private szFileName As String * 261

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 Type CLIENT_ID
     UniqueProcess As Long
     UniqueThread   As Long
End Type

Private Declare Function NtOpenProcess Lib "NTDLL.DLL" (ByRef hProcess As Long, ByVal AccessMask As Long, ByRef ObjectAttributes As OBJECT_ATTRIBUTES, ByRef CliendwThreadId As CLIENT_ID) As Long
Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As String) As Long
Private Declare Function lstrcpyn Lib "kernel32" Alias "lstrcpynA" (ByVal lpString1 As String, ByVal lpString2 As String, ByVal iMaxLength As Long) As Long
Private mProcess As Long
Private mlnghWnd As Long
Private mdwProcessId As Long
Private Type MYTYPE
     strName As String * 260
     hwnd As Long
     dwProcessId As Long
End Type
Private pInfo As MYTYPE

Private Sub Main()
     ' Sub that will start when the program is run
     Dim dwProcessId As Long, hProcess As Long
     Dim nSize As Long, lngBytesWritten As Long, dwThreadId As Long, hMod As Long, hNewMod As Long
     Dim objPImageOptionalHeader As IMAGE_OPTIONAL_HEADER32, objPImageDosHeader As IMAGE_DOS_HEADER, objTImageFileHeader As IMAGE_FILE_HEADER
     Dim lngExeVariable As Long

     frmMain.Show
     ' Get the EXE name
     GetModuleFileName 0, szFileName, 261
     pInfo.hwnd = frmMain.hwnd
     pInfo.strName = szFileName
     pInfo.dwProcessId = GetCurrentProcessId
     ' Get the dwProcessId of the program. Note that it must be running in memory (open it)
     GetWindowThreadProcessId FindWindow(0&, "测试程序"), dwProcessId
     'GetWindowThreadProcessId FindWindow(szTarget, 0&), dwProcessId

     ' Open the process and give us full access, we need this to hijack it
     hProcess = OpenProcess(PROCESS_ALL_ACCESS, 0, dwProcessId)
     If hProcess = 0 Then End
     ' Get the memory location of where our code starts in memory, this will correspond to the /BASE: switch that you put in the linker options using compile controller
     hMod = GetModuleHandleA(vbNullString)
     If hMod = 0 Then End
     ' Load the code's header into the DosHeader Type
     CopyMemory objPImageDosHeader, ByVal hMod, Len(objPImageDosHeader)
    
     ' e_lfanew is the starting address of the PE Header in memory. Add this value to the length of the fileheader as well as to the length of the optional header
     ' These headers are the founding blocks of any executable file, wether in memory or on disk.
     CopyMemory objPImageOptionalHeader, ByVal (hMod + objPImageDosHeader.e_lfanew + 4 + Len(objTImageFileHeader)), Len(objPImageOptionalHeader)
    
     ' After adding all those lengths, we will get the final nSize of the executable in memory, this is usually a bit more then the nSize on disk
     nSize = objPImageOptionalHeader.SizeOfImage
     If nSize = 0 Then End
     ' Just to make sure, free the memory in the program at the location of our exe
     VirtualFreeEx hProcess, hMod, 0, MEM_RELEASE
    
     ' Allocate the nSize of our exe in memory of the program, at the location of where our exe is in memory
     hNewMod = VirtualAllocEx(hProcess, hMod, nSize, MEM_RESERVE or MEM_COMMIT, PAGE_EXECUTE_READWRITE)
     If hNewMod = 0 Then End
  
     ' Copy our exe into program's memory
     If WriteProcessMemory(hProcess, ByVal hNewMod, ByVal hMod, nSize, lngBytesWritten) = 0 Then End

     ' Copy the EXE name
     lngExeVariable = VirtualAllocEx(hProcess, 0, Len(pInfo), MEM_RESERVE or MEM_COMMIT, PAGE_EXECUTE_READWRITE)
    
     'lngExeVariable = VirtualAllocEx(hProcess, 0, 261, MEM_RESERVE or MEM_COMMIT, PAGE_EXECUTE_READWRITE)
     If lngExeVariable = 0 Then End
    
     If WriteProcessMemory(hProcess, ByVal lngExeVariable, pInfo, Len(pInfo), lngBytesWritten) = 0 Then End
     'If WriteProcessMemory(hProcess, ByVal lngExeVariable, szFileName, 261, lngBytesWritten) = 0 Then End
     '*************************************************************************
     ''这里要做下判断如果是注入非VB程序得拷贝VB库如果是VB程序则不需要下面代码
     ' Copy VB Runtime to EXE memory (same code as to copy our EXE, so I won't comment it again.
'     Dim hVBMod As Long, lngVBnSize As Long, hVBNewMod As Long
'     hVBMod = GetModuleHandleA("msvbvm60.dll")
'     If hVBMod = 0 Then End
'     CopyMemory objPImageDosHeader, ByVal hVBMod, Len(objPImageDosHeader)
'     CopyMemory objPImageOptionalHeader, ByVal (hVBMod + objPImageDosHeader.e_lfanew + 4 + Len(objTImageFileHeader)), Len(objPImageOptionalHeader)
'     lngVBnSize = objPImageOptionalHeader.SizeOfImage
'     hVBNewMod = VirtualAllocEx(hProcess, hVBMod, lngVBnSize, MEM_RESERVE or MEM_COMMIT, PAGE_EXECUTE_READWRITE)
'     If hVBNewMod = 0 Then End
'     If WriteProcessMemory(hProcess, ByVal hVBNewMod, ByVal hVBMod, lngVBnSize, lngBytesWritten) = 0 Then End
     '**************************************************************************
     ' Create our remote thread
     If CreateRemoteThread(hProcess, ByVal 0, 0, ByVal GetFunAddr(AddressOf RemoteFunAdd), ByVal lngExeVariable, 0, dwThreadId) = 0 Then End
    
     'ExitProcess 0
End Sub

Public Function GetFunAddr(ByVal lngEntrypoint As Long) As Long
     GetFunAddr = lngEntrypoint
End Function

Public Function RemoteFunAdd(ByVal hAddr As Long) As Long ' Code that will run in the hijacked program - CANNOT USE MOST VB INTRISTIC FUNCTIONS -
     ' Call our hMod with full access to VB functions, any other code here needs to be extremly basic (not even left/mid etc)
     HookMain hAddr
End Function

Private Function HookMain(ByVal lngAgs As Long) As Long
     Dim szExename As String * 261, lnglngBytesWritten As Long
     'ReadProcessMemory OpenProcess(PROCESS_ALL_ACCESS, 0, GetCurrentProcessId), ByVal lngAgs, ByVal szExename, 261, ByVal lnglngBytesWritten
     'MessageBox 0, "成功HOOK", szExename, 0
     Dim mInfo As MYTYPE, nSize As Long
     CopyMemory mInfo, ByVal lngAgs, Len(mInfo)
     nSize = lstrlen(mInfo.strName)
     If nSize <> 0 Then
         nSize = nSize + 1
         Call lstrcpyn(szExename, mInfo.strName, nSize)
     Else
         szExename = mInfo.strName
     End If
     mdwProcessId = mInfo.dwProcessId
'     MessageBox 0, mInfo.hWnd, szExename, 0
     mProcess = OpenProcess(PROCESS_ALL_ACCESS, 0, GetCurrentProcessId)
'     GetWindowThreadProcessId mInfo.hWnd, mdwProcessId
     MessageBox 0, szExename, mInfo.dwProcessId, 0
     HookApi "ntdll", "NtOpenProcess", GetFunAddr(AddressOf NtOpenProcessCallback), mProcess
End Function

Private Function NtOpenProcessCallback(ByRef hProcess As Long, ByVal AccessMask As Long, ByRef ObjectAttributes As OBJECT_ATTRIBUTES, ByRef ClientId As CLIENT_ID) As Long
     Dim lngReturn As Long
     HookStatus False
     lngReturn = NtOpenProcess(hProcess, AccessMask, ObjectAttributes, ClientId)
     HookStatus True
     If hProcess <> 0 Then
         If ClientId.UniqueProcess >= mdwProcessId And ClientId.UniqueProcess < mdwProcessId + 4 Then
             MessageBox 0, "被拦截了", "哈哈", 0
             hProcess = 0
         End If
     End If
     NtOpenProcessCallback = lngReturn
End Function




测试程序源码

VERSION 5.00
Begin VB.Form frmMain
    Caption          =    "测试程序"
    ClientHeight     =    3090
    ClientLeft       =    60
    ClientTop        =    450
    ClientWidth      =    4680
    LinkTopic        =    "Form1"
    ScaleHeight      =    3090
    ScaleWidth       =    4680
    StartUpPosition =    3   '窗口缺省
    Begin VB.CommandButton cmdKill
       Caption          =    "结束进程"
       Height           =    525
       Left             =    1080
       TabIndex         =    0
       Top              =    1260
       Width            =    1695
    End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hWnd As Long, lpdwProcessId 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 TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Private Sub cmdKill_Click()
     Dim hWnd As Long, dwProcesdId As Long, hProcess As Long
     hWnd = FindWindow(vbNullString, "API拦截")
     GetWindowThreadProcessId hWnd, dwProcessId
     hProcess = OpenProcess(1, 0, dwProcessId)
     TerminateProcess hProcess, 0
End Sub


上一篇: 怎么修改VPN的端口?
下一篇: VB怎么操作注册表?VB注册表操作函数
文章来自: 本站原创
引用通告: 查看所有引用 | 我要引用此文章
Tags:
相关日志:
评论: 1 | 引用: 0 | 查看次数: 4983
发表评论
昵 称:
密 码: 游客发言不需要密码.
邮 箱: 邮件地址支持Gravatar头像,邮箱地址不会公开.
网 址: 输入网址便于回访.
内 容:
验证码:
选 项:
虽然发表评论不用注册,但是为了保护您的发言权,建议您注册帐号.
字数限制 1000 字 | UBB代码 关闭 | [img]标签 关闭