Вызов функций по указателю

[Хакер]

Обсуждение проекта, замысла, идеи, эмоции по поводу — в этой теме, пожалуйста.
В данной теме публикуются последние версии кирпича, обсуждаются конкретные вопросы, сообщают о багах.

( Пожалуйста, заходите в эту тему хотя бы раз в месяц, если вы используете модуль в своих проектах, чтобы посмотреть, не вышла ли новая версия )

Последняя версия:

func_pointers_1.0.4.zip

Модуль и пример. (Версия 1.0.4)

(11.74 Кб) Скачиваний: 939

Устаревшие версии:


func_pointers_1.0.2.zip

Модуль и пример. (Версия 1.0.2) Содержит ошибку!

(11.2 Кб) Скачиваний: 665




func_pointers_1.0.1.zip

Модуль и пример. (Версия 1.0.1) Содержит ошибку!

(10.94 Кб) Скачиваний: 598




func_pointers.zip

Модуль и пример. (Версия 1.0.0) Содержит ошибку!

(10.57 Кб) Скачиваний: 608

Модуль позволяет вам объявлять типизированные указатели на функции и делать вызов через эти указатели. Типизированный — значит вы указываете прототип (тип возврата, количество и типы всех параметров) функций, на которые будет указывать данный указатель. Считайте, что указатель, это переменная.

Объявляется указатель так:

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

[Private|Public] Declare {Sub|Function} <ИмяУказателя> Lib "*" ([аргументы]) [As ТипВозврата]

или так:

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

[Private|Public] Declare {Sub|Function} <ИмяПсевдонимаУказателя> Lib "*" Alias "<ИмяУказателя>" ([аргументы]) [As ТипВозврата]

То есть в точности так, как обычная Declare Function, но вместо имени библиотеки вы указываете звёздочку (*).

Присваивание/получение значения указателю/указателя выполняется так:

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

FuncPointer("<ИмяУказателя>") = <новое_значение>
<переменная> = FuncPointer("<ИмяУказателя>")

Вызов по указателю осуществляется с тем же синтаксисом, что и вызов обычной функции.

Поддержка таких указателей включается и выключается функцией MagicPointersOnOff.

В архиве содержится сам модуль и проект-пример его использования. Проект-пример состоит из трёх частей:

• Пример с Апплетами. Мы перебираем в папке «system32» все файлы с расширением «.cpl». Подгружаем каждый CPL-файл и вызываем с помощью указателя экспортируемую функцию CPlApplet. Через её вызов получается список диалогов, предоставляемых апплетами:
  
  Пример демонстрирует, как с помощью указателей на функции работать с библиотеками-плагинами.
• Пример с вызовом метода экземпляра класса. Метод созданного экзмемпляра класса вызывается через указатель, этому методу передаётся некоторое значение. Пример показывает возможность вызова через указатели не только Static-функций, но и методов классов (по механизму раннего связывания).
• Пример с операторами. Адреса двух функций (DoAdd, DoSub), у которых идентичные прототипы, присваиваются указателю MathOperator и выполняется вызов. Выводятся результаты сложения и вычитания одинаковых операндов.
• Пример с callback-ами. Делается вызов «чужой» процедуры, которой передаётся адрес «нашей» процедуры обратного вызова. Чужая процедура по переданному адресу делает вызов нашего callback'а, чтобы сообщить о каждом из найденных файлов. Показывает реализацию механизма callback-ов.

Примеры сделаны на скорую руку, наверняка я их переделаю.

[Хакер]

Загрузил новую версию.

• Исправлена ошибка.
• Дополнен пример.

[Хакер]

Скачивайте новую версию.
Исправлен баг: обычные Declare-функции, ни разу не вызванные до включения «волшебных указателей», при вызова инициирует крах из-за существования в LocalResolver ветки (по которой может пойти выполнение), которая ничего не возвращает.

[arthur2]

Вот в этой месте:

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

If Err.Number <> 0 Then
    Err.Raise 453, , "Specified pointer is not set."


пропущено on error goto 0, если выполнение заходит сюда, сгенерированная ошибка игнорируется

[Хакер]

Ну подождём ещё может кто-то что-то найдёт, не буду же я каждый день выкладывать по несколько новых версий.

Временный bug-fix:
Найти:

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

            On Error Resume Next
            Err.Clear
            lpAddress = m_UndiscoveredPointers(sPointerName)
            If Err.Number <> 0 Then
                Err.Clear
                lpAddress = m_DiscoveredPointers(sPointerName)
                If Err.Number <> 0 Then
                    Err.Raise 453, , "Specified pointer is not set."
                    Exit Function
                End If
            End If
            On Error GoTo 0
           
            If lpAddress = 0 Then

Заменить на:

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

            On Error Resume Next
            Err.Clear
            lpAddress = m_UndiscoveredPointers(sPointerName)
           
            If Err.Number <> 0 Then
                On Error GoTo 0
                On Error Resume Next
                lpAddress = m_DiscoveredPointers(sPointerName)
                If Err.Number <> 0 Then
                    On Error GoTo 0
                    Err.Raise 453, , "Specified pointer is not set."
                    Exit Function
                End If
            End If
           
            If lpAddress = 0 Then

[djalex777]

Вызов методов класса, определенных как function вызывает крах приложения. Это так и должно быть?

[Хакер]

Нет, что-то неправильно делаешь.
В примере же даже есть суб-пример:

# Пример с вызовом метода экземпляра класса. Метод созданного экзмемпляра класса вызывается через указатель, этому методу передаётся некоторое значение. Пример показывает возможность вызова через указатели не только Static-функций, но и методов классов (по механизму раннего связывания).

[Хакер]

Если включить телепатию, получается, что вероятно ты просто забыл, что все методы (и Sub-ы и функции) возвращают HRESULT, а у функции формальное возвращаемое значение передаются через физический последний ByRef-параметр.

То есть указатель на функцию, возвращающую Long, надо объявлять так:

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

Declare Function ptr lib "*" (byval This As CYourClass, ByRef relval as Long) As Long

[djalex777]

Ааай, точно, затупил. Спасибо!

[Хакер]

Не за что.

Вообще, в чём смысл использовать этот кирпич для вызова методов интерфейсов объектов? В примере оно было просто в познавательно-демонстрационных целях, в реальной жизни — почему бы не вызывать нужный метод штатно?

[djalex777]

Я его просто смотрел, так что цели, как таковой, не было

[Хакер]

Вопрос (всем): стоит ли добавлять возможность связать сам указатель с переменной, чтобы устанавливать указатель не так: FuncPointer("ptr1") = 123, а так v_ptr1 = 123? Само по себе связывание будет выполняться один раз, а последующее присвоение — сколько угодно раз.

[0xy]

Баг в примере:
frmApplets:Form_Load падает на "fn = Dir()" (3-я строка снизу).
Падение происходит по причине отсутствия искомых файлов *.cpl в папке System32.

[ger_kar]

Ну по большому счету, пример нужен лишь для того, что-бы продемонстрировать как использовать указатели. Что-же касается самих указателей, то применял их уже несколько раз при этом все работает как часы, никаких глюков/багов не проявлялось. А вообще очень удобная и полезная штука эти указатели, особенно если делать CallBack в своих функциях и вставки на ассемблере.

[Хакер]

Опубликовал исправленную версию.

[Mikle]

Класс. Буду пользоваться. Только добавил во все модули "Option Explicit" и переименовал безликую ф-цию "L_" в "PtrToLong".
Вопросы:
1. Там используется "On Error", допустимо ли, используя такие указатели, применять все дополнительные опции оптимизации? Я скомпилировал, вроде работает, но мало ли.
2. Есть ли преграды для выполнения заранее скомпилированных, скажем, на ассемблере процедур, загруженных в виде ресурса? Или это будет попытка выполнения данных?

[Хакер]

и переименовал безликую ф-цию "L_" в "PtrToLong".

Ну и неправильно. Правильно переименовать CastAsLong. Или ты имел в виду PtrAsLong? Тогда допустимо. Но L_ лучше ибо коротко. Я поклялся себе не писать строки длиннее 83 символов кроме исключительных случаев.

1. Там используется "On Error", допустимо ли, используя такие указатели, применять все дополнительные опции оптимизации? Я скомпилировал, вроде работает, но мало ли.

По идее допустимо. Оптимизации, отключающие проверки, могут привести к тому, что программа упадёт, если проверка не сделана вручную там, где надо. Но так она упадёт в любом случае, и без моего кирпича, и с ним.

2. Есть ли преграды для выполнения заранее скомпилированных, скажем, на ассемблере процедур, загруженных в виде ресурса? Или это будет попытка выполнения данных?

Преград для выполнения заранее скомпилированных процедур нет, но помещать их в ресурсы — неправильно. Но если дать ресурсам E-атрибут, то можно.

[Mikle]

Правильно переименовать CastAsLong. Или ты имел в виду PtrAsLong? Тогда допустимо.

Приведение пойнтера к лонгу, по аналогии с FtoDW.

Я поклялся себе не писать строки длиннее 83 символов кроме исключительных случаев.

А я - не называть Public сущности непонятно

если проверка не сделана вручную там, где надо. Но так она упадёт в любом случае, и без моего кирпича, и с ним.

Это понятно, главное - на работе кирпича не скажется.

помещать их в ресурсы — неправильно. Но если дать ресурсам E-атрибут, то можно.

А как правильно? Или как "дать ресурсам E-атрибут"?

[Хакер]

Приведение пойнтера к лонгу, по аналогии с FtoDW.

Так ведь нет никакого поинтера. AddressOf возвращает Long, но обязан быть аргументом какой-нибудь функции. Поэтому это функция-пустышка, чтобы выполнить это ерундовое требование.

А как правильно?

По идее, правильно, чтобы код был в секции кода. Даже инородный код туда можно легко засунуть, но на порядок сложнее «получить его адрес». Хотя стоп. Это если говорить о нашей собственной секции кода. Но ведь можно и в чужую. Так что очень правильный метод — положить написанные в на ассемблере процедурки в DLL, подгружать эту DLL и вызывать нужные процедурки по указателю. Правда тут уже и указатели не нужны, можно вызывать через обычный Declare. Хотя именно указатели могут потребоваться чтобы воспользоваться удобствами именно самих указателей (а не для того, чтобы вызвать что-то, что раньше вообще никак вызвать было нельзя*)

Второй по правильности способ — копировать код в выделенные фрагменты, обладающие E-флагом. Выделенные с помощью VirtualAlloc/HeapAlloc.

Или как "дать ресурсам E-атрибут"?

Всей секции можно дать с помощью утилиты (входящей в VS) editbin. Примерно так: editbin /section:.rsrc,re my.exe.
Отдельно взятой странице — с помощью VirtualProtect.

Но как ты собрался лёгко из VB получать адрес бинарного ресурса?

[Mikle]

Но как ты собрался лёгко из VB получать адрес бинарного ресурса?

Можно через костыль - поиск по уникальному идентификатору, можно выполнить LoadResData в массив, который предварительно перенаправлен на область памяти, выделенную через VirtualAlloc/HeapAlloc.
Но как CallWindowProc выполняет код в области данных?

[Хакер]

Но как CallWindowProc выполняет код в области данных?

Никак не выполняет. Программы, пытающиеся сделать это, падают с DEP-исключением. Если аппаратный DEP поддерживается процессором, плюс включен, плюс программа не сидит в исключениях.

Плюс, ещё есть SetProcessDEPPolicy, но это всё равно, что признавать — я, автор этой программы, — криворукий неандерталец, не признающий DEP.

[Mikle]

Разобрался в том примере, перед CallWindowProc выполняли VirtualProtect Lib "kernel32".

[Qwertiy]

Требуются ли какие-либо изменения этого модуля для использования в новых версиях Офиса? В частности интересует 2013й Visio.

А то я тут набрёл на вот такое объявление функции:

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

#If Win64 Then
    #If VBA7 Then    ' Windows x64, Office 2010
        Private Declare PtrSafe Function GetOpenFileName Lib "comdlg32.dll" Alias _
                                "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As LongLong
    #Else    ' Windows x64,Office 2003-2007
        Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias _
                                "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As LongLong
    #End If
#Else
    #If VBA7 Then    ' Windows x86, Office 2010
        Private Declare PtrSafe Function GetOpenFileName Lib "comdlg32.dll" Alias _
                                "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
    #Else    ' Windows x86, Office 2003-2007
        Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias _
                                "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
    #End If
#End If

соответственно возникла мысль, что функции, используемые тут тоже надо объявлять как-то так...

[Хакер]

Требуются ли какие-либо изменения этого модуля для использования в новых версиях Офиса?

Наугад не могу сказать. Нужно исследовать изнутри VBA в новых офисах.

[ger_kar]

Декларация судя по приведенному коду изменилась для некоторых случаев. А после прочтения
http://msdn.microsoft.com/ru-ru/library/office/gg278581.aspx
http://msdn.microsoft.com/ru-ru/library/office/gg278832.aspx
Появилось убеждение, что в 64 разрядном варианте вызов по указателю работать без переделки не будет.
А вот проверить на практике мне не представляется возможным.

[loquat]

can this module be used to call cdecl function pointer?

[Хакер]

can this module be used to call cdecl function pointer?

Yes, as soon as VB6 supports calling CDecl functions exported by regular DLLs using "Declare Sub" or "Declare Functions". And VB6 doesn't support this out of the box, but The trick developed an Add-in which improves support of CDecl for Declare statement.

I haven't personally checked his Add-in out, but if managed to learn VB6 how to work with cdecl-functions from DLL, then you can use my module (aka "brick") which turns DLL-imports into pointers to functions.

[loquat]

can this module be used to call cdecl function pointer?

Yes, as soon as VB6 supports calling CDecl functions exported by regular DLLs using "Declare Sub" or "Declare Functions". And VB6 doesn't support this out of the box, but The trick developed an Add-in which improves support of CDecl for Declare statement.

I haven't personally checked his Add-in out, but if managed to learn VB6 how to work with cdecl-functions from DLL, then you can use my module (aka "brick") which turns DLL-imports into pointers to functions.

ok i will test it and give feedback.

[loquat]

yes the trick's cdeclfix addin works with function pointer module solved my problem.

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

Private Declare Function LoadLibrary Lib "kernel32.dll" 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 Sub qsort CDecl Lib "*" (ByRef pFirst As Any, ByVal lNumber As Long, ByVal lSize As Long, ByVal pfnComparator As Long)
Sub Main()
    Dim z() As Long
    Dim i As Long
    Dim s As String
   
    ReDim z(10)
    For i = 0 To UBound(z)
        z(i) = Int(Rnd * 1000)
    Next
   
    MagicPointersOnOff True
    Dim hLib As Long
    Dim hPtr As Long
    hLib = LoadLibrary("msvcrt.dll")
    hPtr = GetProcAddress(hLib, "qsort")
    FuncPointer("qsort") = hPtr
   
    qsort z(0), UBound(z) + 1, LenB(z(0)), AddressOf Comparator
    For i = 0 To UBound(z)
        Debug.Print z(i)
    Next
End Sub

Private Function Comparator CDecl(ByRef a As Long, ByRef b As Long) As Long
    Comparator = a - b
End Function

[loquat]

it seems VBEx.dll do not have these two functions
TipGetLpfnOfFunctionId TipGetFunctionIdOfMod
all other api in vba6.dll was found
so i can not port this module to vba...