Патчинг кодогенерации __vbaSetSystemError

Здесь можно найти готовые «кирпичики» — части кода, пригодные для построения более крупных проектов, а также решения различных типовых и не очень задач на VB.

Модератор: Brickgroup

The trick
Постоялец
Постоялец
 
Сообщения: 781
Зарегистрирован: 26.06.2010 (Сб) 23:08

Патчинг кодогенерации __vbaSetSystemError

Сообщение The trick » 26.06.2024 (Ср) 22:30

Как известно любая API функция объявленная через Declare генерирует вызов функции __vbaSetSystemError которая задает свойство Err.LastDllError. Иногда может быть полезно избежать генерацию этого кода для производительности либо других целей. Для того чтобы сделать это необходимо пропатчить функцию кодогенератора EXMGR::ProcessSystemError:

Изображение

Код: Выделить всё
Option Explicit

Private Enum PTR
    [_]
End Enum

Private Const PAGE_EXECUTE_READWRITE  As Long = &H40&

Private Declare Function GetModuleHandle Lib "kernel32" _
                         Alias "GetModuleHandleW" ( _
                         ByVal lpModuleName As PTR) As PTR
Private Declare Function VirtualProtect Lib "kernel32" ( _
                         ByVal lpAddress As Long, _
                         ByVal dwSize As Long, _
                         ByVal flNewProtect As Long, _
                         ByRef lpflOldProtect As Long) As Long
Private Declare Sub GetMem4 Lib "msvbvm60" ( _
                    ByRef pAddr As Any, _
                    ByRef pDst As Any)
Private Declare Sub GetMemPtr Lib "msvbvm60" _
                    Alias "GetMem4" ( _
                    ByRef pAddr As Any, _
                    ByRef pDst As Any)
Private Declare Sub GetMem8 Lib "msvbvm60" ( _
                    ByRef pAddr As Any, _
                    ByRef pDst As Any)
Private Declare Sub PutMemPtr Lib "msvbvm60" _
                    Alias "PutMem4" ( _
                    ByRef pDst As Any, _
                    ByVal pVal As PTR)
Private Declare Sub PutMem2 Lib "msvbvm60" ( _
                    ByRef pDst As Any, _
                    ByVal iVal As Integer)

Private Function RemoveSystemError() As Boolean
    Dim hVB6    As PTR
    Dim pNTHdr  As PTR
    Dim pStart  As PTR
    Dim pEnd    As PTR
    Dim cSign   As Currency
    Dim lLength As Long
    Dim lProt   As Long
   
    hVB6 = GetModuleHandle(StrPtr("vba6.dll"))
    If hVB6 = 0 Then Exit Function

    GetMem4 ByVal hVB6 + &H3C, pNTHdr
    pNTHdr = pNTHdr + hVB6
   
    GetMem4 ByVal pNTHdr + &H104, pStart
    pStart = pStart + hVB6
   
    GetMem4 ByVal pNTHdr + &H100, lLength
    pEnd = pStart + lLength - 8
       
    Do While pStart <= pEnd
       
        GetMem8 ByVal pStart, cSign
       
        If cSign = -356375250902713.1008@ Then

            If VirtualProtect(pStart + &H10, 2, PAGE_EXECUTE_READWRITE, lProt) Then
           
                PutMem2 ByVal pStart + &H10, &H9090
                VirtualProtect pStart + &H10, 2, lProt, lProt
                RemoveSystemError = True
               
            End If
           
            Exit Do
           
        End If
       
        pStart = pStart + 1
       
    Loop

End Function
UA6527P

Хакер
Телепат
Телепат
Аватара пользователя
 
Сообщения: 16478
Зарегистрирован: 13.11.2005 (Вс) 2:43
Откуда: Казахстан, Петропавловск

Re: Патчинг кодогенерации __vbaSetSystemError

Сообщение Хакер » 10.07.2024 (Ср) 18:39

А где вызов FlushInstructionCache?
—We separate their smiling faces from the rest of their body, Captain.
—That's right! We decapitate them.

The trick
Постоялец
Постоялец
 
Сообщения: 781
Зарегистрирован: 26.06.2010 (Сб) 23:08

Re: Патчинг кодогенерации __vbaSetSystemError

Сообщение The trick » 10.07.2024 (Ср) 20:43

Хакер писал(а):А где вызов FlushInstructionCache?

Да тут не нужен он, т.к. выполнение в любом случае в момент записи не будет в том месте. Это если из другого потока только делать. Процесс кодогенерации и непосредственное исполнение кода в любом случае обновит кэш. И разве на x86 кэш не обновляется автоматом для инструкций?
UA6527P


Вернуться в Кирпичный завод

Кто сейчас на конференции

Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 13

    TopList