1) Почему потребовалось создавать несколько классов вместо одного ?
2) Почему переменные нельзя передать просто через ParamArray и обработать в методе ?
3) Почему было решено оставить только STDCALL и CDECL в структуре ?
- Код: Выделить всё
Public Enum CALLCONV
CC_CDECL = 1
CC_STDCALL = 4
End Enum
Причину выпадания сейчас заметил. Последний параметр передавал в функцию DispCallFunc передавал по значению, а не по ссылке.
4) Если не сложно, можете добавить пару комментариев к коду, а то пока не совсем понятно как это всё работает .
Я пока что свой компонент перепахал так:
- Код: Выделить всё
Option Explicit
Private Declare Function LoadLibrary Lib "kernel32.dll" Alias "LoadLibraryA" _
(ByVal lpFileName As String) As Long
Private Declare Function GetProcAddress Lib "kernel32.dll" _
(ByVal hModule As Long, ByVal lpProcName As String) As Long
Private Declare Function FreeLibrary Lib "kernel32.dll" _
(ByVal hModule As Long) As Long
Private Declare Function DispCallFunc Lib "OleAut32.dll" _
(ByVal pvInstance As Long, _
ByVal oVft As Long, _
ByVal cc As Long, _
ByVal vtReturn As Integer, _
ByVal cActuals As Long, _
ByVal prgvt As Long, _
ByVal prgpvarg As Long, _
ByVal pvargResult As Long) As Long
Enum tagCALLCONV
CC_FASTCALL = 0
CC_CDECL = 1
CC_MSCPASCAL = CC_CDECL + 1
CC_PASCAL = CC_MSCPASCAL
CC_MACPASCAL = CC_PASCAL + 1
CC_STDCALL = CC_MACPASCAL + 1
CC_FPFASTCALL = CC_STDCALL + 1
CC_SYSCALL = CC_FPFASTCALL + 1
CC_MPWCDECL = CC_SYSCALL + 1
CC_MPWPASCAL = CC_MPWCDECL + 1
CC_MAX = CC_MPWPASCAL
End Enum
Private Const ERR_SRC = "cLib"
Private lLibraryHandle As Long
Sub Load(FileName As String)
'Если библиотека уже была загружена, то выгружаем её
If lLibraryHandle <> 0 Then Unload
'Получаем хэндл загруженной библиотеки
lLibraryHandle = LoadLibrary(FileName)
'Проверяем как прошла загрузка
If lLibraryHandle = 0 Then Err.Raise vbObjectError + 1, ERR_SRC, "Error loading module"
End Sub
'Метод вызова функций в DLL
Sub CallFunc(ProcName As String, CallConvention As tagCALLCONV, ReturnValueType As VbVarType, ReturnValuePointer As Long, ParamArray Parameters() As Variant)
Dim lProcAddress As Long
ReDim aTypes(UBound(Parameters)) As Integer
ReDim aPointers(UBound(Parameters)) As Long
Dim i
'Получаем адрес функции в библиотеке
lProcAddress = GetProcAddress(lLibraryHandle, ProcName)
If lProcAddress = 0 Then Err.Raise vbObjectError + 1, ERR_SRC, "Function not found"
'Stop
'Заполняем массив типов переменных
For i = 0 To UBound(Parameters)
aTypes(i) = VarType(Parameters(i))
aPointers(i) = VarPtr(Parameters(i))
Next
Dim rv As Long
rv = DispCallFunc(0, _
lProcAddress, _
CallConvention, _
ReturnValueType, _
UBound(Parameters) + 1, _
VarPtr(aTypes(0)), _
VarPtr(aPointers(0)), _
VarPtr(ReturnValuePointer))
End Sub
'Выгрузка библиотеки
Sub Unload()
FreeLibrary lhModule
End Sub
'Событие выгрузки экземпляра класса
Private Sub Class_Terminate()
FreeLibrary lLibraryHandle
End Sub
Хакер,
Хакер писал(а):Обязательно нужно отрывать. Так так и не понял.
Ну зачем же так критично сразу ? ) В обсуждение рождается истина. Возможно предложенный код и не идеален, но если он работает, то это одно из решений. А дальше уже дело за разработчиком. ) Под себя допилить всегда можно.