Visual Basic форум "Мы обязательно поможем"

[Kerish]

Задавайте любые вопросы относительно Visual Basic и если на них есть ответ,то вы его получите!

[OveRMinD]

Мы с уважаемым Kerishем постараемся%))))))

[Kerish]

Постараемся

[Alex__]

Вопрос по "явной" загрузке DLL с помощью LoadLibraryA...

Помогите пожалуйста разобраться. Как "передаються" и "забираються" параметры для функции в
"явно вызванную" DLL. К примеру у меня есть Mydll.dll в этой DLL есть экспортируемая функция "SQUARED"
которая вычесляет квадратный корень. Мне нужно "передать" в DLL данные, что бы функция могла их
вычислить, а потом "забрать" полученный результат из DLL в основную программу.
Часть кода уже есть, загрузка DLL, вызов функции. Однако как реализовать передачу параметра в DLL
и получение результата???????
Если есть возможность, ответьте на майл: [email protected]
Ниже приведен пример кода, который надо дорабртать.
С уважением.
Александр.


Option Explicit
Private Declare Function LoadLibraryA Lib "kernel32" (ByVal lpLibFileName As String) As Long
Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long
Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long

Private Sub Form_Load()

Dim lngLib As Long, lngCall As Long
Dim Rezult as Double
Dim x as Double
X=16 ' Попробуем вычислить корень из 16

lngLib = LoadLibraryA("mydll.dll") ' Загружаем DLL

If lngLib<>0 Then


lngCall = GetProcAddress(lngLib, "_SQUARED") ' Вызываем функцию SQUARED


' Здесь должен быть кусок кода который передает функции в DLL параметр (X) для вычесления SQUARED(X)
' И получает результат вычесления из DLL
'
'



FreeLibrary lngLib
Else
MsgBox "Ошибка"
End If
Msgbox "SQUARED 16=" & Rezult
End Sub

[Reaper]

Ili posmotri na msdn.microsoft.com , ili peredelay DLL v COM object s DUAL interface. A COM object s podderzhkoy DISP interface iz VB vyzyvat nefig delat.

[Alex__]

УРЯ! Выход есть! ;D

Его любезно подсказал Ларин Александр (кстати, рекомендую прочитать его статью
"Разработка нового языка программирования на Visual Basic " на сайте <a href="http://www.vbnet.ru/" target="_blank">http://www.vbnet.ru/</a> )
Ниже привожу исходник, наверняка кому-то пригодиться....


Сачать этот исходник можно на сайте <a href="http://www.vb.kiev.ua/code/api/" target="_blank">http://www.vb.kiev.ua/code/api/</a> он называеться ApiByName.zip

'Создаем форму Form1 и кладем на нее кнопку Command1

Form1:

Private Declare Function GetDC& Lib "user32" (ByVal hwnd As Long)
Private Declare Function ReleaseDC& Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long)

Private Sub Command1_Click()
Dim a As Long, b As Long
Dim s() As Byte, x As Long, y As Long
s = StrConv("Hello !", vbFromUnicode)
b = 15
x = CallApiByName("user32", "SetWindowTextA", hwnd, VarPtr(s(0)))
Debug.Print "x= ", x
x = CallApiByName("kernel32", "RtlMoveMemory", VarPtr(a), VarPtr(b), 4&)
Debug.Print "a= ", a
x = CallApiByName("user32", "FlashWindow", hwnd, 1&)
Debug.Print "x= ", x
dc1 = GetDC(hwnd)
x = CallApiByName("user32", "GetDC", hwnd)
Debug.Print "x= ", x, "dc= ", dc1
x = ReleaseDC(hwnd, dc1)
End Sub


Module1:


Option Explicit
'***********************************************
'* This module use excelent solution from
'* <a href="http://www.vbdotcom.com/FreeCode.htm" target="_blank">http://www.vbdotcom.com/FreeCode.htm</a>
'* how to implement assembly calls directly
'* into VB code.
'***********************************************

Private Declare Function LoadLibrary Lib "kernel32" 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 Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpDest As Any, lpSource As Any, ByVal cBytes As Long)
Private mlngParameters() As Long 'list of parameters
Private mlngAddress As Long 'address of function to call
Private mbytCode() As Byte 'buffer for assembly code
Private mlngCP As Long 'used to keep track of latest byte added to code

Public Function CallApiByName(libName As String, funcName As String, ParamArray FuncParams()) As Long
Dim lb As Long, i As Integer
ReDim mlngParameters(0)
ReDim mbytCode(0)
mlngAddress = 0
lb = LoadLibrary(ByVal libName)
If lb = 0 Then
MsgBox "DLL not found", vbCritical
Exit Function
End If
mlngAddress = GetProcAddress(lb, ByVal funcName)
If mlngAddress = 0 Then
MsgBox "Function entry not found", vbCritical
FreeLibrary lb
Exit Function
End If
ReDim mlngParameters(UBound(FuncParams) + 1)
For i = 1 To UBound(mlngParameters)
mlngParameters(i) = CLng(FuncParams(i - 1))
Next i
CallApiByName = CallWindowProc(PrepareCode, 0, 0, 0, 0)
FreeLibrary lb
End Function

Private Function PrepareCode() As Long
Dim lngX As Long, codeStart As Long
ReDim mbytCode(18 + 32 + 6 * UBound(mlngParameters))
codeStart = GetAlignedCodeStart(VarPtr(mbytCode(0)))
mlngCP = codeStart - VarPtr(mbytCode(0))
For lngX = 0 To mlngCP - 1
mbytCode(lngX) = &HCC
Next
AddByteToCode &H58 'pop eax
AddByteToCode &H59 'pop ecx
AddByteToCode &H59 'pop ecx
AddByteToCode &H59 'pop ecx
AddByteToCode &H59 'pop ecx
AddByteToCode &H50 'push eax
For lngX = UBound(mlngParameters) To 1 Step -1
AddByteToCode &H68 'push wwxxyyzz
AddLongToCode mlngParameters(lngX)
Next
AddCallToCode mlngAddress
AddByteToCode &HC3
AddByteToCode &HCC
PrepareCode = codeStart
End Function

Private Sub AddCallToCode(lngAddress As Long)
AddByteToCode &HE8
AddLongToCode lngAddress - VarPtr(mbytCode(mlngCP)) - 4
End Sub

Private Sub AddLongToCode(lng As Long)
Dim intX As Integer
Dim byt(3) As Byte
CopyMemory byt(0), lng, 4
For intX = 0 To 3
AddByteToCode byt(intX)
Next
End Sub

Private Sub AddByteToCode(byt As Byte)
mbytCode(mlngCP) = byt
mlngCP = mlngCP + 1
End Sub

Private Function GetAlignedCodeStart(lngAddress As Long) As Long
GetAlignedCodeStart = lngAddress + (15 - (lngAddress - 1) Mod 16)
If (15 - (lngAddress - 1) Mod 16) = 0 Then GetAlignedCodeStart = GetAlignedCodeStart + 16
End Function

[Kerish]

Неплохо...

[Melkiades]

Первоначальное сообщение от Reaper
Ili posmotri na msdn.microsoft.com , ili peredelay DLL v COM object s DUAL interface. A COM object s podderzhkoy DISP interface iz VB vyzyvat nefig delat.

Вот ты где тусишь )

Вопрос на засыпку, у тебя есть в воронеже знакомые программеры профессионалы ? (atl, stl, com) и Win CE исчо

Пока ))

[Kerish]

This Subject is Closed by Kerish.

[Chainik]

Народ!
Посоветуйте!
С чего лучше начать, с Visual Bassic, или Delphi?
Спасибо!

[Kerish]

Если хочешь получить ответ, начни новую тему.
Эта тема была закрыта уже очень давно.
P.S. Если выбирать из того, что ты предложил, то Delphi, если вообще, то C++.