Здесь можно найти готовые «кирпичики» — части кода, пригодные для построения более крупных проектов, а также решения различных типовых и не очень задач на VB.
Модератор: Brickgroup
-
The trick
-
- Постоялец
![Постоялец Постоялец](./images/ranks/rank5.gif)
-
-
- Сообщения: 781
- Зарегистрирован: 26.06.2010 (Сб) 23:08
The trick » 26.06.2024 (Ср) 22:30
Как известно любая API функция объявленная через
Declare генерирует вызов функции
__vbaSetSystemError которая задает свойство
Err.LastDllError. Иногда может быть полезно избежать генерацию этого кода для производительности либо других целей. Для того чтобы сделать это необходимо пропатчить функцию кодогенератора
EXMGR::ProcessSystemError:
![Изображение](https://www.vbforums.com/images/ieimages/2024/05/2.png)
- Код: Выделить всё
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
-
Хакер
-
- Телепат
![Телепат Телепат](./images/ranks/rank14.gif)
-
![Аватара пользователя](./download/file.php?avatar=8077.jpg)
-
- Сообщения: 16477
- Зарегистрирован: 13.11.2005 (Вс) 2:43
- Откуда: Казахстан, Петропавловск
-
Хакер » 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
-
- Постоялец
![Постоялец Постоялец](./images/ranks/rank5.gif)
-
-
- Сообщения: 781
- Зарегистрирован: 26.06.2010 (Сб) 23:08
The trick » 10.07.2024 (Ср) 20:43
Хакер писал(а):А где вызов FlushInstructionCache?
Да тут не нужен он, т.к. выполнение в любом случае в момент записи не будет в том месте. Это если из другого потока только делать. Процесс кодогенерации и непосредственное исполнение кода в любом случае обновит кэш. И разве на x86 кэш не обновляется автоматом для инструкций?
UA6527P
Вернуться в Кирпичный завод
Кто сейчас на конференции
Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 2