Большой Воронежский Форум
» Программирование>Visual Basic форум "Мы обязательно поможем"
Kerish 21:32 23.04.2002
Задавайте любые вопросы относительно Visual Basic и если на них есть ответ,то вы его получите!
OveRMinD 23:01 11.05.2002
Мы с уважаемым Kerishем постараемся%))))))
Kerish 22:56 12.05.2002
Постараемся
Alex__ 14:18 20.05.2002
Вопрос по "явной" загрузке 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 19:31 20.05.2002
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__ 11:50 22.05.2002
УРЯ! Выход есть! ;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 01:09 29.05.2002
Неплохо...
Melkiades 20:36 04.07.2003

Сообщение от :
Первоначальное сообщение от 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 23:11 24.07.2003
This Subject is Closed by Kerish.
Chainik 23:48 25.12.2004
Народ!
Посоветуйте!
С чего лучше начать, с Visual Bassic, или Delphi?
Спасибо!
Kerish 00:48 26.12.2004
Если хочешь получить ответ, начни новую тему.
Эта тема была закрыта уже очень давно.
P.S. Если выбирать из того, что ты предложил, то Delphi, если вообще, то C++.
Вверх