VB-код для китайского USB-реле

[sosed213]

Добрый день.
Имеется вот такая USB-реле с китайского сайта. Долго валялась без дела, а теперь загорелся написать VB код для управления этой релюшкой. Назначение реле может быть разное, это не суть важно. Главное, подружить библиотеку на C++ вместе с VB.

Есть архив с готовой библиотекой и примером. Есть похожая тема, где люди попытались сделать код на VB6, но во первых код до конца не написан, во вторых, то что там есть не работает.


Я попытался из среды VB6 подключить библиотеку. Стандартно ссылку на dll не получилось сделать. Тогда я прописал путь к dll при объявлении функций.

Производитель этих реле описывает работу следующим образом:

1. Инициализируем библиотеку call usb_relay_init().
2. Получаем список подключенных к ПК USB-модулей реле usb_relay_device_enumerate().
3. Открываем устройство usb_relay_device_open().
4. А дальше уже непосредственно управляем релюшками.

usb_relay_device_open_one_relay_channel()
usb_relay_device_open_all_relay_channel()
usb_relay_device_close_one_relay_channel()
usb_relay_device_close_all_relay_channel()

Первый два этапа проходят нормально. usb_relay_device_enumerate дает некий идентификатор, по которому я через CopyMemory получаю структуру

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

Public Type USB_Relay_Device_Info
    Serial_Number As Long
    Device_Path   As Long
    Type          As Long
    Next          As Long
End Type

В данном случае Serial_Number, тоже указатель. Через функцию CopyMemoryToString, я получаю строку из 5 символов в виде иероглифов, хотя должна получится нормальная строка "WRO0H"

Далее нужно открыть устройство, как раз на этом этапе возникает ошибка. "Ошибка 49. Неверный вызов DLL"

Вот эта функция, и как я ее вызываю:

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

Public Enum USB_Relay_Device_Type
    USB_RELAY_DEVICE_ONE_CHANNEL = 1
    USB_RELAY_DEVICE_TWO_CHANNEL = 2
    USB_RELAY_DEVICE_FOUR_CHANNEL = 4
    USB_RELAY_DEVICE_EIGHT_CHANNEL = 8
End Enum

Public Type USB_Relay_Device_Info
    Serial_Number As Long
    Device_Path   As Long
    Type          As Long
    Next          As Long
End Type

Public Declare Function usb_relay_init Lib "c:\!tmp1\MyVBRelay\usb_relay_device.dll" () As Long
Public Declare Function usb_relay_exit Lib "c:\!tmp1\MyVBRelay\usb_relay_device.dll" () As Long
Public Declare Function usb_relay_device_enumerate Lib "c:\!tmp1\MyVBRelay\usb_relay_device.dll" () As Long
Public Declare Function usb_relay_device_open Lib "c:\!tmp1\MyVBRelay\usb_relay_device.dll" (ByRef Device_Info As USB_Relay_Device_Info) As Long

Private Sub main()
    mUSBRelay.usb_relay_init
   
    Dim n As Long
    n = mUSBRelay.usb_relay_device_enumerate
   
    Dim t As USB_Relay_Device_Info
    Win32.CopyMemory ByVal VarPtr(t), ByVal n, Len(t)
   
    Dim z As Long
    z = usb_relay_device_open(t)
End Sub


Понимаю что без железяки будет сложно что то проверить/подсказать. Но если кто нибудь откликнется, буду очень признателен.

[Sirik]

Я конечно все понимаю, но не проще использовать Arduino с платами реле? (Правда цена вопрос будет чуть выше, зато геморроя меньше). А если брать китайский клон, то цена вполне приемлемая:
1. Arduino - http://ru.aliexpress.com/item/R3-MEGA32 ... 5,201409_5
2. 4-х канальное реле: http://ru.aliexpress.com/item/4-Channel ... .11.lR7pnR

В программирование оной могу помочь

[sosed213]

Да, Arduino можно использовать. Я его и использую для других проектов. Но в данном случае задача стоит в том чтобы разобраться с кодом именно на VB6.

[sosed213]

Уже думаю что возможно надо использовать динамический вызов dll через LoadLibrary.

Нашел статейку, но осилить ее не хватает ума.

[hclubmk]

Писать dll-обертку на C, с соглашением вызова __stdcall, и уже её использовать в VB не вариант?

[sosed213]

Отличный вариант! только я не знаю C.

И опять же, это получается будет уже 2 библиотеке? (хотя это и не критично.)


Правильно ли я понимаю, что на С можно написать библиотеку *.tlb (например как Win32.tlb) и использовать в проекте vb6 ?

[hclubmk]

Нет, речь идет о создании нативной dll, в которой функции-обертки с соглашением вызова stdcall будут работать с "натуральными" функциями, но имеющими соглашение cdecl, которое (соглашение cdecl) увы не понимает VB. Правда, Тёмыч на форуме где-то показывал трюк с вызовом cdecl из VB - можно поискать.

[The trick]

Можно через DispCallFunc вызывать cdecl функции из IDE, а в скомпилированном виде использовать функции задекларированные в tlb с указанием соглашения вызова.

[bon818]

Писать dll-обертку. Отличный вариант! только я не знаю C.
И опять же, это получается будет уже 2 библиотеке? (хотя это и не критично.)

Или на PowerBasic, код будет почти идентичен VB6.

[Хакер]

Написать обёртку можно и на VB: viewtopic.php?f=54&t=44385&start=0
А дальше маленькой обёрточкой пользоваться из основного проекта.

[sosed213]

Ура. Сдается мне что тема не безнадежна. С чего бы начать. Может есть пример, для разгона?

[hclubmk]

Да, activex-обертка справляется с cdecl-соглашением, и вполне себе работает в другом проекте - приятно удивлен - раньше приходилось делать, как упоминал выше.

[sosed213]

Сам то я такое вряд ли осилю. Может кто поможет хотя бы с одной функцией, а дальше я сам, по аналогии?

Интересно что функции, которым не требуется передавать параметры срабатывают. А там где нужно задавать параметры, вылазит ошибка.

[sosed213]

И правда! Скомпилировал, и все работает, как и говорил Хакер.
Круто!

[sosed213]

Отлично!

Накидал Демо-проект демонстрирующий все возможности китайского USB-реле средствами VB6. (проект прикрепил)
В папке с проектом должна находится библиотека usb_relay_device.dll

Спасибо всем за участие!

PS. под отладкой даже не пытайтесь запустить. Работает только в скомпелированном виде.

Так же привожу код:

Код Формы:

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

Dim b As Boolean

Private Sub cmdCloseAll_Click()
    Dim z As Long
    Dim s As String
   
    s = WToA(cmbRelay.Text, CP_ACP)
   
    z = usb_relay_device_open_with_serial_number(StrPtr(s), Len(s))
   
    If Not (z > 0) Then Exit Sub
   
    Call mUSBRelay.usb_relay_device_close_all_relay_channel(z)
   
    Dim nStatus As Long, zStatus As Long
    zStatus = usb_relay_device_get_status(z, nStatus)
    Me.Caption = "Status: " & nStatus
   
    Call usb_relay_device_close(z)
End Sub

Private Sub cmdOpenAll_Click()
    Dim z As Long
    Dim s As String
   
    s = WToA(cmbRelay.Text, CP_ACP)
   
    z = usb_relay_device_open_with_serial_number(StrPtr(s), Len(s))
    If Not (z > 0) Then Exit Sub
    Call mUSBRelay.usb_relay_device_open_all_relay_channel(z)
   
    Dim nStatus As Long, zStatus As Long
    zStatus = usb_relay_device_get_status(z, nStatus)
    Me.Caption = "Status: " & nStatus
   
    Call usb_relay_device_close(z)
End Sub

Private Sub cmdO2_Click()
    Dim z As Long
    Dim s As String
   
    s = WToA(cmbRelay.Text, CP_ACP)
   
    z = usb_relay_device_open_with_serial_number(StrPtr(s), Len(s))
    If Not (z > 0) Then Exit Sub
    Call usb_relay_device_open_one_relay_channel(z, 2)
   
    Dim nStatus As Long, zStatus As Long
    zStatus = usb_relay_device_get_status(z, nStatus)
    Me.Caption = "Status: " & nStatus
   
    Call usb_relay_device_close(z)
End Sub

Private Sub cmdC2_Click()
    Dim z As Long
    Dim s As String
   
    s = WToA(cmbRelay.Text, CP_ACP)
   
    z = usb_relay_device_open_with_serial_number(StrPtr(s), Len(s))
   
    If Not (z > 0) Then Exit Sub
   
    Call usb_relay_device_close_one_relay_channel(z, 2)
   
    Dim nStatus As Long, zStatus As Long
    zStatus = usb_relay_device_get_status(z, nStatus)
    Me.Caption = "Status: " & nStatus
   
    Call usb_relay_device_close(z)
End Sub





Private Sub cmdO1_Click()

    Dim z As Long
    Dim s As String
   
    s = WToA(cmbRelay.Text, CP_ACP)
   
   
    z = usb_relay_device_open_with_serial_number(StrPtr(s), Len(s))
   
    If Not (z > 0) Then Exit Sub
    Call usb_relay_device_open_one_relay_channel(z, 1)
   
    Dim nStatus As Long, zStatus As Long
    zStatus = usb_relay_device_get_status(z, nStatus)
    Me.Caption = "Status: " & nStatus
   
    Call usb_relay_device_close(z)
End Sub

Private Sub cmdC1_Click()
    Dim z As Long
    Dim s As String
   
    s = WToA(cmbRelay.Text, CP_ACP)
   
    z = usb_relay_device_open_with_serial_number(StrPtr(s), Len(s))
   
    If Not (z > 0) Then Exit Sub
   
    Call usb_relay_device_close_one_relay_channel(z, 1)
   
    Dim nStatus As Long, zStatus As Long
    zStatus = usb_relay_device_get_status(z, nStatus)
    Me.Caption = "Status: " & nStatus
   
    Call usb_relay_device_close(z)
End Sub



Private Sub cmdRefresh_Click()
    Call RefreshRelay
End Sub




Private Sub RefreshRelay()
    cmbRelay.Clear
   
    If m_pDeviceList Then
        m_pDeviceList = 0
    End If
 
   
    Dim n As Long
    n = usb_relay_device_enumerate
   
    If Not (n > 0) Then
        'MsgBox "USB Relay Not Found!"
        Exit Sub
    End If
   
    Dim t As USB_Relay_Device_Info
    Win32.CopyMemory ByVal VarPtr(t), ByVal n, Len(t)
   
   
   
    Dim sSerial As String
    Dim sPath As String
   
    sSerial = AToWP(t.Serial_Number, CP_ACP)
    sPath = AToWP(t.Device_Path, CP_ACP)
    cmbRelay.AddItem sSerial
    cmbRelay.ItemData(cmbRelay.ListCount - 1) = t.Serial_Number
   
   
    cmbRelay.ListIndex = 0
   
   


    Call usb_relay_device_free_enumerate(t)


   
   
   
End Sub

Private Sub Command1_Click()
    Timer1.Enabled = Not (Timer1.Enabled)
   
    Select Case Timer1.Enabled
    Case False
        txtInterval.Locked = False
        Command1.Caption = "Start"
       
    Case True
        txtInterval.Locked = True
        Command1.Caption = "Stop"
       
        Timer1.Interval = CLng(Val(txtInterval.Text))
   
    End Select
   
End Sub

Private Sub Form_Load()
    Call usb_relay_init
    'MsgBox "Init OK!"

    Call RefreshRelay
    'MsgBox "RefreshRelay OK!"
End Sub

Private Sub Form_Unload(Cancel As Integer)
   
    Call usb_relay_exit
    Unload Me
    End
End Sub

Private Sub Timer1_Timer()

    Dim z As Long
    Dim s As String
    s = WToA(cmbRelay.Text, CP_ACP)
   
    z = usb_relay_device_open_with_serial_number(StrPtr(s), Len(s))
    If Not (z > 0) Then Exit Sub
   
   
    Dim nStatus As Long, zStatus As Long
    zStatus = usb_relay_device_get_status(z, nStatus)
    Me.Caption = "Status: " & nStatus

Select Case b
Case True
    Call mUSBRelay.usb_relay_device_open_all_relay_channel(z)
Case False
    Call mUSBRelay.usb_relay_device_close_all_relay_channel(z)
End Select

Call usb_relay_device_close(z)

b = Not (b)

End Sub

Код модуля:

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

Option Explicit

Public Enum USB_Relay_Device_Type
    USB_RELAY_DEVICE_ONE_CHANNEL = 1
    USB_RELAY_DEVICE_TWO_CHANNEL = 2
    USB_RELAY_DEVICE_FOUR_CHANNEL = 4
    USB_RELAY_DEVICE_EIGHT_CHANNEL = 8
End Enum

Public Type USB_Relay_Device_Info
    Serial_Number As Long
    Device_Path   As Long
    Type          As USB_Relay_Device_Type
    Next          As Long
End Type




Public Declare Function usb_relay_device_close_all_relay_channel Lib "usb_relay_device.dll" (ByVal hHandle As Long) As Long
Public Declare Function usb_relay_device_close_one_relay_channel Lib "usb_relay_device.dll" (ByVal hHandle As Long, ByVal Index As Long) As Long

Public Declare Function usb_relay_device_open_all_relay_channel Lib "usb_relay_device.dll" (ByVal hHandle As Long) As Long
Public Declare Function usb_relay_device_open_one_relay_channel Lib "usb_relay_device.dll" (ByVal hHandle As Long, ByVal Index As Long) As Long

Public Declare Sub usb_relay_device_free_enumerate Lib "usb_relay_device.dll" (ByRef Device_Info As USB_Relay_Device_Info)
Public Declare Function usb_relay_device_enumerate Lib "usb_relay_device.dll" () As Long

Public Declare Function usb_relay_device_set_serial Lib "usb_relay_device.dll" (ByVal hHandle As Long, ByVal Serial As Any) As Long

Public Declare Function usb_relay_exit Lib "usb_relay_device.dll" () As Long
Public Declare Function usb_relay_init Lib "usb_relay_device.dll" () As Long
Public Declare Sub usb_relay_device_close Lib "usb_relay_device.dll" (ByVal hHandle As Long)

Public Declare Function usb_relay_device_open Lib "usb_relay_device.dll" (ByRef Device_Info As USB_Relay_Device_Info) As Long
Public Declare Function usb_relay_device_open_with_serial_number Lib "usb_relay_device.dll" (ByVal Serial_Number As Long, ByVal Length As Integer) As Long

Public Declare Function usb_relay_device_get_status Lib "usb_relay_device.dll" (ByVal hHandle As Long, ByRef Status As Long) As Long
' 0 - Отключены все реле
' 1 - Включено 1 реле
' 2 - Включено 2 реле
' 3 - Включены все реле

Код модуля для конвертирования кодировки:

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

Option Explicit
Public Const CP_ACP = 0
Public Const CP_UTF8 = 65001
Private Declare Function GetACP Lib "kernel32.dll" () As Long
Private Declare Function WideCharToMultiByte Lib "kernel32.dll" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long, ByVal lpMultiByteStr As Long, ByVal cchMultiByte As Long, ByVal lpDefaultChar As Long, lpUsedDefaultChar As Long) As Long
Private Declare Function MultiByteToWideChar Lib "kernel32.dll" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpMultiByteStr As Long, ByVal cchMultiByte As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long) As Long
Dim i As Long
Public Running As Boolean
Public Function WToA(ByVal st As String, Optional ByVal cpg As Long = -1, Optional lFlags As Long = 0) As String
    Dim stBuffer As String
    Dim cwch As Long
    Dim pwz As Long
    Dim pwzBuffer As Long
    Dim lpUsedDefaultChar As Long
   
    If cpg = -1 Then cpg = GetACP()
    pwz = StrPtr(st)
    cwch = WideCharToMultiByte(cpg, lFlags, pwz, -1, 0&, 0&, ByVal 0&, ByVal 0&)
    stBuffer = String$(cwch + 1, vbNullChar)
    pwzBuffer = StrPtr(stBuffer)
    cwch = WideCharToMultiByte(cpg, lFlags, pwz, -1, pwzBuffer, Len(stBuffer), ByVal 0&, ByVal 0&)
    WToA = Left$(stBuffer, cwch - 1)
End Function



Public Function WToAP(ByVal pwz As Long, Optional ByVal cpg As Long = -1, Optional lFlags As Long = 0) As String
    Dim stBuffer As String
    Dim cwch As Long
    'Dim pwz As Long
    Dim pwzBuffer As Long
    Dim lpUsedDefaultChar As Long
   
    If cpg = -1 Then cpg = GetACP()
    'pwz = StrPtr(st)
    cwch = WideCharToMultiByte(cpg, lFlags, pwz, -1, 0&, 0&, ByVal 0&, ByVal 0&)
    stBuffer = String$(cwch + 1, vbNullChar)
    pwzBuffer = StrPtr(stBuffer)
    cwch = WideCharToMultiByte(cpg, lFlags, pwz, -1, pwzBuffer, Len(stBuffer), ByVal 0&, ByVal 0&)
    WToAP = Left$(stBuffer, cwch - 1)
End Function

Public Function AToW(ByVal st As String, Optional ByVal cpg As Long = -1, Optional lFlags As Long = 0) As String
    Dim stBuffer As String
    Dim cwch As Long
    Dim pwz As Long
    Dim pwzBuffer As Long
       
    If cpg = -1 Then cpg = GetACP()
    pwz = StrPtr(st)
    cwch = MultiByteToWideChar(cpg, lFlags, pwz, -1, 0&, 0&)
    stBuffer = String$(cwch + 1, vbNullChar)
    pwzBuffer = StrPtr(stBuffer)
    cwch = MultiByteToWideChar(cpg, lFlags, pwz, -1, pwzBuffer, Len(stBuffer))
    AToW = Left$(stBuffer, cwch - 1)
End Function


Public Function AToWP(ByVal pwz As Long, Optional ByVal cpg As Long = -1, Optional lFlags As Long = 0) As String
    Dim stBuffer As String
    Dim cwch As Long
    'Dim pwz As Long
    Dim pwzBuffer As Long
       
    If cpg = -1 Then cpg = GetACP()
    'pwz = StrPtr(st)
    cwch = MultiByteToWideChar(cpg, lFlags, pwz, -1, 0&, 0&)
    stBuffer = String$(cwch + 1, vbNullChar)
    pwzBuffer = StrPtr(stBuffer)
    cwch = MultiByteToWideChar(cpg, lFlags, pwz, -1, pwzBuffer, Len(stBuffer))
    AToWP = Left$(stBuffer, cwch - 1)
End Function

Public Function DecodeUTF8(ByVal cnvUni As String) As String
    If cnvUni = vbNullString Then Exit Function
    DecodeUTF8 = AToW(WToA(cnvUni, CP_ACP), CP_UTF8)
End Function

Private Function ParsingTXT(sData As String, startstr As String, endstr As String) As String
    Dim sStart, ssEnd As Long

    sStart = InStr(1, sData, startstr)
    ssEnd = InStr(sStart + Len(startstr), sData, endstr)

    If sStart > 0 And ssEnd > 0 Then
        ParsingTXT = Mid$(sData, sStart + Len(startstr), ssEnd - sStart - Len(startstr))
    Else
        ParsingTXT = ""
    End If
End Function


На форме нужно разместить ComboBox (cmbRelay), TextBox (txtInterval), Timer1, и 8 кнопок (по коду будет понятно)

[Хакер]

Работает правильно?

Что-то я не понял, зачем там win32.tlb и где TLB с описанием функций из твоей DLL? Или там всё-таки не cdecl, а вышеотписавшие ошиблись? Я просто саму библиотеку не ковырял и не скачивал даже.

[hclubmk]

Хакер, проясни ситуацию до конца. Для примера, у меня есть пара С-функций, объявленных следующим образом:

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

extern "C" __declspec(dllexport) long __cdecl cdecl_foo(long *a, long *b, long *c)
{
   return *a + *b + *c;
}


и

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

extern "C" __declspec(dllexport) long __stdcall stdcall_foo(long *a,long *b,long *c)
{
   return *a + *b + *c;
}

в проекте VB (Standard-EXE) следующий код

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

Private Declare Function cdecl_foo Lib "vbc.dll" (a As Long, b As Long, c As Long) As Long
Private Declare Function stdcall_foo Lib "vbc.dll" (a As Long, b As Long, c As Long) As Long

Sub Main()
    MsgBox stdcall_foo(1, 2, 88)
    MsgBox cdecl_foo(11, 2, 3)
End Sub


в IDE на строке MsgBox cdecl_foo(11, 2, 3) я естественно, получаю ошибку: Bad DLL calling convention, но в скомпилированном проекте никаких ошибок не возникает. Причем, никаких .tlb, с описанием функций vbc.dll нет/не подключено к проекту.

Вопрос 1: Обязательно ли наличие .tlb, и если ДА, тогда каким дивным образом мой пример работает, да и проект sosed213, как сообщает автор, - тоже?
Вопрос 2: Каким образом можно получить .tlb из имеющейся .dll?

[sosed213]

Tlb совсем не обезательно. А как это работает, вот тут Хакер уже пояснил.

[sosed213]

Хакер, да работает все правильно, и идеально.


Win32.tlb, по привычке подключаю, наверно, к каждому проекту. В данном случае ради функции CopyMemory.

[The trick]

Это работает неправильно. И ты это заметишь когда будешь совершенствовать код и у тебя полезут разные баги. У тебя после вызова процедуры не восстанавливается стек и дальнейшая работа уже в вызывающей процедуре - некорректна. Я не проверял, но попробуй после вызова cdecl функции обратится к локальным переменным или к Me. Видимость отличной работы только из-за регистра кадра стека, но это не всегда бывает.

[hclubmk]

sosed213
Или ты невнимательно читал, или я уже что-то додумал сам, но

Я уж было начал делать TLB-шку с объявлениями всех функций сишного рантайма (стандартной библиотеки Си), проживающих в NTDLL, таких как printf, scanf, isdigit, memcpy, strcpy, упомянутой в пресловутом топике qsort и им подобным. И тут такая досада — нельзя отлаживать (дело даже не доходит до вызова функций), ибо падает.

исходя из этого, и из того, что проект всё-же работает, и возник вопрос №1

[hclubmk]

The trick, спасибо, 1-й вопрос закрыт.
Остался №2

[sosed213]

The trick , проверил обращение к локальным переменным, а также к App и Me. Вроде работает без проблем. Может баги начнут проявляться позже.

Правильно ли я понял, когда ты говоришь что стек не восстанавливается, это значит память не освобождается?

После отправки команды управления релющкой, я отправляю команду Call usb_relay_device_close(z), как мне кажется в этот момент и должно происходить корректное освобождение памяти.

А при завершении программы выполняю предусмотренную процедуру Call usb_relay_exit, которая по видимому тоже должна корректно освобождать подключаемую библиотеку. (может где-то я и заблуждаюсь)

[Хакер]

но в скомпилированном проекте никаких ошибок не возникает.

Очевидно, в скомпилированный проект не попадают check-stack-кусочки, проверяющие ESP после каждого внешнего вызова. Попробуй, кстати, скомпилировать с полностью отключенной оптимизацией.

Обращение к локальным переменным будет работать правильно практически всегда (если не абсолютно всегда), тут The Trick не прав. Причина в том, что для обращения к ним используется EBP-основанная адресация, а EBP остаётся правильным на протяжении работы всей нашей процедуры.
ESP же, как и следует ожидать, не отматывается. Это значит, достаточно сделать цикл, вызывающий cdecl-функцию, и этот цикл быстро израсходует стек и прогрмма рухгнет.

Вопрос 2: Каким образом можно получить .tlb из имеющейся .dll?

Простым, открываем любимую IDE или даже просто блокнот — и пишем. Затем делаем батник или makefile, который вызывает midl или mktyplib.

Небольшой пример для пары cdecl-функций, относящихся к CRT и живущих в NTDLL:

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

[
   helpstring("Fire-Lines Useful CDecl function Type library"),
   uuid(ваш_новый_случайный_UUID_библиотеки)
]
library CdeclStuff
{
   [
      helpstring("C-runtime functions (libc) from NTDLL"),
      dllname("ntdll")
   ]
   module CRuntimeNtdll
   {
      [entry("sprintf")]
      int _cdecl sprintf(LPSTR buffer, LPSTR format, void* arg1);

      [entry("swprintf")]
      int _cdecl wsprintf(LPWSTR buffer, LPWSTR format, void* arg1, void* arg2);
   }
}

[sosed213]

Без оптимизации тоже работает.

[hclubmk]

Это значит, достаточно сделать цикл, вызывающий cdecl-функцию, и этот цикл быстро израсходует стек и прогрмма рухгнет.

рухнула молча, как будто ее и не было. С tlb работает. Жаль в IDE нельзя отлаживать. Впрочем, если очень нужно

Написать обёртку можно и на VB

и тогда уже можно
Хакер, спасибо за разъяснения!

[Хакер]

Надо делать Add-in, надо делать Add-in.

Убить сразу двух зайцев: починить баг, из-за которого переходнички для AddressOf-адресованных процедур не делают правильный retn (из-за этого у людей падает IDE, когда те используют сабклассинг и жмут Stop) и добавить поддержку cdecl под IDE.

[The trick]

Обращение к локальным переменным будет работать правильно практически всегда (если не абсолютно всегда), тут The Trick не прав. Причина в том, что для обращения к ним используется EBP-основанная адресация, а EBP остаётся правильным на протяжении работы всей нашей процедуры.

viewtopic.php?f=99&t=46839
Процедура DriverEntry, там же находится дизассемблированный листинг. Как видно обращение к параметрам процедуры идёт через ESP, EBP не используется совсем.

[Хакер]

Ключевое слово — практически всегда.

Почему такая оговорка? Потому что VB умный и лавирует между использование EBP и не-использованием EBP. Очевидно, когда ты писал драйвер, ты использовал специальные меры предосторожности, например те, что минимизируеют использование рантайма. Как раз эти меры коррелируют со стремлением VB не использовать EBP. Но в данном случае, то есть, как я полагаю, как минимум при использовании Declare-функций — EBP-адресация используется всегда.

Плюс, если я правильно помню, она используется всегда для методов классов/форм.

Говорю всё по памяти и руководствуясь «чутьём», проверок не делал, могу ошибаться.

[Адская_Капча]

Надо делать Add-in, надо делать Add-in.

Присоединяюсь насчет AddressOf. Дело в том, что этот квазиоператор не возвращает реальный адрес процедуры под IDE, чтобы эту процедуру можно было пропатчить ассемблерной вставкой. Именно из-за этого, думаю и

Думаете, всё так хорошо, как кажется? Нет же!

Этот способ не будет работать в среде разработки - только лишь в скомпилированном проекте будет работать он.

А под IDE тоже необходима работа, т.к. синтаксис VB может использоваться и в проектах VBA MS Office, например.

Может, существуют более изящные способы получения реального адреса функции в BAS-модуле под IDE, чем связка EbGetExecutingProj > TipGetFunctionId > TipGetLpfnOfFunctionId, требующая vba6?

Можно вызвать внутри целевой функции вспомогательную и посмотреть на ESP... Но дело в том, что под IDE "адрес возврата (на вершине ESP) минус длина опкодов вызывающей функции" из целевой функции модуля является каким-то "третьим"... кардинально отличающимся от значений AddressOf и TipGetLpfnOfFunctionId. В скомпилированном же виде "ESP минус длина опкодов вызывающей" и AddressOf совпадают.