IAT hooking

mdHookImportedFunctionByName.bas

Option Explicit
DefObj A-Z
Private Const MODULE_NAME As String = "mdHookImportedFunctionByName"

'--- will DebugPrint module imports
#Const SHOW_MODULE_IMPORTS = True

'=========================================================================
' API
'=========================================================================

Private Const IMAGE_NUMBEROF_DIRECTORY_ENTRIES   As Long = 16
Private Const IMAGE_DIRECTORY_ENTRY_IMPORT       As Long = 1  ' Import Directory
Private Const IMAGE_DIRECTORY_ENTRY_DELAY_IMPORT As Long = 13
Private Const IMAGE_ORDINAL_FLAG32               As Long = &H80000000
Private Const PAGE_EXECUTE_READWRITE             As Long = &H40

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function VirtualQuery Lib "kernel32" (lpAddress As Any, lpBuffer As MEMORY_BASIC_INFORMATION, ByVal dwLength As Long) As Long
Private Declare Function VirtualProtect Lib "kernel32" (lpAddress As Any, ByVal dwSize As Long, ByVal flNewProtect As Long, lpflOldProtect As Long) As Long
Private Declare Function GetVersion Lib "kernel32" () As Long
Private Declare Function lstrcmpiA Lib "kernel32" (ByVal lpStr As String, ByVal lpString2 As Long) As Long
Private Declare Function lstrlenA Lib "kernel32" (ByVal lpStr As Long) As Long
Private Declare Sub OutputDebugStringW Lib "kernel32" (ByVal lpOutputString As Long)

Private Type IMAGE_IMPORT_DESCRIPTOR
    OriginalFirstThunk      As Long
    TimeDateStamp           As Long
    ForwarderChain          As Long
    Name                    As Long
    FirstThunk              As Long
End Type

Private Type IMAGE_DELAYLOAD_DESCRIPTOR
    Attributes              As Long
    DllNameRVA              As Long
    ModuleHandleRVA         As Long
    ImportAddressTableRVA   As Long
    ImportNameTableRVA      As Long
    BoundImportAddressTableRVA As Long
    UnloadInformationTableRVA As Long
    TimeDateStamp           As Long
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_ovno                  As Integer
    e_res(0 To 3)           As Integer
    e_oemid                 As Integer
    e_oeminfo               As Integer
    e_res2(0 To 9)          As Integer
    e_lfanew                As Long
End Type

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

Private Type IMAGE_DATA_DIRECTORY
    VirtualAddress          As Long
    Size                    As Long
End Type

Private Type IMAGE_OPTIONAL_HEADER
    Magic                   As Integer
    MajorLinkerVersion      As Byte
    MinorLinkerVersion      As Byte
    SizeOfCode              As Long
    SizeOfInitializedData   As Long
    SizeOfUninitializedData 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
    Win32VersionValue       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
    LoaderFlags             As Long
    NumberOfRvaAndSizes     As Long
    DataDirectory(0 To IMAGE_NUMBEROF_DIRECTORY_ENTRIES - 1) As IMAGE_DATA_DIRECTORY
End Type

Private Type IMAGE_NT_HEADERS
    Signature               As Long
    FileHeader              As IMAGE_FILE_HEADER
    OptionalHeader          As IMAGE_OPTIONAL_HEADER
End Type

Private Type IMAGE_THUNK_DATA32
    FunctionOrOrdinalOrAddress As Long
End Type

Private Type MEMORY_BASIC_INFORMATION
    BaseAddress             As Long
    AllocationBase          As Long
    AllocationProtect       As Long
    RegionSize              As Long
    State                   As Long
    Protect                 As Long
    lType                   As Long
End Type

'=========================================================================
' Error handling
'=========================================================================

Private Function PrintError(sFunction As String) As VbMsgBoxResult
    Debug.Print sFunction & ": " & Err.Description
End Function

'=========================================================================
' Functions
'=========================================================================

Public Function HookImportedFunctionByName( _
            ByVal hModule As Long, _
            sImportMod As String, _
            sImportFunc As String, _
            ByVal pFuncAddress As Long, _
            pOrigAddress As Long) As Boolean
    Const FUNC_NAME     As String = "HookImportedFunctionByName"
    Dim uDosHeader      As IMAGE_DOS_HEADER
    Dim uNtHeaders      As IMAGE_NT_HEADERS
    Dim uImportDesc     As IMAGE_IMPORT_DESCRIPTOR
    Dim pImportDesc     As Long
    Dim pNameThunk      As Long
    Dim pAddrThunk      As Long

    On Error GoTo EH
    If hModule = 0 Or pFuncAddress = 0 Or LenB(sImportMod) = 0 Or LenB(sImportFunc) = 0 Then
        Exit Function
    End If
    '--- dll above 2G on 9x -> NOT working!!!!
    If hModule < 0 Then
        If Not IsNT() Then
            Exit Function
        End If
    End If
    Call CopyMemory(uDosHeader, ByVal hModule, LenB(uDosHeader))
    Call CopyMemory(uNtHeaders, ByVal UnsignedAdd(hModule, uDosHeader.e_lfanew), LenB(uNtHeaders))
    If uNtHeaders.OptionalHeader.DataDirectory(IMAGE_DIRECTORY_ENTRY_IMPORT).VirtualAddress = 0 Then
        Exit Function
    End If
    pImportDesc = hModule + uNtHeaders.OptionalHeader.DataDirectory(IMAGE_DIRECTORY_ENTRY_IMPORT).VirtualAddress
    Call CopyMemory(uImportDesc, ByVal pImportDesc, LenB(uImportDesc))
    Do While uImportDesc.Name <> 0
        If pvToStringA(hModule + uImportDesc.Name) Like sImportMod Then
            With uImportDesc
                If .FirstThunk = 0 Or .OriginalFirstThunk = 0 Then
                    Exit Function
                End If
                pNameThunk = hModule + .OriginalFirstThunk
                pAddrThunk = hModule + .FirstThunk
            End With
            If pvHookByName(hModule, pvToStringA(hModule + uImportDesc.Name), sImportFunc, pNameThunk, pAddrThunk, pFuncAddress, pOrigAddress) Then
                '--- success
                HookImportedFunctionByName = True
                Exit Do
            End If
        End If
        pImportDesc = pImportDesc + LenB(uImportDesc)
        Call CopyMemory(uImportDesc, ByVal pImportDesc, LenB(uImportDesc))
    Loop
    Exit Function
EH:
    If PrintError(FUNC_NAME) = vbRetry Then
        Resume
    End If
    Resume Next
End Function

Public Function HookDelayLoadedFunctionByName( _
            ByVal hModule As Long, _
            sImportMod As String, _
            sImportFunc As String, _
            ByVal pFuncAddress As Long, _
            pOrigAddress As Long) As Boolean
    Const FUNC_NAME     As String = "HookDelayLoadedFunctionByName"
    Dim uDosHeader      As IMAGE_DOS_HEADER
    Dim uNtHeaders      As IMAGE_NT_HEADERS
    Dim uDelayDesc      As IMAGE_DELAYLOAD_DESCRIPTOR
    Dim pDelayDesc      As Long
    Dim pNameThunk      As Long
    Dim pAddrThunk      As Long

    On Error GoTo EH
    If hModule = 0 Or pFuncAddress = 0 Or LenB(sImportMod) = 0 Or LenB(sImportFunc) = 0 Then
        Exit Function
    End If
    '--- dll above 2G on 9x -> NOT working!!!!
    If hModule < 0 Then
        If Not IsNT() Then
            Exit Function
        End If
    End If
    Call CopyMemory(uDosHeader, ByVal hModule, LenB(uDosHeader))
    Call CopyMemory(uNtHeaders, ByVal UnsignedAdd(hModule, uDosHeader.e_lfanew), LenB(uNtHeaders))
    If uNtHeaders.OptionalHeader.DataDirectory(IMAGE_DIRECTORY_ENTRY_DELAY_IMPORT).VirtualAddress = 0 Then
        Exit Function
    End If
    pDelayDesc = hModule + uNtHeaders.OptionalHeader.DataDirectory(IMAGE_DIRECTORY_ENTRY_DELAY_IMPORT).VirtualAddress
    Call CopyMemory(uDelayDesc, ByVal pDelayDesc, LenB(uDelayDesc))
    Do While uDelayDesc.DllNameRVA <> 0
        If pvToStringA(hModule + uDelayDesc.DllNameRVA) Like sImportMod Then
            With uDelayDesc
                If .ImportNameTableRVA = 0 Or .ImportAddressTableRVA = 0 Then
                    Exit Function
                End If
                pNameThunk = hModule + .ImportNameTableRVA
                pAddrThunk = hModule + .ImportAddressTableRVA
            End With
            If pvHookByName(hModule, pvToStringA(hModule + uDelayDesc.DllNameRVA), sImportFunc, pNameThunk, pAddrThunk, pFuncAddress, pOrigAddress) Then
                '--- success
                HookDelayLoadedFunctionByName = True
                Exit Do
            End If
        End If
        pDelayDesc = pDelayDesc + LenB(uDelayDesc)
        Call CopyMemory(uDelayDesc, ByVal pDelayDesc, LenB(uDelayDesc))
    Loop
    Exit Function
EH:
    If PrintError(FUNC_NAME) = vbRetry Then
        Resume
    End If
    Resume Next
End Function

Private Function pvHookByName( _
            ByVal hModule As Long, _
            sModuleName As String, _
            sImportFunc As String, _
            ByVal pNameThunk As Long, _
            ByVal pAddrThunk As Long, _
            ByVal pFuncAddress As Long, _
            pOrigAddress As Long) As Boolean
    Const FUNC_NAME     As String = "pvHookByName"
    Dim uNameThunk      As IMAGE_THUNK_DATA32
    Dim uAddrThunk      As IMAGE_THUNK_DATA32
    Dim uMemInfo        As MEMORY_BASIC_INFORMATION
    Dim lOldProtect     As Long
    Dim lNotUsed        As Long
    Dim sMsg            As String

    Call CopyMemory(uNameThunk, ByVal pNameThunk, LenB(uNameThunk))
    Do While uNameThunk.FunctionOrOrdinalOrAddress <> 0
        If (uNameThunk.FunctionOrOrdinalOrAddress And IMAGE_ORDINAL_FLAG32) = 0 Then
            '--- case-insensitive compare
            If lstrcmpiA(sImportFunc, hModule + uNameThunk.FunctionOrOrdinalOrAddress + 2) = 0 Then
                #If SHOW_MODULE_IMPORTS Then
                    OutputDebugStringW StrPtr("Hooking " & sModuleName & "." & pvToStringA(hModule + uNameThunk.FunctionOrOrdinalOrAddress + 2) & " [" & MODULE_NAME & "." & FUNC_NAME & "]" & vbCrLf)
                #End If
                Call VirtualQuery(ByVal pAddrThunk, uMemInfo, LenB(uMemInfo))
                If VirtualProtect(ByVal uMemInfo.BaseAddress, uMemInfo.RegionSize, PAGE_EXECUTE_READWRITE, lOldProtect) = 0 Then
                    sMsg = GetSystemMessage(Err.LastDllError) & " (" & Err.LastDllError & ")"
                    #If SHOW_MODULE_IMPORTS Then
                        OutputDebugStringW StrPtr("VirtualProtect failed: " & sMsg & " [" & MODULE_NAME & "." & FUNC_NAME & "]" & vbCrLf)
                    #End If
                    On Error GoTo 0
                    Err.Raise vbObjectError, , "VirtualProtect failed: " & sMsg
                End If
                Call CopyMemory(uAddrThunk, ByVal pAddrThunk, LenB(uAddrThunk))
                pOrigAddress = uAddrThunk.FunctionOrOrdinalOrAddress
                uAddrThunk.FunctionOrOrdinalOrAddress = pFuncAddress
                Call CopyMemory(ByVal pAddrThunk, uAddrThunk, LenB(uAddrThunk))
                Call VirtualProtect(ByVal uMemInfo.BaseAddress, uMemInfo.RegionSize, lOldProtect, lNotUsed)
                '--- success
                pvHookByName = True
                Exit Function
            End If
        End If
        pNameThunk = pNameThunk + LenB(uNameThunk)
        pAddrThunk = pAddrThunk + LenB(uAddrThunk)
        Call CopyMemory(uNameThunk, ByVal pNameThunk, LenB(uNameThunk))
    Loop
End Function

Private Function IsNT() As Boolean
    Static lVersion     As Long
    
    If lVersion = 0 Then
        lVersion = GetVersion()
    End If
    IsNT = ((lVersion And &H80000000) = 0)
End Function

Private Function pvToStringA(ByVal lPtr As Long) As String
    If lPtr <> 0 Then
        pvToStringA = String$(lstrlenA(lPtr), 0)
        Call CopyMemory(ByVal pvToStringA, ByVal lPtr, Len(pvToStringA))
    End If
End Function

Private Function UnsignedAdd(ByVal lStart As Long, ByVal lIncr As Long) As Long
    UnsignedAdd = ((lStart Xor &H80000000) + lIncr) Xor &H80000000
End Function

Private Function GetSystemMessage(ByVal lLastDllError As Long) As String
    GetSystemMessage = "Error " & lLastDllError
End Function

how could pair this .bas with a .vbp reference to stdole32.tlb

how could pair this .bas with a .vbp reference to stdole32.tlb

Not sure what you are asking.