Raise Custom Error

[tyomitch]

Я выдумал-таки способ возвратить из процедуры любой HRESULT.
Таким образом, преодолено два ограничения VB:
- нельзя было вернуть положительный HRESULT, такой как S_FALSE;
- нельзя было вернуть некоторые конкретные значения HRESULT, которые VB в соответствии со своей внутренней логикой преобразовывал (например, E_OUTOFMEMORY = 0x8007000E в 0x800A007)
Задумываемая область применения этого способа - при имплементации интерфейсов, требующих необычных HRESULT-ов, удастся обойти без WriteProcessMemory и подстановки в VTbl адресов функций из обычных модулей.

Модуль:

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

Option Explicit
Public Declare Function InterlockedExchange Lib "kernel32" (ByVal Target As Long, ByVal Value As Long) As Long
Public Declare Sub PutMem4 Lib "msvbvm60" (pDst As Any, ByVal Src As Any)

Public ReturnCode(10) As Byte

Sub Main()
'initialize thunk
ReturnCode(0) = &HB8
ReturnCode(5) = &H68
ReturnCode(10) = &HC3

Dim c As Class1
Set c = New Class1
c.Harmless 123
End Sub


Class1:

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

Option Explicit

Public Sub Harmless(ByVal IgnoreMe As Long)
Debug.Print "Been here"
PutMem4 ReturnCode(1), &H80004001 'E_NOTIMPL
PutMem4 ReturnCode(6), InterlockedExchange(VarPtr(IgnoreMe) - 8, VarPtr(ReturnCode(0)))
End Sub


[GSerg]

Ага...
1. Есть причина не уподобиться дурному примеру и не сделать Optional ByVal IgnoreMe As Long = 0?
2. -4 у нас this, -8 у нас что - адрес возврата? А совместимость с IDE/exe?

[tyomitch]

1. Нет причины (в реальном методе это будет реальный первый параметр, а это - только technology demo )
2. Именно так, проверено и работает всюду.

[GSerg]

1. Внимательно прочитай вопрос, и ты увидишь, что следовало ответить наоборот %) А так - получается, что нет причин не уподобиться
2. Поковыряем, со своей стороны...

[tyomitch]

1. Да, ты меня успешно запутал.
2. А мы - со своей... "В крайнем случае, будет два туннеля" (с)

[GSerg]

По различным техническим причинам не могу сейчас ответить тебе по аське, и вообще щас опять коннект порвётся

В общем, описанного тобой бага нет – всё передаётся правильно, даже тогда, когда в декларации стоит byref, а в вызове byval. Вот, зацени:

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

Option Explicit

Private Declare Sub GetIntByRef Lib "C:\Program Files\Microsoft Visual Studio\MyProjects\fooLibPramsPassType\Release\fooLibPramsPassType.dll" Alias "?GetIntByRef@@YGXPAH00@Z" (ByRef i As Long, ByRef outAddress As Long, ByRef outValue As Long)

Private Sub Form_Load()
  Dim i As Long, a As Long, v As Long
 
  Me.AutoRedraw = True
 
  Me.Print "Let's test something..."
  Me.Print "GetIntByRef function receives integer byref, and returns it's address and value."
  Me.Print
  Me.Print "First of all, let's locate our variable i in memory."
  Me.Print "It's located at " & PaddHex(VarPtr(i)) & ". Let's remember that address."
  Me.Print vbNewLine
  Me.Print "Test 1. We'll pass params as usually."
  Me.Print "Let i = 5. We call ""GetIntByRef i, a, v"""
 
  i = 5
  GetIntByRef i, a, v
  Me.Print "Function reports that it got value """ & CStr(v) & """, which is placed at " & PaddHex(a) & "."
  Me.Print
 
  Me.Print "Test 2. ""GetIntByRef ByVal VarPtr(i), a, v"""
  GetIntByRef ByVal VarPtr(i), a, v
  Me.Print "Function says that it got value """ & CStr(v) & """, which is placed at " & PaddHex(a) & "."
End Sub

Private Function PaddHex(ByVal v As Long) As String
  PaddHex = Hex$(v)
  PaddHex = "0x" & String$(8 - Len(PaddHex), "0") & PaddHex
End Function

У меня строки описания результата одинаковы. Если у тебя разные, рассмотри вопрос об установке SP


Библиотеку сам скомпилируешь

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

__declspec(dllexport) void __stdcall GetIntByRef(int* p, int* outAddress, int* outValue) {*outAddress=(int)p; *outValue=*p;}

[tyomitch]

Работает. Ладно, значит там дело было не в этом (или не только в этом).
Факт в том, что после переноса ByVal из вызова в декларацию всё заработало

[GSerg]

Не хочешь искать причину?